From bcpierce at seas.upenn.edu Fri May 1 21:57:37 2009 From: bcpierce at seas.upenn.edu (Benjamin C. Pierce) Date: Fri, 1 May 2009 21:57:37 -0400 Subject: [Unison-hackers] [unison-svn] r320 - in trunk/src: . lwt ubase uimacnew/uimacnew.xcodeproj Message-ID: <200905020157.n421vbQr005424@yaws.seas.upenn.edu> Author: bcpierce Date: 2009-05-01 21:57:23 -0400 (Fri, 01 May 2009) New Revision: 320 Modified: trunk/src/Makefile.OCaml trunk/src/RECENTNEWS trunk/src/TODO.txt trunk/src/abort.ml trunk/src/case.ml trunk/src/case.mli trunk/src/checksum.ml trunk/src/checksum.mli trunk/src/clroot.ml trunk/src/clroot.mli trunk/src/common.ml trunk/src/common.mli trunk/src/copy.ml trunk/src/external.ml trunk/src/external.mli trunk/src/fileinfo.ml trunk/src/fileinfo.mli trunk/src/files.ml trunk/src/files.mli trunk/src/fileutil.ml trunk/src/fileutil.mli trunk/src/fingerprint.ml trunk/src/fingerprint.mli trunk/src/fspath.ml trunk/src/fspath.mli trunk/src/globals.ml trunk/src/globals.mli trunk/src/linkgtk.ml trunk/src/linkgtk2.ml trunk/src/linktext.ml trunk/src/linktk.ml trunk/src/lock.ml trunk/src/lock.mli trunk/src/lwt/pqueue.ml trunk/src/lwt/pqueue.mli trunk/src/main.ml trunk/src/mkProjectInfo.ml trunk/src/name.ml trunk/src/name.mli trunk/src/os.ml trunk/src/os.mli trunk/src/osx.ml trunk/src/osx.mli trunk/src/path.ml trunk/src/path.mli trunk/src/pixmaps.ml trunk/src/pred.ml trunk/src/pred.mli trunk/src/props.ml trunk/src/props.mli trunk/src/recon.ml trunk/src/recon.mli trunk/src/remote.ml trunk/src/remote.mli trunk/src/sortri.ml trunk/src/sortri.mli trunk/src/stasher.ml trunk/src/strings.mli trunk/src/test.ml trunk/src/test.mli trunk/src/transfer.ml trunk/src/transfer.mli trunk/src/transport.ml trunk/src/transport.mli trunk/src/tree.ml trunk/src/tree.mli trunk/src/ubase/rx.ml trunk/src/ubase/rx.mli trunk/src/ubase/safelist.ml trunk/src/ubase/safelist.mli trunk/src/ubase/trace.ml trunk/src/ubase/trace.mli trunk/src/ubase/uarg.ml trunk/src/ubase/util.ml trunk/src/ubase/util.mli trunk/src/ui.mli trunk/src/uicommon.ml trunk/src/uicommon.mli trunk/src/uigtk2.ml trunk/src/uigtk2.mli trunk/src/uimacnew/uimacnew.xcodeproj/project.pbxproj trunk/src/uitext.ml trunk/src/uitext.mli trunk/src/update.ml trunk/src/update.mli trunk/src/uutil.ml trunk/src/uutil.mli trunk/src/xferhint.ml trunk/src/xferhint.mli Log: * Update copyright notices and add GPLv3 boilerplate to .ml files (.mli files are left with a short copyright line, to reduce clutter) Modified: trunk/src/Makefile.OCaml =================================================================== --- trunk/src/Makefile.OCaml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/Makefile.OCaml 2009-05-02 01:57:23 UTC (rev 320) @@ -155,6 +155,8 @@ endif endif +MINOSXVERSION=10.5 + # NOTE: the OCAMLLIBDIR is not getting passed correctly? # The two cases for cltool are needed because Xcode 2.1+ # builds in build/Default/, and earlier versions use build/ @@ -162,9 +164,9 @@ # sed -e's/@@VERSION@@/$(VERSION)/' $(UIMACDIR)/Info.plist.template > $(UIMACDIR)/Info.plist (cd $(UIMACDIR); xcodebuild OCAMLLIBDIR="$(OCAMLLIBDIR)" SYMROOT=build) if [ -e $(UIMACDIR)/build/Default ]; then \ - gcc -mmacosx-version-min=10.4 $(UIMACDIR)/cltool.c -o $(UIMACDIR)/build/Default/Unison.app/Contents/MacOS/cltool -framework Carbon; \ + gcc -mmacosx-version-min=$(MINOSXVERSION) $(UIMACDIR)/cltool.c -o $(UIMACDIR)/build/Default/Unison.app/Contents/MacOS/cltool -framework Carbon; \ else \ - gcc -mmacosx-version-min=10.4 $(UIMACDIR)/cltool.c -o $(UIMACDIR)/build/Unison.app/Contents/MacOS/cltool -framework Carbon; \ + gcc -mmacosx-version-min=$(MINOSXVERSION) $(UIMACDIR)/cltool.c -o $(UIMACDIR)/build/Unison.app/Contents/MacOS/cltool -framework Carbon; \ fi # OCaml objects for the bytecode version Modified: trunk/src/RECENTNEWS =================================================================== --- trunk/src/RECENTNEWS 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/RECENTNEWS 2009-05-02 01:57:23 UTC (rev 320) @@ -1,11 +1,19 @@ +CHANGES FROM VERSION 2.32.6 + +* Update copyright notices and add GPLv3 boilerplate to .ml files + (.mli files are left with a short copyright line, to reduce clutter) + +------------------------------- CHANGES FROM VERSION 2.32.5 +* Update copyright notices and add GPLv3 boilerplate to .ml files + (.mli files are left with a short copyright line, to reduce clutter) + * Ignore one hour differences for deciding whether a file may have been updated. This avoids slow update detection after daylight saving time changes under Windows. This makes it slightly more likely to miss an update, but that should be safe enough. -------------------------------- CHANGES FROM VERSION 2.32.4 * Text UI now includes the current time in its completion message @@ -39,20 +47,11 @@ shortcut-copying completely unrelated files that happen to also have zero length!). - - - - - - ------------------------------- CHANGES FROM VERSION 2.32.0 * Bumped version number to reflect newly added preference - - - ------------------------------- CHANGES FROM VERSION 2.31.11 @@ -69,35 +68,21 @@ * Add some suggestions to TODO file - - - - - ------------------------------- CHANGES FROM VERSION 2.31.10 * Another slight tweak. - - - - ------------------------------- CHANGES FROM VERSION 2.31.9 * Slight tweak to the last commit, suggested by Rasmus. - - - ------------------------------- CHANGES FROM VERSION 2.31.8 * (Forgot to add a couple of new files.) - - ------------------------------- CHANGES FROM VERSION 2.31.5 @@ -113,8 +98,6 @@ * Logging tweak. - - ------------------------------- CHANGES FROM VERSION 2.31.5 @@ -130,29 +113,11 @@ * Logging tweak. +* Resizing the update window vertically no longer moves the status + label. Fix contributed by Pedro Melo. - ------------------------------- -CHANGES FROM VERSION 2.31.5 -* A special hack for Rasmus, who has a special situation that requires - the utimes-setting program to run 'setuid root' (and we do not want - all of Unison to run setuid, so we just spin off an external utility - to do it). This functionality is disabled by default and requires - editing the source code (changing 'false' to 'true' on line 496 of - props.ml) and recompiling to enable. If there are other people that - want it, we can easily make it accessible using a preference - instead, but I prefer not to add a preference until someone else - requests it, to avoid creating an incompatible version. - -* Logging tweak. - - -CHANGES FROM VERSION 2.31.5 - -Resizing the update window vertically no longer moves the status label. Fix contributed by Pedro Melo. -------------------------------- - CHANGES FROM VERSION 2.31.4 * Don't ignore files that look like backup files if the {\\tt @@ -194,16 +159,11 @@ * Record some current TODO items - - - ------------------------------- CHANGES FROM VERSION 2.30.3 * Update docs - - ------------------------------- CHANGES FROM VERSION 2.30.2 @@ -219,14 +179,12 @@ * A better fix for the "single file transfer failed in large directory" issue. - ------------------------------- CHANGES FROM VERSION 2.29.9 * Trying a possible fix for the "assert failure in remote.ml" bug (thanks Jerome!) - ------------------------------- CHANGES FROM VERSION 2.29.8 @@ -236,7 +194,6 @@ still supported, for backwards compatibility, but they do not appear in the documentation. - ------------------------------- CHANGES FROM VERSION 2.29.7 @@ -253,9 +210,6 @@ whether a partially transferred file already exists or not. (Rsync doesn't seem to care about this, but other utilities may.) - - - ------------------------------- CHANGES FROM VERSION 2.29.7 @@ -272,15 +226,11 @@ whether a partially transferred file already exists or not. (Rsync doesn't seem to care about this, but other utilities may.) - - - ------------------------------- CHANGES FROM VERSION 2.29.6 * Fix a small bug in the external copyprog setup. - ------------------------------- CHANGES FROM VERSION 2.29.5 @@ -289,8 +239,6 @@ This should hopefully make Unison a little more approachable for new users.) - - ------------------------------- CHANGES FROM VERSION 2.29.4 @@ -303,7 +251,6 @@ * Updated copyright notices to 2008. :-) - ------------------------------- CHANGES FROM VERSION 2.29.3 @@ -317,7 +264,6 @@ * Automatically supply "user@" in argument to external copy program. - ------------------------------- CHANGES FROM VERSION 2.29.1 @@ -363,13 +309,11 @@ Unison is run, it will continue filling in this temporary directory, skipping transferring files that it finds are already there. - ------------------------------- CHANGES FROM VERSION 2.28.51 * Propagating changes from 2.27 branch - ------------------------------- CHANGES FROM VERSION 2.28.51 @@ -512,7 +456,6 @@ * Add couple of missing files. - ------------------------------- CHANGES FROM VERSION 2.28.4 @@ -543,7 +486,6 @@ with fastcheck. This *might* fix the bug that Karl M. has reported. (Copying fix into trunk.) - ------------------------------- CHANGES FROM VERSION 2.28.-2 Modified: trunk/src/TODO.txt =================================================================== --- trunk/src/TODO.txt 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/TODO.txt 2009-05-02 01:57:23 UTC (rev 320) @@ -250,6 +250,16 @@ * SMALL FUNCTIONALITY IMPROVEMENTS * ================================ +**** When I tell unison to ignore a file whose name has a comma in it, + then unison adds to the preferences file a line like: + ignore = Path{this file, has a comma} + which gets interpreted as "this file" OR " has a comma". + unison should be escaping that comma and write it as \, instead. + +**** Please let me say + root = ~/bla + instead of requiring me to give an absolute path to my home dir. + **** The archive should indicate whether it is case-dependant or not. (This is important for correctness -- if the case-insensitive flag is set differently on different runs, things can get very confused!) Modified: trunk/src/abort.ml =================================================================== --- trunk/src/abort.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/abort.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/abort.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + let debug = Trace.debug "abort" let files = ref ([] : Uutil.File.t list) Modified: trunk/src/case.ml =================================================================== --- trunk/src/case.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/case.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/case.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + (* The update detector, reconciler, and transporter behave differently *) (* depending on whether the local and/or remote file system is case *) (* insensitive. This pref is set during the initial handshake if any one of *) Modified: trunk/src/case.mli =================================================================== --- trunk/src/case.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/case.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/case.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) val insensitive : unit -> bool Modified: trunk/src/checksum.ml =================================================================== --- trunk/src/checksum.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/checksum.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/checksum.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + (* The checksum (or fast fingerprinting) algorithm must be fast and has to *) (* be called in a rolling fashion (i.e. we must be able to calculate a new *) (* checksum when provided the current checksum, the outgoing character and *) Modified: trunk/src/checksum.mli =================================================================== --- trunk/src/checksum.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/checksum.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/checksum.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) type t = int type u = int array Modified: trunk/src/clroot.ml =================================================================== --- trunk/src/clroot.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/clroot.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/clroot.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + (* This file parses the unison command-line arguments that specify replicas. The syntax for replicas is based on that of Modified: trunk/src/clroot.mli =================================================================== --- trunk/src/clroot.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/clroot.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/clroot.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) (* Command-line roots *) type clroot = Modified: trunk/src/common.ml =================================================================== --- trunk/src/common.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/common.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/common.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + type hostname = string (* Canonized roots *) Modified: trunk/src/common.mli =================================================================== --- trunk/src/common.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/common.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/common.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) (***************************************************************************) (* COMMON TYPES USED BY ALL MODULES *) Modified: trunk/src/copy.ml =================================================================== --- trunk/src/copy.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/copy.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/copy.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + let (>>=) = Lwt.bind let debug = Trace.debug "copy" Modified: trunk/src/external.ml =================================================================== --- trunk/src/external.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/external.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/external.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + (*****************************************************************************) (* RUNNING EXTERNAL PROGRAMS *) (*****************************************************************************) Modified: trunk/src/external.mli =================================================================== --- trunk/src/external.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/external.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/external.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) val runExternalProgram : string -> Unix.process_status * string val readChannelTillEof : in_channel -> string Modified: trunk/src/fileinfo.ml =================================================================== --- trunk/src/fileinfo.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/fileinfo.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/fileinfo.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + let debugV = Util.debug "fileinfo+" type typ = [ `ABSENT | `FILE | `DIRECTORY | `SYMLINK ] Modified: trunk/src/fileinfo.mli =================================================================== --- trunk/src/fileinfo.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/fileinfo.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/fileinfo.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) type typ = [`ABSENT | `FILE | `DIRECTORY | `SYMLINK] val type2string : typ -> string Modified: trunk/src/files.ml =================================================================== --- trunk/src/files.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/files.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/files.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + open Common open Lwt open Fileinfo Modified: trunk/src/files.mli =================================================================== --- trunk/src/files.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/files.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/files.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) (* As usual, these functions should only be called by the client (i.e., in *) (* the same address space as the user interface). *) Modified: trunk/src/fileutil.ml =================================================================== --- trunk/src/fileutil.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/fileutil.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/fileutil.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + (* Convert backslashes in a string to forward slashes. Useful in Windows. *) let backslashes2forwardslashes s0 = try Modified: trunk/src/fileutil.mli =================================================================== --- trunk/src/fileutil.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/fileutil.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/fileutil.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) (* Convert backslashes in a string to forward slashes. Useful in Windows. *) val backslashes2forwardslashes : string -> string Modified: trunk/src/fingerprint.ml =================================================================== --- trunk/src/fingerprint.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/fingerprint.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/fingerprint.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + (* NOTE: IF YOU CHANGE TYPE "FINGERPRINT", THE ARCHIVE FORMAT CHANGES; *) (* INCREMENT "UPDATE.ARCHIVEFORMAT" *) type t = string Modified: trunk/src/fingerprint.mli =================================================================== --- trunk/src/fingerprint.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/fingerprint.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/fingerprint.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) type t Modified: trunk/src/fspath.ml =================================================================== --- trunk/src/fspath.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/fspath.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/fspath.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + (* Defines an abstract type of absolute filenames (fspaths). Keeping the *) (* type abstract lets us enforce some invariants which are important for *) (* correct behavior of some system calls. *) Modified: trunk/src/fspath.mli =================================================================== --- trunk/src/fspath.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/fspath.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/fspath.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) (* Defines an abstract type of absolute filenames (fspaths) *) Modified: trunk/src/globals.ml =================================================================== --- trunk/src/globals.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/globals.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/globals.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + open Common let debug = Trace.debug "globals" Modified: trunk/src/globals.mli =================================================================== --- trunk/src/globals.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/globals.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/globals.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) (* Global variables and functions needed by top-level modules and user *) (* interfaces *) Modified: trunk/src/linkgtk.ml =================================================================== --- trunk/src/linkgtk.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/linkgtk.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,4 +1,19 @@ (* Unison file synchronizer: src/linkgtk.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + module TopLevel = Main.Body(Uigtk.Body) Modified: trunk/src/linkgtk2.ml =================================================================== --- trunk/src/linkgtk2.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/linkgtk2.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,4 +1,19 @@ (* Unison file synchronizer: src/linkgtk2.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + module TopLevel = Main.Body(Uigtk2.Body) Modified: trunk/src/linktext.ml =================================================================== --- trunk/src/linktext.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/linktext.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,4 +1,19 @@ (* Unison file synchronizer: src/linktext.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + module TopLevel = Main.Body(Uitext.Body) Modified: trunk/src/linktk.ml =================================================================== --- trunk/src/linktk.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/linktk.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,4 +1,19 @@ (* Unison file synchronizer: src/linktk.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + module TopLevel = Main.Body(Uitk.Body) Modified: trunk/src/lock.ml =================================================================== --- trunk/src/lock.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/lock.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/lock.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + let rename oldFile newFile = begin try Unix.link oldFile newFile with Unix.Unix_error _ -> () end; let res = try (Unix.LargeFile.stat oldFile).Unix.LargeFile.st_nlink = 2 Modified: trunk/src/lock.mli =================================================================== --- trunk/src/lock.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/lock.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/lock.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) (* A simple utility module for setting and releasing inter-process locks using entries in the filesystem. *) Modified: trunk/src/lwt/pqueue.ml =================================================================== --- trunk/src/lwt/pqueue.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/lwt/pqueue.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/lwt/pqueue.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + module type OrderedType = sig type t Modified: trunk/src/lwt/pqueue.mli =================================================================== --- trunk/src/lwt/pqueue.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/lwt/pqueue.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/lwt/pqueue.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) module type OrderedType = sig Modified: trunk/src/main.ml =================================================================== --- trunk/src/main.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/main.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/main.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + (* ---------------------------------------------------------------------- *) (* This is the main program -- the thing that gets executed first when Modified: trunk/src/mkProjectInfo.ml =================================================================== --- trunk/src/mkProjectInfo.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/mkProjectInfo.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -103,3 +103,4 @@ + Modified: trunk/src/name.ml =================================================================== --- trunk/src/name.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/name.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/name.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + (* NOTE: IF YOU CHANGE TYPE "NAME", THE ARCHIVE FORMAT CHANGES; INCREMENT "UPDATE.ARCHIVEFORMAT" *) type t = string Modified: trunk/src/name.mli =================================================================== --- trunk/src/name.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/name.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/name.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) type t Modified: trunk/src/os.ml =================================================================== --- trunk/src/os.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/os.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/os.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + (* This file attempts to isolate operating system specific details from the *) (* rest of the program. *) Modified: trunk/src/os.mli =================================================================== --- trunk/src/os.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/os.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/os.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) val myCanonicalHostName : string Modified: trunk/src/osx.ml =================================================================== --- trunk/src/osx.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/osx.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/osx.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + external isMacOSXPred : unit -> bool = "isMacOSX" let isMacOSX = isMacOSXPred () Modified: trunk/src/osx.mli =================================================================== --- trunk/src/osx.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/osx.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/osx.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) val init : bool -> unit val isMacOSX : bool Modified: trunk/src/path.ml =================================================================== --- trunk/src/path.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/path.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/path.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + (* Defines an abstract type of relative pathnames *) type 'a path = string Modified: trunk/src/path.mli =================================================================== --- trunk/src/path.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/path.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/path.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) (* Abstract type of relative pathnames *) type 'a path Modified: trunk/src/pixmaps.ml =================================================================== --- trunk/src/pixmaps.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/pixmaps.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/pixmaps.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + let copyAB color = [| (* width height num_colors chars_per_pixel *) " 28 14 2 1"; Modified: trunk/src/pred.ml =================================================================== --- trunk/src/pred.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/pred.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/pred.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + let debug = Util.debug "pred" (********************************************************************) Modified: trunk/src/pred.mli =================================================================== --- trunk/src/pred.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/pred.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/pred.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) (* Predicates over paths. Modified: trunk/src/props.ml =================================================================== --- trunk/src/props.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/props.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/props.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + let debug = Util.debug "props" module type S = sig Modified: trunk/src/props.mli =================================================================== --- trunk/src/props.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/props.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/props.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) (* File properties: time, permission, length, etc. *) Modified: trunk/src/recon.ml =================================================================== --- trunk/src/recon.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/recon.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/recon.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + open Common (* ------------------------------------------------------------------------- *) Modified: trunk/src/recon.mli =================================================================== --- trunk/src/recon.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/recon.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/recon.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) val reconcileAll : Common.updateItem list Common.oneperpath Modified: trunk/src/remote.ml =================================================================== --- trunk/src/remote.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/remote.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/remote.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + (* XXX - Check exception handling Modified: trunk/src/remote.mli =================================================================== --- trunk/src/remote.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/remote.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/remote.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) module Thread : sig val unwindProtect : (unit -> 'a Lwt.t) -> (exn -> unit Lwt.t) -> 'a Lwt.t Modified: trunk/src/sortri.ml =================================================================== --- trunk/src/sortri.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/sortri.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/sortri.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + open Common let dbgsort = Util.debug "sort" Modified: trunk/src/sortri.mli =================================================================== --- trunk/src/sortri.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/sortri.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/sortri.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) (* Sort a list of recon items according to the current setting of various preferences (defined in sort.ml, and accessible from the Modified: trunk/src/stasher.ml =================================================================== --- trunk/src/stasher.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/stasher.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,7 +1,22 @@ (* Unison file synchronizer: src/stasher.ml *) (* $I2: Last modified by lescuyer *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + (* --------------------------------------------------------------------------*) (* Preferences for backing up and stashing *) Modified: trunk/src/strings.mli =================================================================== --- trunk/src/strings.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/strings.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,4 +1,4 @@ (* Unison file synchronizer: src/strings.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) val docs : (string * (string * string)) list Modified: trunk/src/test.ml =================================================================== --- trunk/src/test.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/test.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/test.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + let (>>=) = Lwt.(>>=) (* ---------------------------------------------------------------------- *) Modified: trunk/src/test.mli =================================================================== --- trunk/src/test.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/test.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/test.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) (* Internal self-tests *) Modified: trunk/src/transfer.ml =================================================================== --- trunk/src/transfer.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/transfer.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/transfer.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + (* rsync compression algorithm To compress, we use a compression buffer with a size a lot Modified: trunk/src/transfer.mli =================================================================== --- trunk/src/transfer.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/transfer.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/transfer.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) (* Rsync : general algorithm description Modified: trunk/src/transport.ml =================================================================== --- trunk/src/transport.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/transport.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/transport.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + open Common open Lwt Modified: trunk/src/transport.mli =================================================================== --- trunk/src/transport.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/transport.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/transport.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) (* Executes the actions implied by the reconItem list. *) val transportItem : Modified: trunk/src/tree.ml =================================================================== --- trunk/src/tree.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/tree.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/tree.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + type ('a, 'b) t = Node of ('a * ('a, 'b) t) list * 'b option | Leaf of 'b Modified: trunk/src/tree.mli =================================================================== --- trunk/src/tree.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/tree.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/tree.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) (* An ('a, 'b) t is a tree with 'a-labeled arcs and 'b-labeled nodes. *) (* Labeling for the internal nodes is optional *) Modified: trunk/src/ubase/rx.ml =================================================================== --- trunk/src/ubase/rx.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/ubase/rx.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,20 @@ (* Unison file synchronizer: src/ubase/rx.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + (* Inspired by some code and algorithms from Mark William Hopkins (regexp.tar.gz, available in the comp.compilers file archive) Modified: trunk/src/ubase/rx.mli =================================================================== --- trunk/src/ubase/rx.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/ubase/rx.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/ubase/rx.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) type t Modified: trunk/src/ubase/safelist.ml =================================================================== --- trunk/src/ubase/safelist.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/ubase/safelist.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/ubase/safelist.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + let filterBoth f l = let rec loop r1 r2 = function [] -> (List.rev r1, List.rev r2) Modified: trunk/src/ubase/safelist.mli =================================================================== --- trunk/src/ubase/safelist.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/ubase/safelist.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/ubase/safelist.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) (* All functions here are tail recursive and will work for arbitrary sized lists (unlike some of the standard ones). The intention is that Modified: trunk/src/ubase/trace.ml =================================================================== --- trunk/src/ubase/trace.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/ubase/trace.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/ubase/trace.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + (* ---------------------------------------------------------------------- *) (* Choosing where messages go *) Modified: trunk/src/ubase/trace.mli =================================================================== --- trunk/src/ubase/trace.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/ubase/trace.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/ubase/trace.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) (* ---------------------------------------------------------------------- *) (* Debugging support *) Modified: trunk/src/ubase/uarg.ml =================================================================== --- trunk/src/ubase/uarg.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/ubase/uarg.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/ubase/uarg.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) (* by Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* Slightly modified by BCP, July 1999 *) Modified: trunk/src/ubase/util.ml =================================================================== --- trunk/src/ubase/util.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/ubase/util.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/ubase/util.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + (*****************************************************************************) (* CASE INSENSITIVE COMPARISON *) (*****************************************************************************) Modified: trunk/src/ubase/util.mli =================================================================== --- trunk/src/ubase/util.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/ubase/util.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/ubase/util.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) (* Miscellaneous utility functions and datatypes *) Modified: trunk/src/ui.mli =================================================================== --- trunk/src/ui.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/ui.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/ui.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) (* The module Ui provides only the user interface signature. Implementations are provided by Uitext and Uitk. *) Modified: trunk/src/uicommon.ml =================================================================== --- trunk/src/uicommon.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/uicommon.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/uicommon.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + open Common open Lwt Modified: trunk/src/uicommon.mli =================================================================== --- trunk/src/uicommon.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/uicommon.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/uicommon.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) (* Kinds of UI *) type interface = Modified: trunk/src/uigtk2.ml =================================================================== --- trunk/src/uigtk2.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/uigtk2.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/uigtk2.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + open Common open Lwt Modified: trunk/src/uigtk2.mli =================================================================== --- trunk/src/uigtk2.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/uigtk2.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,4 +1,4 @@ (* Unison file synchronizer: src/uigtk2.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) module Body : Uicommon.UI Modified: trunk/src/uimacnew/uimacnew.xcodeproj/project.pbxproj =================================================================== --- trunk/src/uimacnew/uimacnew.xcodeproj/project.pbxproj 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/uimacnew/uimacnew.xcodeproj/project.pbxproj 2009-05-02 01:57:23 UTC (rev 320) @@ -669,7 +669,7 @@ baseConfigurationReference = 2E282CCC0D9AE2E800439D01 /* ExternalSettings.xcconfig */; buildSettings = { LIBRARY_SEARCH_PATHS = ""; - SDKROOT = /Developer/SDKs/MacOSX10.4u.sdk; + SDKROOT = /Developer/SDKs/MacOSX10.5.sdk; USER_HEADER_SEARCH_PATHS = $OCAMLLIBDIR; }; name = Development; Modified: trunk/src/uitext.ml =================================================================== --- trunk/src/uitext.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/uitext.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/uitext.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + open Common open Lwt Modified: trunk/src/uitext.mli =================================================================== --- trunk/src/uitext.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/uitext.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,4 +1,4 @@ (* Unison file synchronizer: src/uitext.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) module Body : Uicommon.UI Modified: trunk/src/update.ml =================================================================== --- trunk/src/update.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/update.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/update.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + open Common let (>>=) = Lwt.(>>=) @@ -650,7 +665,7 @@ ("When this preference is set, Unison will ignore any lock files " ^ "that may have been left over from a previous run of Unison that " ^ "was interrupted while reading or writing archive files; by default, " - ^ "when Unison sees these lock files it will stop and request manual" + ^ "when Unison sees these lock files it will stop and request manual " ^ "intervention. This " ^ "option should be set only if you are {\\em positive} that no other " ^ "instance of Unison might be concurrently accessing the same archive " Modified: trunk/src/update.mli =================================================================== --- trunk/src/update.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/update.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/update.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) module NameMap : Map.S with type key = Name.t Modified: trunk/src/uutil.ml =================================================================== --- trunk/src/uutil.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/uutil.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/uutil.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + (*****************************************************************************) (* Unison name and version *) (*****************************************************************************) Modified: trunk/src/uutil.mli =================================================================== --- trunk/src/uutil.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/uutil.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/uutil.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) (* This module collects a number of low-level, Unison-specific utility functions. It is kept separate from the Util module so that that module Modified: trunk/src/xferhint.ml =================================================================== --- trunk/src/xferhint.ml 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/xferhint.ml 2009-05-02 01:57:23 UTC (rev 320) @@ -1,6 +1,21 @@ (* Unison file synchronizer: src/xferhint.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + let debug = Trace.debug "xferhint" let xferbycopying = Modified: trunk/src/xferhint.mli =================================================================== --- trunk/src/xferhint.mli 2009-04-29 14:36:48 UTC (rev 319) +++ trunk/src/xferhint.mli 2009-05-02 01:57:23 UTC (rev 320) @@ -1,5 +1,5 @@ (* Unison file synchronizer: src/xferhint.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) (* This module maintains a cache that can be used to map an Os.fingerprint to a (Fspath.t * Path.t) naming a file that *may* From bcpierce at seas.upenn.edu Fri May 1 22:30:33 2009 From: bcpierce at seas.upenn.edu (Benjamin C. Pierce) Date: Fri, 1 May 2009 22:30:33 -0400 Subject: [Unison-hackers] [unison-svn] r321 - in trunk: doc src Message-ID: <200905020230.n422UXLR006632@yaws.seas.upenn.edu> Author: bcpierce Date: 2009-05-01 22:30:31 -0400 (Fri, 01 May 2009) New Revision: 321 Modified: trunk/doc/changes.tex trunk/src/RECENTNEWS trunk/src/mkProjectInfo.ml trunk/src/strings.ml Log: * Move descriptions of recent changes to documentation. Modified: trunk/doc/changes.tex =================================================================== --- trunk/doc/changes.tex 2009-05-02 01:57:23 UTC (rev 320) +++ trunk/doc/changes.tex 2009-05-02 02:30:31 UTC (rev 321) @@ -1,24 +1,142 @@ +\begin{changesfromversion}{2.31} +\item Small user interface changes +\begin{itemize} +\item Small change to text UI "scanning..." messages, to print just + directories (hopefully making it clearer that individual files are + not necessarily being fingerprinted). +\end{itemize} +\item Minor fixes and improvements: +\begin{itemize} +\item Ignore one hour differences when deciding whether a file may have + been updated. This avoids slow update detection after daylight + saving time changes under Windows. This makes Unison slightly more + likely to miss an update, but it should be safe enough. +\item Fix a small bug that was affecting mainly windows users. We need to + commit the archives at the end of the sync even if there are 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. (Changed the text UI only. It's less clear where + to change the GUI.) +\item Don't delete the temp file when a transfer fails due to a + fingerprint mismatch (so that we can have a look and see why!) We've also + added more debugging code togive more informative error messages when we + encounter the dreaded and longstanding "assert failed during file + transfer" bug +\end{itemize} +\end{changesfromversion} + +\begin{changesfromversion}{2.27} +\item If Unison is interrupted during a directory transfer, it will now +leave the partially transferred directory intact in a temporary +location. (This maintains the invariant that new files/directories are +transferred either completely or not at all.) The next time Unison is run, +it will continue filling in this temporary directory, skipping transferring +files that it finds are already there. +\item We've added experimental support for invoking an external file +transfer tool for whole-file copies instead of Unison's built-in transfer +protocol. Three new preferences have been added: +\begin{itemize} +\item {\tt copyprog} is a string giving the name (and command-line +switches, if needed) of an external program that can be used to copy large +files efficiently. By default, rsync is invoked, but other tools such as +scp can be used instead by changing the value of this preference. (Although +this is not its primary purpose, rsync is actually a pretty fast way of +copying files that don't already exist on the receiving host.) For files +that do already exist on (but that have been changed in one replica), Unison +will always use its built-in implementation of the rsync algorithm. +\item Added a "copyprogrest" preference, so that we can give different +command lines for invoking the external copy utility depending on whether a +partially transferred file already exists or not. (Rsync doesn't seem to +care about this, but other utilities may.) +\item {\tt copythreshold} is an integer (-1 by default), indicating above what +filesize (in megabytes) Unison should use the external copying utility +specified by copyprog. Specifying 0 will cause ALL copies to use the +external program; a negative number will prevent any files from using it. +(Default is -1.) +\end{itemize} +Thanks to Alan Schmitt for a huge amount of hacking and to an anonymous +sponsor for suggesting and underwriting this extension. +\item Small improvements: +\begin{itemize} +\item Added a new preference, {\tt dontchmod}. By default, Unison uses the +{\tt chmod} system call to set the permission bits of files after it has +copied them. But in some circumstances (and under some operating systems), +the chmod call always fails. Setting this preference completely prevents +Unison from ever calling {\tt chmod}. +\item Don't ignore files that look like backup files if the {\tt + backuplocation} preference is set to {\tt central} +\item Shortened the names of several preferences. The old names are also +still supported, for backwards compatibility, but they do not appear in the +documentation. +\item Lots of little documentation tidying. (In particular, preferences are +separated into Basic and Advanced! This should hopefully make Unison a +little more approachable for new users. +\item Unison can sometimes fail to transfer a file, giving the unhelpful +message "Destination updated during synchronization" even though the file +has not been changed. This can be caused by programs that change either the +file's contents \emph{or} the file's extended attributes without changing +its modification time. It's not clear what is the best fix for this -- it +is not Unison's fault, but it makes Unison's behavior puzzling -- but at +least Unison can be more helpful about suggesting a workaround (running once +with {\tt fastcheck} set to false). The failure message has been changed to +give this advice. +\item Further improvements to the OS X GUI (thanks to Alan Schmitt and Craig +Federighi). +\end{itemize} +\item Very preliminary support for triggering Unison from an external + filesystem-watching utility. The current implementation is very + simple, not efficient, and almost completely untested---not ready + for real users. But if someone wants to help improve it (e.g., + by writing a filesystem watcher for your favorite OS), please make + yourself known! + + On the Unison side, the new behavior is very simple: + \begin{itemize} + \item use the text UI + \item start Unison with the command-line flag "-repeat FOO", + where FOO is name of a file where Unison should look + for notifications of changes + \item when it starts up, Unison will read the whole contents + of this file (on both hosts), which should be a + newline-separated list of paths (relative to the root + of the synchronization) and synchronize just these paths, + as if it had been started with the "-path=xxx" option for + each one of them + \item when it finishes, it will sleep for a few seconds and then + examine the watchfile again; if anything has been added, it + will read the new paths, synchronize them, and go back to + sleep + \item that's it! + \end{itemize} + To use this to drive Unison "incrementally," just start it in + this mode and start up a tool (on each host) to watch for + new changes to the filesystem and append the appropriate paths + to the watchfile. Hopefully such tools should not be too hard + to write. +\item Bug fixes: +\begin{itemize} +\item Fixed a bug that was causing new files to be created with + permissions 0x600 instead of using a reasonable default (like + 0x644), if the 'perms' flag was set to 0. (Bug reported by Ben + Crowell.) +\item Follow maxthreads preference when transferring directories. +\end{itemize} +\end{changesfromversion} + \begin{changesfromversion}{2.17} \item Major rewrite and cleanup of the whole Mac OS X graphical user interface by Craig Federighi. Thanks, Craig!!! - \item Small fix to ctime (non-)handling in update detection under windows with fastcheck. -\end{changesfromversion} - -\begin{changesfromversion}{2.17} \item Several small fixes to the GTK2 UI to make it work better under Windows [thanks to Karl M for these]. - \item The backup functionality has been completely rewritten. The external interface has not changed, but numerous bugs, irregular behaviors, and cross-platform inconsistencies have been corrected. - \item The Unison project now accepts donations via PayPal. If you'd like to donate, you can find a link to the donation page on the \URL{http://www.cis.upenn.edu/~bcpierce/unison/lists.html}{Unison home page}. - \item Some important safety improvements: \begin{itemize} \item Added a new \verb|mountpoint| preference, which can be used to specify @@ -26,13 +144,11 @@ (otherwise Unison aborts). This can be used to avoid potentially dangerous situations when Unison is used with removable media such as external hard drives and compact flash cards. - \item The confirmation of ``big deletes'' is now controlled by a boolean preference \verb|confirmbigdeletes|. Default is true, which gives the same behavior as previously. (This functionality is at least partly superceded by the \verb|mountpoint| preference, but it has been left in place in case it is useful to some people.) - \item If Unison is asked to ``follow'' a symbolic link but there is nothing at the other end of the link, it will now flag this path as an error, rather than treating the symlink itself as missing or deleted. @@ -47,37 +163,28 @@ \item Added \verb|forcepartial| and \verb|preferpartial| preferences, which behave like \verb|force| and \verb|prefer| but can be specified on a per-path basis. [Thanks to Alan Schmitt for this.] - \item A bare-bones self test feature was added, which runs unison through some of its paces and checks that the results are as expected. The coverage of the tests is still very limited, but the facility has already been very useful in debugging the new backup functionality (especially in exposing some subtle cross-platform issues). - \item Refined debugging code so that the verbosity of individual modules can be controlled separately. Instead of just putting '-debug verbose' on the command line, you can put '-debug update+', which causes all the extra messages in the Update module, but not other modules, to be printed. Putting '-debug verbose' causes all modules to print with maximum verbosity. - \item Removed \verb|mergebatch| preference. (It never seemed very useful, and its semantics were confusing.) - \item Rewrote some of the merging functionality, for better cooperation with external Harmony instances. - \item Changed the temp file prefix from \verb|.#| to \verb|.unison|. - \item Compressed the output from the text user interface (particularly when run with the \verb|-terse| flag) to make it easier to interpret the results when Unison is run several times in succession from a script. - \item Diff and merge functions now work under Windows. - \item Changed the order of arguments to the default diff command (so that the + and - annotations in diff's output are reversed). - \item Added \verb|.mpp| files to the ``never fastcheck'' list (like \verb|.xls| files). \end{itemize} @@ -134,24 +241,20 @@ internals have been rationalized and there are a number of new features. See the manual (in particular, the description of the \verb|backupXXX| preferences) for details. - \item Incorporated patches for ipv6 support, contributed by Samuel Thibault. (Note that, due to a bug in the released OCaml 3.08.3 compiler, this code will not actually work with ipv6 unless compiled with the CVS version of the OCaml compiler, where the bug has been fixed; however, ipv4 should continue to work normally.) - \item OSX interface: \begin{itemize} \item Incorporated Ben Willmore's cool new icon for the Mac UI. \end{itemize} - \item Small fixes: \begin{itemize} \item Fixed off by one error in month numbers (in printed dates) reported by Bob Burger \end{itemize} - \end{changesfromversion} \begin{changesfromversion}{2.12.0} @@ -169,14 +272,11 @@ (without changing the major version number) and new tarballs re-released as needed. When this process converges, the patched beta version will be dubbed stable. - \item Warning (failure in batch mode) when one path is completely emptied. This prevents Unison from deleting everything on one replica when the other disappear. - \item Fix diff bug (where no difference is shown the first time the diff command is given). - \item User interface changes: \begin{itemize} \item Improved workaround for button focus problem (GTK2 UI) @@ -197,7 +297,6 @@ \item Include profile name in the GTK2 window name \item Added bindings ',' (same as '<') and '.' (same as '>') in the GTK2 UI \end{itemize} - \item Mac GUI: \begin{itemize} \item actions like < and > scroll to the next item as necessary. @@ -214,8 +313,6 @@ \item Size of left and right columns is now large enough so that "PropsChanged" is not cut off. \end{itemize} - - \item Minor changes: \begin{itemize} \item Disable multi-threading when both roots are local @@ -241,12 +338,10 @@ they occur in the diff preference \item Improvements to syncing resource forks between Macs via a non-Mac system. \end{itemize} - \end{changesfromversion} \begin{changesfromversion}{2.10.2} \item \incompatible{} Archive format has changed. - \item Source code availability: The Unison sources are now managed using Subversion. One nice side-effect is that anonymous checkout is now possible, like this: @@ -257,7 +352,6 @@ (modulo one day) sources in the web export directory. To receive commit logs for changes to the sources, subscribe to the \verb|unison-hackers| list (\ONEURL{http://www.cis.upenn.edu/~bcpierce/unison/lists.html}). - \item Text user interface: \begin{itemize} \item Substantial reworking of the internal logic of the text UI to make it @@ -266,7 +360,6 @@ the client is running on a Unix system and the {\tt EMACS} environment variable is set to anything other than the empty string. \end{itemize} - \item Native OS X gui: \begin{itemize} \item Added a synchronize menu item with keyboard shortcut @@ -274,7 +367,6 @@ \item Fixes to compile for Panther \item Miscellaneous improvements and bugfixes \end{itemize} - \item Small changes: \begin{itemize} \item Changed the filename checking code to apply to Windows only, instead @@ -316,9 +408,7 @@ Warning: the new merging functionality is not completely compatible with old versions! Check the manual for details. - \item Files larger than 2Gb are now supported. - \item Added preliminary (and still somewhat experimental) support for the Apple OS X operating system. \begin{itemize} @@ -341,7 +431,6 @@ \item Minor functionality changes: \begin{itemize} - \item Added an {\tt ignorelocks} preference, which forces Unison to override left-over archive locks. (Setting this preference is dangerous! Use it only if you are positive you know what you are doing.) @@ -357,7 +446,6 @@ {\tt assumeContentsAreImmutableNot}, which overrides the first, similarly to {\tt ignorenot}. (Later amendment: these preferences are now called {\tt immutable} and {\tt immutablenot}.) - \item The {\tt ignorecase} flag has been changed from a boolean to a three-valued preference. The default setting, called {\tt default}, checks the operating systems running on the client and server and ignores filename case if either of them is @@ -365,40 +453,33 @@ this behavior. If you have been setting {\tt ignorecase} on the command line using {\tt -ignorecase=true} or {\tt -ignorecase=false}, you will need to change to {\tt -ignorecase true} or {\tt -ignorecase false}. - \item a new preference, 'repeat', for the text user interface (only). If 'repeat' is set to a number, then, after it finishes synchronizing, Unison will wait for that many seconds and then start over, continuing this way until it is killed from outside. Setting repeat to true will automatically set the batch preference to true. - \item Excel files are now handled specially, so that the {\tt fastcheck} optimization is skipped even if the {\tt fastcheck} flag is set. (Excel does some naughty things with modtimes, making this optimization unreliable and leading to failures during change propagation.) - \item The ignorecase flag has been changed from a boolean to a three-valued preference. The default setting, called 'default', checks the operating systems running on the client and server and ignores filename case if either of them is OSX or Windows. Setting ignorecase to 'true' or 'false' overrides this behavior. - \item Added a new preference, 'repeat', for the text user interface (only, at the moment). If 'repeat' is set to a number, then, after it finishes synchronizing, Unison will wait for that many seconds and then start over, continuing this way until it is killed from outside. Setting repeat to true will automatically set the batch preference to true. - \item The 'rshargs' preference has been split into 'rshargs' and 'sshargs' (mainly to make the documentation clearer). In fact, 'rshargs' is no longer mentioned in the documentation at all, since pretty much everybody uses ssh now anyway. \end{itemize} - \item Documentation \begin{itemize} \item The web pages have been completely redesigned and reorganized. (Thanks to Alan Schmitt for help with this.) \end{itemize} - \item User interface improvements \begin{itemize} \item Added a GTK2 user interface, capable (among other things) of displaying filenames @@ -412,7 +493,6 @@ \item Several small improvements to the text user interface, including a progress display. \end{itemize} - \item Bug fixes (too numerous to count, actually, but here are some): \begin{itemize} \item The {\tt maxthreads} preference works now. @@ -432,7 +512,6 @@ \item Incorporated a fix by Dmitry Bely for setting utimes of read-only files on Win32 systems. \end{itemize} - \item Installation / portability: \begin{itemize} \item Unison now compiles with OCaml version 3.07 and later out of the box. @@ -491,11 +570,11 @@ Unix \item Small improvements: \begin{itemize} - \item If neither the {\\tt USERPROFILE} nor the {\\tt HOME} environment + \item If neither the {\tt USERPROFILE} nor the {\tt HOME} environment variables are set, then Unison will put its temporary commit log - (called {\\tt DANGER.README}) into the directory named by the - {\\tt UNISON} environment variable, if any; otherwise it will use - {\\tt C:}. + (called {\tt DANGER.README}) into the directory named by the + {\tt UNISON} environment variable, if any; otherwise it will use + {\tt C:}. \item alternative set of values for fastcheck: yes = true; no = false; default = auto. \item -silent implies -contactquietly @@ -549,7 +628,7 @@ update detection are now noted in the log file. \item \verb|[END]| messages in log now use a briefer format \item Changed the text UI startup sequence so that - {\\tt ./unison -ui text} will use the default profile instead of failing. + {\tt ./unison -ui text} will use the default profile instead of failing. \item Made some improvements to the error messages. \item Added some debugging messages to remote.ml. \end{itemize} Modified: trunk/src/RECENTNEWS =================================================================== --- trunk/src/RECENTNEWS 2009-05-02 01:57:23 UTC (rev 320) +++ trunk/src/RECENTNEWS 2009-05-02 02:30:31 UTC (rev 321) @@ -1,527 +1,6 @@ -CHANGES FROM VERSION 2.32.6 +CHANGES FROM VERSION 2.32.7 -* Update copyright notices and add GPLv3 boilerplate to .ml files - (.mli files are left with a short copyright line, to reduce clutter) +* Move descriptions of recent changes to documentation. -------------------------------- -CHANGES FROM VERSION 2.32.5 -* Update copyright notices and add GPLv3 boilerplate to .ml files - (.mli files are left with a short copyright line, to reduce clutter) - -* Ignore one hour differences for deciding whether a file may have - been updated. This avoids slow update detection after daylight - saving time changes under Windows. This makes it slightly more - likely to miss an update, but that should be safe enough. - -CHANGES FROM VERSION 2.32.4 - -* Text UI now includes the current time in its completion message - -* Fix a small bug that was affecting mainly windows users. We need to - commit the archives at the end of the sync even if there are 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. (Changed the text UI only. It's less clear where - to change the GUI.) - -* Small improvement to text UI "scanning..." messages, to print just - directories (hopefully making it clearer that individual files are - not necessarily being fingerprinted). - - ------------------------------- -CHANGES FROM VERSION 2.32.2 - -* Don't delete the temp file when a transfer fails due to a - fingerprint mismatch (so that we can have a look and see why!) - -------------------------------- -CHANGES FROM VERSION 2.32.1 - -* Applied a patch from Karl M to make the GTK2 version build with - OCaml 3.11 on Windows. - -* Don't use shortcuts or external copy programs to transfer - zero-length files (to avoid confusing status messages about - shortcut-copying completely unrelated files that happen to also have - zero length!). - -------------------------------- -CHANGES FROM VERSION 2.32.0 - -* Bumped version number to reflect newly added preference - -------------------------------- -CHANGES FROM VERSION 2.31.11 - -* Fixed a bug that was causing new files to be created with - permissions 0x600 instead of using a reasonable default (like - 0x644), if the 'perms' flag was set to 0. (Bug reported by Ben - Crowell.) - -* Added a new preference, 'dontchmod'. By default, Unison uses the - 'chmod' system call to set the permission bits of files after it has - copied them. But in some circumstances (and under some operating - systems), the chmod call always fails. Setting this preference - completely prevents Unison from ever calling chmod. - -* Add some suggestions to TODO file - -------------------------------- -CHANGES FROM VERSION 2.31.10 - -* Another slight tweak. - -------------------------------- -CHANGES FROM VERSION 2.31.9 - -* Slight tweak to the last commit, suggested by Rasmus. - -------------------------------- -CHANGES FROM VERSION 2.31.8 - -* (Forgot to add a couple of new files.) - -------------------------------- -CHANGES FROM VERSION 2.31.5 - -* A special hack for Rasmus, who has a special situation that requires - the utimes-setting program to run 'setuid root' (and we do not want - all of Unison to run setuid, so we just spin off an external utility - to do it). This functionality is disabled by default and requires - editing the source code (changing 'false' to 'true' on line 496 of - props.ml) and recompiling to enable. If there are other people that - want it, we can easily make it accessible using a preference - instead, but I prefer not to add a preference until someone else - requests it, to avoid creating an incompatible version. - -* Logging tweak. - -------------------------------- -CHANGES FROM VERSION 2.31.5 - -* A special hack for Rasmus, who has a special situation that requires - the utimes-setting program to run 'setuid root' (and we do not want - all of Unison to run setuid, so we just spin off an external utility - to do it). This functionality is disabled by default and requires - editing the source code (changing 'false' to 'true' on line 496 of - props.ml) and recompiling to enable. If there are other people that - want it, we can easily make it accessible using a preference - instead, but I prefer not to add a preference until someone else - requests it, to avoid creating an incompatible version. - -* Logging tweak. - -* Resizing the update window vertically no longer moves the status - label. Fix contributed by Pedro Melo. - -------------------------------- - -CHANGES FROM VERSION 2.31.4 - -* Don't ignore files that look like backup files if the {\\tt - backuplocation} preference is set to {\\tt central} - -------------------------------- -CHANGES FROM VERSION 2.31.3 - -* Updated documentation with recently added preferences. - -* Applied patch from Antoine Reilles for NetBSD compilation - -* Makefile tidying - -------------------------------- -CHANGES FROM VERSION 2.31.2 - -* Added a bit of debugging code for Alan. - -------------------------------- -CHANGES FROM VERSION 2.31.1 - -* Fixed a small bug with resuming interrupted file transfers when both - replicas are local. -------------------------------- -CHANGES FROM VERSION 2.31.-1 - -* Fixed a couple of file-transfer bugs. (One was about copying - resource forks. Another was about restarting interrupted transfers - on files where exactly zero bytes had been transferred so far and - the file had been created with null permissions -- believe it or - not, this is possible with rsync!) This required a protocol change, - so I'm also bumping the version number. - -------------------------------- -CHANGES FROM VERSION 2.30.4 - -* Work on text UI to prepare for new filesystem watcher functionality - -* Record some current TODO items - -------------------------------- -CHANGES FROM VERSION 2.30.3 - -* Update docs - -------------------------------- -CHANGES FROM VERSION 2.30.2 - -fix quoting for Unix - -------------------------------- -CHANGES FROM VERSION 2.30.1 - -- Fixed handling of paths containing spaces when using rsync -- Better error report for fingerprint mismatch -------------------------------- -CHANGES FROM VERSION 2.30.0 - -* A better fix for the "single file transfer failed in large directory" issue. - -------------------------------- -CHANGES FROM VERSION 2.29.9 - -* Trying a possible fix for the "assert failure in remote.ml" bug - (thanks Jerome!) - -------------------------------- -CHANGES FROM VERSION 2.29.8 - -* Updated documentation. - -* Shortened the names of several preferences. The old names are also - still supported, for backwards compatibility, but they do not appear - in the documentation. - -------------------------------- -CHANGES FROM VERSION 2.29.7 - -* Squashed a bug in transferring partially transferred directories - containing symlinks. - -* Squashed some more bugs in partial rsync transfers (rsync, oddly, - creates files with zero permissions and then on the next run - discovers that it cannot write to the file it partially wrote - before!). - -* Added a "copyprogrest" preference, so that we can give different - command lines for invoking the external copy utility depending on - whether a partially transferred file already exists or not. (Rsync - doesn't seem to care about this, but other utilities may.) - -------------------------------- -CHANGES FROM VERSION 2.29.7 - -* Squashed a bug in transferring partially transferred directories - containing symlinks. - -* Squashed some more bugs in partial rsync transfers (rsync, oddly, - creates files with zero permissions and then on the next run - discovers that it cannot write to the file it partially wrote - before!). - -* Added a "copyprogrest" preference, so that we can give different - command lines for invoking the external copy utility depending on - whether a partially transferred file already exists or not. (Rsync - doesn't seem to care about this, but other utilities may.) - -------------------------------- -CHANGES FROM VERSION 2.29.6 - -* Fix a small bug in the external copyprog setup. - -------------------------------- -CHANGES FROM VERSION 2.29.5 - -* Lots of little documentation tidying. (In particular, I finally - spent the time to separate preferences into Basic and Advanced! - This should hopefully make Unison a little more approachable for new - users.) - -------------------------------- -CHANGES FROM VERSION 2.29.4 - -* When using the internal transfer method, remove any temp file on the - destination (which may be left over from a previous interrupted run - of Unison) before starting the transfer. - -* Fixed (hopefully!) the bug causing Unison to backup the new archive - version after a (partially or fully) successful merge. - -* Updated copyright notices to 2008. :-) - -------------------------------- -CHANGES FROM VERSION 2.29.3 - -* Updated documentation to describe new features - -* Changed units of copythreshold to kilobytes - -* Added -z to flags for external rsync program -------------------------------- -CHANGES FROM VERSION 2.29.2 - -* Automatically supply "user@" in argument to external copy program. - -------------------------------- -CHANGES FROM VERSION 2.29.1 - -Follow maxthreads preference when transferring directories. -------------------------------- -CHANGES FROM VERSION 2.29.0 - -This version introduces some pretty big changes, by BCP in -collaboration with Alan Schmitt. We've tested them minimally, but -this version should be considered "only for the adventurous" for the -moment. - -* Added some more debugging code to remote.ml to give more informative - error messages when we encounter the (dreaded and longstanding) - "assert failed during file transfer" bug - -* Experimental support for invoking an external file transfer tool for - whole-file copies instead of Unison's built-in transfer protocol. - - Two new preferences have been added: - - - copyprog is a string giving the name (and command-line switches, - if needed) of an external program that can be used to copy large - files efficiently. By default, rsync is invoked, but other - tools such as scp can be used instead by changing the value of - this preference. (Although this is not its primary purpose, - rsync is actually a pretty fast way of copying files that don't - already exist on the receiving host.) For files that do already - exist on (but that have been changed in one replica), Unison - will always use its built-in implementation of the rsync - algorithm. - - - copythreshold is an integer (-1 by default), indicating above - what filesize (in megabytes) Unison should use the external - copying utility specified by copyprog. Specifying 0 will cause - ALL copies to use the external program; a negative number will - prevent any files from using it. (Default is -1.) - -* If Unison is interrupted during a directory transfer, it will now - leave the partially transferred directory intact in a temporary - location. (This maintains the invariant that new files/directories - are transferred either completely or not at all.) The next time - Unison is run, it will continue filling in this temporary directory, - skipping transferring files that it finds are already there. - -------------------------------- -CHANGES FROM VERSION 2.28.51 - -* Propagating changes from 2.27 branch - -------------------------------- -CHANGES FROM VERSION 2.28.51 - -* Propagating changes from 2.27 branch - - -------------------------------- -CHANGES FROM VERSION 2.28.45 - -* Unison can sometimes fail to transfer a file, giving the unhelpful - message "Destination updated during synchronization" even though the - file has not been changed. This can be caused by programs that - change either the file's contents *or* the file's extended - attributes without changing its modification time. I'm not sure - what is the best fix for this -- it is not Unison's fault, but it - makes Unison's behavior puzzling -- but at least Unison can be more - helpful about suggesting a workaround (running once with 'fastcheck' - set to false). The failure message has been changed to give this - advice. - -* Upgraded to GPL version 3 and added copyright notice to - documentation files. - -------------------------------- -CHANGES FROM VERSION 2.28.36 - -* Transfer changes from 2.27 branch - -------------------------------- -------------------------------- -CHANGES FROM VERSION 2.28.29 - -* Propagage changes from 2.27 branch. - - -------------------------------- -CHANGES FROM VERSION 2.28.23 - -* Small improvement to error message when no archive files are - found (thanks to Norman Ramsey). - -* Patch from Karl M for GTK2 UI: - 1) reverts the problematic (when no profile is used) - reloadProfile on the restart button. - 2) it adds a reloadProfile call after the detectCmd for - rescanning unsynchronized items. - 3) it turns off confirmBigDeletes on a rescan and checks it - before issuing a warning popup. - 4) it adjusts the status results width so that everything fits. - -------------------------------- -CHANGES FROM VERSION 2.28.17 - -* Applying a patch from Karl M to make the Restart button reload the - profile in the uigtk2 UI. - -* Fixed a bug in the merge code (new archive was not being backed up). - Minor improvements to the merge code to make it say more about what - it's doing and why. - - -------------------------------- -CHANGES FROM VERSION 2.28.16 - -More Mac UI improvements -* Revert the combo ProgressIndicator / status message (couldn't get the flicker to go away...) -* Improved file change icons - - Lighter color / slight gradient wash - - Icons for Absent (opposite side of an add) and Unmodified (opposite side of a one sided change) -- these give the line balance -* Display panel for errors occuring during Connecting... phase - -------------------------------- -CHANGES FROM VERSION 2.28.15 - -Test commit. - -------------------------------- -CHANGES FROM VERSION 2.28.13 - -* Roll back non-fix for GTK2 UI - -------------------------------- -CHANGES FROM VERSION 2.28.11 - -* Added some files left out of the previous commit. - -* Fix for GTK2 UI, suggested by Karl M - -------------------------------- -CHANGES FROM VERSION 2.28.9 - -* More Mac GUI goodness from Craig. - -Enhancements: - - Default table layout is now outline view (middle choice in outline control) - - Outline layout initial does "smart expand" to open one screen full - - Action icons - Lighter parent icons - - Icons for Left / Right work (Added, Modified, Deleted) - -Bug Fixes: - - Fix problem with file Details not showing - - Sort by Action not working - - Missing status for some items (on right) - - Reset view contents (clear recon items) when re-syncing - - Action icons -- Fix upside-down question mark - - Fix centering of "Connecting..." message when panel is resized - - Force to progress to 100% when done - -Known Issues: - -1) The most controversial "enhancement" here is the replacement of the - text for Left / Right (e.g. "Modified", "Deleted") with more - compact / colorful icons. These icons are perhaps was too "loud", - but Craig thinks that if he can tone them down a bit that this will - be an improvement. [Actually, I like them pretty well as-is.] - - Any icon artists out there? - -2) The rendering of the status message in the main ProgressIndicator - is currently leading to flicker. - -------------------------------- -CHANGES FROM VERSION 2.28.8 - -* Some more files needed for Craig's updated Mac GUI. - -------------------------------- -CHANGES FROM VERSION 2.28.6 - -* More improvements to the OSX GUI from Craig Federighi, including a very - nice new "nested directory" display style and per-file progress bars. Any - unison hackers using Macs are invited to check out the new UI and post - any bugs or suggestions for improvement to the unison-hackers list. - - (There is one known issue that sometimes causes the list of changes to be - redisplayed incorrectly after an Ignore command.) - -------------------------------- -CHANGES FROM VERSION 2.28.5 - -* Add couple of missing files. - -------------------------------- -CHANGES FROM VERSION 2.28.4 - -* Apply experimental patch from Craig Federighi, which seems to fix - the deadlocks and crashes in new OSX UI. (Actually, this is a major - rewrite and cleanup of the whole Cocoa UI.) Thanks, Craig!!! - - It would be great if some Mac users could help stress-test this fix. - -------------------------------- -CHANGES FROM VERSION 2.28.4 - -* Apply experimental patch from Craig Federighi, which seems to fix - the deadlocks and crashes in new OSX UI. (Actually, this is a major - rewrite and cleanup of the whole Cocoa UI.) Thanks, Craig!!! - - It would be great if some Mac users could help stress-test this fix. - -------------------------------- -CHANGES FROM VERSION 2.28.3 - -* Another fix to ctime (non-)handling - -------------------------------- -CHANGES FROM VERSION 2.28.1 - -* Small fix to ctime (non-)handling in update detection under windows - with fastcheck. This *might* fix the bug that Karl M. has reported. - (Copying fix into trunk.) - -------------------------------- -CHANGES FROM VERSION 2.28.-2 - -* Very preliminary support for triggering Unison from an external - filesystem-watching utility. The current implementation is very - simple, not efficient, and almost completely untested. Not ready - for real users. But if someone wants to help me improve it (e.g., - by writing a filesystem watcher for your favorite OS), please let - me know. - - On the Unison side, the new behavior is incredibly simple: - - use the text UI - - start Unison with the command-line flag "-repeat FOO", - where FOO is name of a file where Unison should look - for notifications of changes - - when it starts up, Unison will read the whole contents - of this file (on both hosts), which should be a - newline-separated list of paths (relative to the root - of the synchronization) and synchronize just these paths, - as if it had been started with the "-path=xxx" option for - each one of them - - when it finishes, it will sleep for a few seconds and then - examine the watchfile again; if anything has been added, it - will read the new paths, synchronize them, and go back to - sleep - - that's it! - - To use this to drive Unison "incrementally," just start it in - this mode and start up a tool (on each host) to watch for - new changes to the filesystem and append the appropriate paths - to the watchfile. Hopefully such tools should not be too hard - to write. - - Since I'm an OSX user, I'm particularly interested in writing a - watcher tool for this platform. If anybody knows about - programming against the Spotlight API and can give me a hand, - that would be much appreciated. - -------------------------------- Modified: trunk/src/mkProjectInfo.ml =================================================================== --- trunk/src/mkProjectInfo.ml 2009-05-02 01:57:23 UTC (rev 320) +++ trunk/src/mkProjectInfo.ml 2009-05-02 02:30:31 UTC (rev 321) @@ -104,3 +104,4 @@ + Modified: trunk/src/strings.ml =================================================================== --- trunk/src/strings.ml 2009-05-02 01:57:23 UTC (rev 320) +++ trunk/src/strings.ml 2009-05-02 02:30:31 UTC (rev 321) @@ -4,7 +4,7 @@ let docs = ("about", ("About Unison", "Unison File Synchronizer\n\ - Version 2.32.1\n\ + Version 2.32.7\n\ \n\ ")) :: @@ -1154,7 +1154,7 @@ \032-debug xxx debug module xxx ('all' -> everything, 'verbose' -> more)\n\ \032-diff xxx command for showing differences between files\n\ \032-dontchmod When set, never use the chmod system call\n\ - \032-dumbtty do not change terminal settings in text UI (default true)\n\ + \032-dumbtty do not change terminal settings in text UI\n\ \032-fastcheck xxx do fast update detection (true/false/default)\n\ \032-forcepartial xxx add a pattern to the forcepartial list\n\ \032-height n height (in lines) of main window in graphical interface\n\ @@ -1458,7 +1458,7 @@ \032 that may have been left over from a previous run of Unison that\n\ \032 was interrupted while reading or writing archive files; by\n\ \032 default, when Unison sees these lock files it will stop and\n\ - \032 request manualintervention. This option should be set only if\n\ + \032 request manual intervention. This option should be set only if\n\ \032 you are positive that no other instance of Unison might be\n\ \032 concurrently accessing the same archive files (e.g., because\n\ \032 there was only one instance of unison running and it has just\n\ @@ -2582,16 +2582,133 @@ \n\ ")) :: - ("news", ("Changes in Version 2.32.1", - "Changes in Version 2.32.1\n\ + ("news", ("Changes in Version 2.32.7", + "Changes in Version 2.32.7\n\ \n\ + \032 Changes since 2.31:\n\ + \032 * Small user interface changes\n\ + \032 + Small change to text UI \"scanning...\" messages, to print just\n\ + \032 directories (hopefully making it clearer that individual\n\ + \032 files are not necessarily being fingerprinted).\n\ + \032 * Minor fixes and improvements:\n\ + \032 + Ignore one hour differences when deciding whether a file may\n\ + \032 have been updated. This avoids slow update detection after\n\ + \032 daylight saving time changes under Windows. This makes Unison\n\ + \032 slightly more likely to miss an update, but it should be safe\n\ + \032 enough.\n\ + \032 + Fix a small bug that was affecting mainly windows users. We\n\ + \032 need to commit the archives at the end of the sync even if\n\ + \032 there are no updates to propagate because some files (in\n\ + \032 fact, if we've just switched to DST on windows, a LOT of\n\ + \032 files) might have new modtimes in the archive. (Changed the\n\ + \032 text UI only. It's less clear where to change the GUI.)\n\ + \032 + Don't delete the temp file when a transfer fails due to a\n\ + \032 fingerprint mismatch (so that we can have a look and see\n\ + \032 why!) We've also added more debugging code togive more\n\ + \032 informative error messages when we encounter the dreaded and\n\ + \032 longstanding \"assert failed during file transfer\" bug\n\ + \n\ + \032 Changes since 2.27:\n\ + \032 * If Unison is interrupted during a directory transfer, it will now\n\ + \032 leave the partially transferred directory intact in a temporary\n\ + \032 location. (This maintains the invariant that new files/directories\n\ + \032 are transferred either completely or not at all.) The next time\n\ + \032 Unison is run, it will continue filling in this temporary\n\ + \032 directory, skipping transferring files that it finds are already\n\ + \032 there.\n\ + \032 * We've added experimental support for invoking an external file\n\ + \032 transfer tool for whole-file copies instead of Unison's built-in\n\ + \032 transfer protocol. Three new preferences have been added:\n\ + \032 + copyprog is a string giving the name (and command-line\n\ + \032 switches, if needed) of an external program that can be used\n\ + \032 to copy large files efficiently. By default, rsync is\n\ + \032 invoked, but other tools such as scp can be used instead by\n\ + \032 changing the value of this preference. (Although this is not\n\ + \032 its primary purpose, rsync is actually a pretty fast way of\n\ + \032 copying files that don't already exist on the receiving\n\ + \032 host.) For files that do already exist on (but that have been\n\ + \032 changed in one replica), Unison will always use its built-in\n\ + \032 implementation of the rsync algorithm.\n\ + \032 + Added a \"copyprogrest\" preference, so that we can give\n\ + \032 different command lines for invoking the external copy\n\ + \032 utility depending on whether a partially transferred file\n\ + \032 already exists or not. (Rsync doesn't seem to care about\n\ + \032 this, but other utilities may.)\n\ + \032 + copythreshold is an integer (-1 by default), indicating above\n\ + \032 what filesize (in megabytes) Unison should use the external\n\ + \032 copying utility specified by copyprog. Specifying 0 will\n\ + \032 cause ALL copies to use the external program; a negative\n\ + \032 number will prevent any files from using it. (Default is -1.)\n\ + \032 Thanks to Alan Schmitt for a huge amount of hacking and to an\n\ + \032 anonymous sponsor for suggesting and underwriting this extension.\n\ + \032 * Small improvements:\n\ + \032 + Added a new preference, dontchmod. By default, Unison uses\n\ + \032 the chmod system call to set the permission bits of files\n\ + \032 after it has copied them. But in some circumstances (and\n\ + \032 under some operating systems), the chmod call always fails.\n\ + \032 Setting this preference completely prevents Unison from ever\n\ + \032 calling chmod.\n\ + \032 + Don't ignore files that look like backup files if the\n\ + \032 backuplocation preference is set to central\n\ + \032 + Shortened the names of several preferences. The old names are\n\ + \032 also still supported, for backwards compatibility, but they\n\ + \032 do not appear in the documentation.\n\ + \032 + Lots of little documentation tidying. (In particular,\n\ + \032 preferences are separated into Basic and Advanced! This\n\ + \032 should hopefully make Unison a little more approachable for\n\ + \032 new users.\n\ + \032 + Unison can sometimes fail to transfer a file, giving the\n\ + \032 unhelpful message \"Destination updated during\n\ + \032 synchronization\" even though the file has not been changed.\n\ + \032 This can be caused by programs that change either the file's\n\ + \032 contents or the file's extended attributes without changing\n\ + \032 its modification time. It's not clear what is the best fix\n\ + \032 for this - it is not Unison's fault, but it makes Unison's\n\ + \032 behavior puzzling - but at least Unison can be more helpful\n\ + \032 about suggesting a workaround (running once with fastcheck\n\ + \032 set to false). The failure message has been changed to give\n\ + \032 this advice.\n\ + \032 + Many improvements to the OS X GUI (thanks to Alan Schmitt and\n\ + \032 Craig Federighi), including a very nice new \"nested\n\ + \032 directory\" display style and per-file progress bars.\n\ + \032 * Very preliminary support for triggering Unison from an external\n\ + \032 filesystem-watching utility. The current implementation is very\n\ + \032 simple, not efficient, and almost completely untested--not ready\n\ + \032 for real users. But if someone wants to help improve it (e.g., by\n\ + \032 writing a filesystem watcher for your favorite OS), please make\n\ + \032 yourself known!\n\ + \032 On the Unison side, the new behavior is very simple:\n\ + \032 + use the text UI\n\ + \032 + start Unison with the command-line flag \"-repeat FOO\", where\n\ + \032 FOO is name of a file where Unison should look for\n\ + \032 notifications of changes\n\ + \032 + when it starts up, Unison will read the whole contents of\n\ + \032 this file (on both hosts), which should be a\n\ + \032 newline-separated list of paths (relative to the root of the\n\ + \032 synchronization) and synchronize just these paths, as if it\n\ + \032 had been started with the \"-path=xxx\" option for each one of\n\ + \032 them\n\ + \032 + when it finishes, it will sleep for a few seconds and then\n\ + \032 examine the watchfile again; if anything has been added, it\n\ + \032 will read the new paths, synchronize them, and go back to\n\ + \032 sleep\n\ + \032 + that's it!\n\ + \032 To use this to drive Unison \"incrementally,\" just start it in this\n\ + \032 mode and start up a tool (on each host) to watch for new changes\n\ + \032 to the filesystem and append the appropriate paths to the\n\ + \032 watchfile. Hopefully such tools should not be too hard to write.\n\ + \032 * Bug fixes:\n\ + \032 + Fixed a bug that was causing new files to be created with\n\ + \032 permissions 0x600 instead of using a reasonable default (like\n\ + \032 0x644), if the 'perms' flag was set to 0. (Bug reported by\n\ + \032 Ben Crowell.)\n\ + \032 + Follow maxthreads preference when transferring directories.\n\ + \n\ \032 Changes since 2.17:\n\ \032 * Major rewrite and cleanup of the whole Mac OS X graphical user\n\ \032 interface by Craig Federighi. Thanks, Craig!!!\n\ \032 * Small fix to ctime (non-)handling in update detection under\n\ \032 windows with fastcheck.\n\ - \n\ - \032 Changes since 2.17:\n\ \032 * Several small fixes to the GTK2 UI to make it work better under\n\ \032 Windows [thanks to Karl M for these].\n\ \032 * The backup functionality has been completely rewritten. The\n\ @@ -3017,13 +3134,10 @@ \032 * Fixed potential deadlock when synchronizing between Windows and\n\ \032 Unix\n\ \032 * Small improvements:\n\ - \032 + If neither the\n\ - \032 tt USERPROFILE nor the\n\ - \032 tt HOME environment variables are set, then Unison will put\n\ - \032 its temporary commit log (called\n\ - \032 tt DANGER.README) into the directory named by the\n\ - \032 tt UNISON environment variable, if any; otherwise it will use\n\ - \032 tt C:.\n\ + \032 + If neither the USERPROFILE nor the HOME environment variables\n\ + \032 are set, then Unison will put its temporary commit log\n\ + \032 (called DANGER.README) into the directory named by the UNISON\n\ + \032 environment variable, if any; otherwise it will use C:.\n\ \032 + alternative set of values for fastcheck: yes = true; no =\n\ \032 false; default = auto.\n\ \032 + -silent implies -contactquietly\n\ @@ -3070,9 +3184,8 @@ \032 + Paths that are not synchronized because of conflicts or\n\ \032 errors during update detection are now noted in the log file.\n\ \032 + [END] messages in log now use a briefer format\n\ - \032 + Changed the text UI startup sequence so that\n\ - \032 tt ./unison -ui text will use the default profile instead of\n\ - \032 failing.\n\ + \032 + Changed the text UI startup sequence so that ./unison -ui\n\ + \032 text will use the default profile instead of failing.\n\ \032 + Made some improvements to the error messages.\n\ \032 + Added some debugging messages to remote.ml.\n\ \n\ From bcpierce at seas.upenn.edu Fri May 1 22:31:51 2009 From: bcpierce at seas.upenn.edu (Benjamin C. Pierce) Date: Fri, 1 May 2009 22:31:51 -0400 Subject: [Unison-hackers] [unison-svn] r322 - in branches: . 2.32/doc 2.32/src 2.32/src/lwt 2.32/src/ubase 2.32/src/uimacnew/uimacnew.xcodeproj Message-ID: <200905020231.n422VpL9006699@yaws.seas.upenn.edu> Author: bcpierce Date: 2009-05-01 22:31:27 -0400 (Fri, 01 May 2009) New Revision: 322 Added: branches/2.32/ branches/2.32/doc/changes.tex branches/2.32/src/Makefile.OCaml branches/2.32/src/RECENTNEWS branches/2.32/src/TODO.txt branches/2.32/src/abort.ml branches/2.32/src/case.ml branches/2.32/src/case.mli branches/2.32/src/checksum.ml branches/2.32/src/checksum.mli branches/2.32/src/clroot.ml branches/2.32/src/clroot.mli branches/2.32/src/common.ml branches/2.32/src/common.mli branches/2.32/src/copy.ml branches/2.32/src/external.ml branches/2.32/src/external.mli branches/2.32/src/fileinfo.ml branches/2.32/src/fileinfo.mli branches/2.32/src/files.ml branches/2.32/src/files.mli branches/2.32/src/fileutil.ml branches/2.32/src/fileutil.mli branches/2.32/src/fingerprint.ml branches/2.32/src/fingerprint.mli branches/2.32/src/fspath.ml branches/2.32/src/fspath.mli branches/2.32/src/globals.ml branches/2.32/src/globals.mli branches/2.32/src/linkgtk.ml branches/2.32/src/linkgtk2.ml branches/2.32/src/linktext.ml branches/2.32/src/linktk.ml branches/2.32/src/lock.ml branches/2.32/src/lock.mli branches/2.32/src/lwt/pqueue.ml branches/2.32/src/lwt/pqueue.mli branches/2.32/src/main.ml branches/2.32/src/mkProjectInfo.ml branches/2.32/src/name.ml branches/2.32/src/name.mli branches/2.32/src/os.ml branches/2.32/src/os.mli branches/2.32/src/osx.ml branches/2.32/src/osx.mli branches/2.32/src/path.ml branches/2.32/src/path.mli branches/2.32/src/pixmaps.ml branches/2.32/src/pred.ml branches/2.32/src/pred.mli branches/2.32/src/props.ml branches/2.32/src/props.mli branches/2.32/src/recon.ml branches/2.32/src/recon.mli branches/2.32/src/remote.ml branches/2.32/src/remote.mli branches/2.32/src/sortri.ml branches/2.32/src/sortri.mli branches/2.32/src/stasher.ml branches/2.32/src/strings.ml branches/2.32/src/strings.mli branches/2.32/src/test.ml branches/2.32/src/test.mli branches/2.32/src/transfer.ml branches/2.32/src/transfer.mli branches/2.32/src/transport.ml branches/2.32/src/transport.mli branches/2.32/src/tree.ml branches/2.32/src/tree.mli branches/2.32/src/ubase/rx.ml branches/2.32/src/ubase/rx.mli branches/2.32/src/ubase/safelist.ml branches/2.32/src/ubase/safelist.mli branches/2.32/src/ubase/trace.ml branches/2.32/src/ubase/trace.mli branches/2.32/src/ubase/uarg.ml branches/2.32/src/ubase/util.ml branches/2.32/src/ubase/util.mli branches/2.32/src/ui.mli branches/2.32/src/uicommon.ml branches/2.32/src/uicommon.mli branches/2.32/src/uigtk2.ml branches/2.32/src/uigtk2.mli branches/2.32/src/uimacnew/uimacnew.xcodeproj/project.pbxproj branches/2.32/src/uitext.ml branches/2.32/src/uitext.mli branches/2.32/src/update.ml branches/2.32/src/update.mli branches/2.32/src/uutil.ml branches/2.32/src/uutil.mli branches/2.32/src/xferhint.ml branches/2.32/src/xferhint.mli Removed: branches/2.32/doc/changes.tex branches/2.32/src/Makefile.OCaml branches/2.32/src/RECENTNEWS branches/2.32/src/TODO.txt branches/2.32/src/abort.ml branches/2.32/src/case.ml branches/2.32/src/case.mli branches/2.32/src/checksum.ml branches/2.32/src/checksum.mli branches/2.32/src/clroot.ml branches/2.32/src/clroot.mli branches/2.32/src/common.ml branches/2.32/src/common.mli branches/2.32/src/copy.ml branches/2.32/src/external.ml branches/2.32/src/external.mli branches/2.32/src/fileinfo.ml branches/2.32/src/fileinfo.mli branches/2.32/src/files.ml branches/2.32/src/files.mli branches/2.32/src/fileutil.ml branches/2.32/src/fileutil.mli branches/2.32/src/fingerprint.ml branches/2.32/src/fingerprint.mli branches/2.32/src/fspath.ml branches/2.32/src/fspath.mli branches/2.32/src/globals.ml branches/2.32/src/globals.mli branches/2.32/src/linkgtk.ml branches/2.32/src/linkgtk2.ml branches/2.32/src/linktext.ml branches/2.32/src/linktk.ml branches/2.32/src/lock.ml branches/2.32/src/lock.mli branches/2.32/src/lwt/pqueue.ml branches/2.32/src/lwt/pqueue.mli branches/2.32/src/main.ml branches/2.32/src/mkProjectInfo.ml branches/2.32/src/name.ml branches/2.32/src/name.mli branches/2.32/src/os.ml branches/2.32/src/os.mli branches/2.32/src/osx.ml branches/2.32/src/osx.mli branches/2.32/src/path.ml branches/2.32/src/path.mli branches/2.32/src/pixmaps.ml branches/2.32/src/pred.ml branches/2.32/src/pred.mli branches/2.32/src/props.ml branches/2.32/src/props.mli branches/2.32/src/recon.ml branches/2.32/src/recon.mli branches/2.32/src/remote.ml branches/2.32/src/remote.mli branches/2.32/src/sortri.ml branches/2.32/src/sortri.mli branches/2.32/src/stasher.ml branches/2.32/src/strings.ml branches/2.32/src/strings.mli branches/2.32/src/test.ml branches/2.32/src/test.mli branches/2.32/src/transfer.ml branches/2.32/src/transfer.mli branches/2.32/src/transport.ml branches/2.32/src/transport.mli branches/2.32/src/tree.ml branches/2.32/src/tree.mli branches/2.32/src/ubase/rx.ml branches/2.32/src/ubase/rx.mli branches/2.32/src/ubase/safelist.ml branches/2.32/src/ubase/safelist.mli branches/2.32/src/ubase/trace.ml branches/2.32/src/ubase/trace.mli branches/2.32/src/ubase/uarg.ml branches/2.32/src/ubase/util.ml branches/2.32/src/ubase/util.mli branches/2.32/src/ui.mli branches/2.32/src/uicommon.ml branches/2.32/src/uicommon.mli branches/2.32/src/uigtk2.ml branches/2.32/src/uigtk2.mli branches/2.32/src/uimacnew/uimacnew.xcodeproj/project.pbxproj branches/2.32/src/uitext.ml branches/2.32/src/uitext.mli branches/2.32/src/update.ml branches/2.32/src/update.mli branches/2.32/src/uutil.ml branches/2.32/src/uutil.mli branches/2.32/src/xferhint.ml branches/2.32/src/xferhint.mli Log: New release branch Copied: branches/2.32 (from rev 319, trunk) Deleted: branches/2.32/doc/changes.tex =================================================================== --- trunk/doc/changes.tex 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/doc/changes.tex 2009-05-02 02:31:27 UTC (rev 322) @@ -1,1534 +0,0 @@ -\begin{changesfromversion}{2.17} -\item Major rewrite and cleanup of the whole Mac OS X graphical user -interface by Craig Federighi. Thanks, Craig!!! - -\item Small fix to ctime (non-)handling in update detection under windows - with fastcheck. -\end{changesfromversion} - -\begin{changesfromversion}{2.17} -\item Several small fixes to the GTK2 UI to make it work better under -Windows [thanks to Karl M for these]. - -\item The backup functionality has been completely rewritten. The external -interface has not changed, but numerous bugs, irregular behaviors, and -cross-platform inconsistencies have been corrected. - -\item The Unison project now accepts donations via PayPal. If you'd like to -donate, you can find a link to the donation page on the -\URL{http://www.cis.upenn.edu/~bcpierce/unison/lists.html}{Unison home - page}. - -\item Some important safety improvements: -\begin{itemize} -\item Added a new \verb|mountpoint| preference, which can be used to specify -a path that must exist in both replicas at the end of update detection -(otherwise Unison aborts). This can be used to avoid potentially dangerous -situations when Unison is used with removable media such as external hard -drives and compact flash cards. - -\item The confirmation of ``big deletes'' is now controlled by a boolean preference - \verb|confirmbigdeletes|. Default is true, which gives the same behavior as - previously. (This functionality is at least partly superceded by the - \verb|mountpoint| preference, but it has been left in place in case it is - useful to some people.) - - \item If Unison is asked to ``follow'' a symbolic link but there is - nothing at the other end of the link, it will now flag this path as an - error, rather than treating the symlink itself as missing or deleted. - This avoids a potentially dangerous situation where a followed symlink - points to an external filesystem that might be offline when Unison is run - (whereupon Unison would cheerfully delete the corresponding files in the - other replica!). -\end{itemize} - -\item Smaller changes: -\begin{itemize} -\item Added \verb|forcepartial| and \verb|preferpartial| preferences, which -behave like \verb|force| and \verb|prefer| but can be specified on a -per-path basis. [Thanks to Alan Schmitt for this.] - -\item A bare-bones self test feature was added, which runs unison through - some of its paces and checks that the results are as expected. The - coverage of the tests is still very limited, but the facility has already - been very useful in debugging the new backup functionality (especially in - exposing some subtle cross-platform issues). - -\item Refined debugging code so that the verbosity of individual modules - can be controlled separately. Instead of just putting '-debug - verbose' on the command line, you can put '-debug update+', which - causes all the extra messages in the Update module, but not other - modules, to be printed. Putting '-debug verbose' causes all modules - to print with maximum verbosity. - -\item Removed \verb|mergebatch| preference. (It never seemed very useful, and - its semantics were confusing.) - -\item Rewrote some of the merging functionality, for better cooperation - with external Harmony instances. - -\item Changed the temp file prefix from \verb|.#| to \verb|.unison|. - -\item Compressed the output from the text user interface (particularly - when run with the \verb|-terse| flag) to make it easier to interpret the - results when Unison is run several times in succession from a script. - -\item Diff and merge functions now work under Windows. - -\item Changed the order of arguments to the default diff command (so that - the + and - annotations in diff's output are reversed). - -\item Added \verb|.mpp| files to the ``never fastcheck'' list (like -\verb|.xls| files). -\end{itemize} - -\item Many small bugfixes, including: -\begin{itemize} -\item Fixed a longstanding bug regarding fastcheck and daylight saving time - under Windows when Unison is set up to synchronize modification times. - (Modification times cannot be updated in the archive in this case, - so we have to ignore one hour differences.) -\item Fixed a bug that would occasionally cause the archives to be left in - non-identical states on the two hosts after synchronization. -\item Fixed a bug that prevented Unison from communicating correctly between - 32- and 64-bit architectures. -\item On windows, file creation times are no longer used as a proxy for - inode numbers. (This is unfortunate, as it makes fastcheck a little less - safe. But it turns out that file creation times are not reliable - under Windows: if a file is removed and a new file is created in its - place, the new one will sometimes be given the same creation date as the - old one!) -\item Set read-only file to R/W on OSX before attempting to change other attributes. -\item Fixed bug resulting in spurious "Aborted" errors during transport -(thanks to Jerome Vouillon) -\item Enable diff if file contents have changed in one replica, but -only properties in the other. -\item Removed misleading documentation for 'repeat' preference. -\item Fixed a bug in merging code where Unison could sometimes deadlock - with the external merge program, if the latter produced large - amounts of output. -\item Workaround for a bug compiling gtk2 user interface against current versions - of gtk2+ libraries. -\item Added a better error message for "ambiguous paths". -\item Squashed a longstanding bug that would cause file transfer to fail - with the message ``Failed: Error in readWrite: Is a directory.'' -\item Replaced symlinks with copies of their targets in the Growl framework in src/uimac. - This should make the sources easier to check out from the svn repository on WinXP - systems. -\item Added a workaround (suggested by Karl M.) for the problem discussed - on the unison users mailing list where, on the Windows platform, the - server would hang when transferring files. I conjecture that - the problem has to do with the RPC mechanism, which was used to - make a call {\em back} from the server to the client (inside the Trace.log - function) so that the log message would be appended to the log file on - the client. The workaround is to dump these messages (about when - xferbycopying shortcuts are applied and whether they succeed) just to the - standard output of the Unison process, not to the log file. -\end{itemize} -\end{changesfromversion} - -\begin{changesfromversion}{2.13.0} -\item The features for performing backups and for invoking external merge -programs have been completely rewritten by Stephane Lescuyer (thanks, -Stephane!). The user-visible functionality should not change, but the -internals have been rationalized and there are a number of new features. -See the manual (in particular, the description of the \verb|backupXXX| -preferences) for details. - -\item Incorporated patches for ipv6 support, contributed by Samuel Thibault. -(Note that, due to a bug in the released OCaml 3.08.3 compiler, this code -will not actually work with ipv6 unless compiled with the CVS version of the -OCaml compiler, where the bug has been fixed; however, ipv4 should continue -to work normally.) - -\item OSX interface: -\begin{itemize} -\item Incorporated Ben Willmore's cool new icon for the Mac UI. -\end{itemize} - -\item Small fixes: -\begin{itemize} -\item Fixed off by one error in month numbers (in printed dates) reported - by Bob Burger -\end{itemize} - -\end{changesfromversion} - -\begin{changesfromversion}{2.12.0} -\item New convention for release numbering: Releases will continue to be -given numbers of the form \verb|X.Y.Z|, but, -from now on, just the major version number (\verb|X.Y|) will be considered -significant when checking compatibility between client and server versions. -The third component of the version number will be used only to identify -``patch levels'' of releases. - -This change goes hand in hand with a change to the procedure for making new -releases. Candidate releases will initially be given ``beta release'' -status when they are announced for public consumption. Any bugs that are -discovered will be fixed in a separate branch of the source repository -(without changing the major version number) and new tarballs re-released as -needed. When this process converges, the patched beta version will be -dubbed stable. - -\item Warning (failure in batch mode) when one path is completely emptied. - This prevents Unison from deleting everything on one replica when - the other disappear. - -\item Fix diff bug (where no difference is shown the first time the diff - command is given). - -\item User interface changes: -\begin{itemize} -\item Improved workaround for button focus problem (GTK2 UI) -\item Put leading zeroes in date fields -\item More robust handling of character encodings in GTK2 UI -\item Changed format of modification time displays, from \verb|modified at hh:mm:ss on dd MMM, yyyy| -to \verb|modified on yyyy-mm-dd hh:mm:ss| -\item Changed time display to include seconds (so that people on FAT - filesystems will not be confused when Unison tries to update a file - time to an odd number of seconds and the filesystem truncates it to - an even number!) -\item Use the diff "-u" option by default when showing differences between files - (the output is more readable) -\item In text mode, pipe the diff output to a pager if the environment - variable PAGER is set -\item Bug fixes and cleanups in ssh password prompting. Now works with - the GTK2 UI under Linux. (Hopefully the Mac OS X one is not broken!) -\item Include profile name in the GTK2 window name -\item Added bindings ',' (same as '<') and '.' (same as '>') in the GTK2 UI -\end{itemize} - -\item Mac GUI: -\begin{itemize} -\item actions like < and > scroll to the next item as necessary. -\item Restart has a menu item and keyboard shortcut (command-R). -\item - Added a command-line tool for Mac OS X. It can be installed from - the Unison menu. -\item New icon. -\item Handle the "help" command-line argument properly. -\item Handle profiles given on the command line properly. -\item When a profile has been selected, the profile dialog is replaced by a - "connecting" message while the connection is being made. This - gives better feedback. -\item Size of left and right columns is now large enough so that - "PropsChanged" is not cut off. -\end{itemize} - - -\item Minor changes: -\begin{itemize} -\item Disable multi-threading when both roots are local -\item Improved error handling code. In particular, make sure all files - are closed in case of a transient failure -\item Under Windows, use \verb|$UNISON| for home directory as a last resort - (it was wrongly moved before \verb|$HOME| and \verb|$USERPROFILE| in - Unison 2.12.0) -\item Reopen the logfile if its name changes (profile change) -\item Double-check that permissions and modification times have been - properly set: there are some combination of OS and filesystem on - which setting them can fail in a silent way. -\item Check for bad Windows filenames for pure Windows synchronization - also (not just cross architecture synchronization). - This way, filenames containing backslashes, which are not correctly - handled by unison, are rejected right away. -\item Attempt to resolve issues with synchronizing modification times - of read-only files under Windows -\item Ignore chmod failures when deleting files -\item Ignore trailing dots in filenames in case insensitive mode -\item Proper quoting of paths, files and extensions ignored using the UI -\item The strings CURRENT1 and CURRENT2 are now correctly substitued when - they occur in the diff preference -\item Improvements to syncing resource forks between Macs via a non-Mac system. -\end{itemize} - -\end{changesfromversion} - -\begin{changesfromversion}{2.10.2} -\item \incompatible{} Archive format has changed. - -\item Source code availability: The Unison sources are now managed using - Subversion. One nice side-effect is that anonymous checkout is now - possible, like this: -\begin{verbatim} - svn co https://cvs.cis.upenn.edu:3690/svnroot/unison/ -\end{verbatim} -We will also continue to export a ``developer tarball'' of the current -(modulo one day) sources in the web export directory. To receive commit logs -for changes to the sources, subscribe to the \verb|unison-hackers| list -(\ONEURL{http://www.cis.upenn.edu/~bcpierce/unison/lists.html}). - -\item Text user interface: -\begin{itemize} -\item Substantial reworking of the internal logic of the text UI to make it -a bit easier to modify. -\item The {\tt dumbtty} flag in the text UI is automatically set to true if -the client is running on a Unix system and the {\tt EMACS} environment -variable is set to anything other than the empty string. -\end{itemize} - -\item Native OS X gui: -\begin{itemize} -\item Added a synchronize menu item with keyboard shortcut -\item Added a merge menu item, still needs to be debugged -\item Fixes to compile for Panther -\item Miscellaneous improvements and bugfixes -\end{itemize} - -\item Small changes: -\begin{itemize} -\item Changed the filename checking code to apply to Windows only, instead - of OS X as well. -\item Finder flags now synchronized -\item Fallback in copy.ml for filesystem that do not support \verb|O_EXCL| -\item Changed buffer size for local file copy (was highly inefficient with - synchronous writes) -\item Ignore chmod failure when deleting a directory -\item Fixed assertion failure when resolving a conflict content change / - permission changes in favor of the content change. -\item Workaround for transferring large files using rsync. -\item Use buffered I/O for files (this is the only way to open files in binary - mode under Cygwin). -\item On non-Cygwin Windows systems, the UNISON environment variable is now checked first to determine - where to look for Unison's archive and preference files, followed by \verb|HOME| and - \verb|USERPROFILE| in that order. On Unix and Cygwin systems, \verb|HOME| is used. -\item Generalized \verb|diff| preference so that it can be given either as just - the command name to be used for calculating diffs or else a whole command - line, containing the strings \verb|CURRENT1| and \verb|CURRENT2|, which will be replaced - by the names of the files to be diff'ed before the command is called. -\item Recognize password prompts in some newer versions of ssh. -\end{itemize} -\end{changesfromversion} - -\begin{changesfromversion}{2.9.20} -\item \incompatible{} Archive format has changed. -\item Major functionality changes: -\begin{itemize} -\item Major tidying and enhancement of 'merge' functionality. The main - user-visible change is that the external merge program may either write - the merged output to a single new file, as before, or it may modify one or - both of its input files, or it may write {\em two} new files. In the - latter cases, its modifications will be copied back into place on both the - local and the remote host, and (if the two files are now equal) the - archive will be updated appropriately. More information can be found in - the user manual. Thanks to Malo Denielou and Alan Schmitt for these - improvements. - - Warning: the new merging functionality is not completely compatible with - old versions! Check the manual for details. - -\item Files larger than 2Gb are now supported. - -\item Added preliminary (and still somewhat experimental) support for the - Apple OS X operating system. -\begin{itemize} -\item Resource forks should be transferred correctly. (See the manual for -details of how this works when synchronizing HFS with non-HFS volumes.) -Synchronization of file type and creator information is also supported. -\item On OSX systems, the name of the directory for storing Unison's -archives, preference files, etc., is now determined as follows: -\begin{itemize} - \item if \verb+~/.unison+ exists, use it - \item otherwise, use \verb|~/Library/Application Support/Unison|, - creating it if necessary. -\end{itemize} -\item A preliminary native-Cocoa user interface is under construction. This -still needs some work, and some users experience unpredictable crashes, so -it is only for hackers for now. Run make with {\tt UISTYLE=mac} to build -this interface. -\end{itemize} -\end{itemize} - -\item Minor functionality changes: -\begin{itemize} - -\item Added an {\tt ignorelocks} preference, which forces Unison to override left-over - archive locks. (Setting this preference is dangerous! Use it only if you - are positive you know what you are doing.) -% BCP: removed later -% \item Running with the {\tt -timers} flag set to true will now show the total time taken -% to check for updates on each directory. (This can be helpful for tidying directories to improve -% update detection times.) -\item Added a new preference {\tt assumeContentsAreImmutable}. If a directory - matches one of the patterns set in this preference, then update detection - is skipped for files in this directory. (The - purpose is to speed update detection for cases like Mail folders, which - contain lots and lots of immutable files.) Also a preference - {\tt assumeContentsAreImmutableNot}, which overrides the first, similarly - to {\tt ignorenot}. (Later amendment: these preferences are now called - {\tt immutable} and {\tt immutablenot}.) - -\item The {\tt ignorecase} flag has been changed from a boolean to a three-valued - preference. The default setting, called {\tt default}, checks the operating systems - running on the client and server and ignores filename case if either of them is - OSX or Windows. Setting ignorecase to {\tt true} or {\tt false} overrides - this behavior. If you have been setting {\tt ignorecase} on the command - line using {\tt -ignorecase=true} or {\tt -ignorecase=false}, you will - need to change to {\tt -ignorecase true} or {\tt -ignorecase false}. - -\item a new preference, 'repeat', for the text user interface (only). If 'repeat' is set to - a number, then, after it finishes synchronizing, Unison will wait for that many seconds and - then start over, continuing this way until it is killed from outside. Setting repeat to true - will automatically set the batch preference to true. - -\item Excel files are now handled specially, so that the {\tt fastcheck} - optimization is skipped even if the {\tt fastcheck} flag is set. (Excel - does some naughty things with modtimes, making this optimization - unreliable and leading to failures during change propagation.) - -\item The ignorecase flag has been changed from a boolean to a three-valued - preference. The default setting, called 'default', checks the operating systems - running on the client and server and ignores filename case if either of them is - OSX or Windows. Setting ignorecase to 'true' or 'false' overrides this behavior. - -\item Added a new preference, 'repeat', for the text user interface (only, - at the moment). If 'repeat' is set to a number, then, after it finishes - synchronizing, Unison will wait for that many seconds and then start over, - continuing this way until it is killed from outside. Setting repeat to - true will automatically set the batch preference to true. - -\item The 'rshargs' preference has been split into 'rshargs' and 'sshargs' - (mainly to make the documentation clearer). In fact, 'rshargs' is no longer - mentioned in the documentation at all, since pretty much everybody uses - ssh now anyway. -\end{itemize} - -\item Documentation -\begin{itemize} -\item The web pages have been completely redesigned and reorganized. - (Thanks to Alan Schmitt for help with this.) -\end{itemize} - -\item User interface improvements -\begin{itemize} -\item Added a GTK2 user interface, capable (among other things) of displaying filenames - in any locale encoding. Kudos to Stephen Tse for contributing this code! -\item The text UI now prints a list of failed and skipped transfers at the end of - synchronization. -\item Restarting update detection from the graphical UI will reload the current - profile (which in particular will reset the -path preference, in case - it has been narrowed by using the ``Recheck unsynchronized items'' - command). -\item Several small improvements to the text user interface, including a - progress display. -\end{itemize} - -\item Bug fixes (too numerous to count, actually, but here are some): -\begin{itemize} -\item The {\tt maxthreads} preference works now. -\item Fixed bug where warning message about uname returning an unrecognized - result was preventing connection to server. (The warning is no longer - printed, and all systems where 'uname' returns anything other than 'Darwin' - are assumed not to be running OS X.) -\item Fixed a problem on OS X that caused some valid file names (e.g., - those including colons) to be considered invalid. -\item Patched Path.followLink to follow links under cygwin in addition to Unix - (suggested by Matt Swift). -\item Small change to the storeRootsName function, suggested by bliviero at - ichips.intel.com, to fix a problem in unison with the `rootalias' - option, which allows you to tell unison that two roots contain the same - files. Rootalias was being applied after the hosts were - sorted, so it wouldn't work properly in all cases. -\item Incorporated a fix by Dmitry Bely for setting utimes of read-only files - on Win32 systems. -\end{itemize} - -\item Installation / portability: -\begin{itemize} -\item Unison now compiles with OCaml version 3.07 and later out of the box. -\item Makefile.OCaml fixed to compile out of the box under OpenBSD. -\item a few additional ports (e.g. OpenBSD, Zaurus/IPAQ) are now mentioned in - the documentation -\item Unison can now be installed easily on OSX systems using the Fink - package manager -\end{itemize} -\end{changesfromversion} - -\begin{changesfromversion}{2.9.1} -\item Added a preference {\tt maxthreads} that can be used to limit the -number of simultaneous file transfers. -\item Added a {\tt backupdir} preference, which controls where backup -files are stored. -\item Basic support added for OSX. In particular, Unison now recognizes -when one of the hosts being synchronized is running OSX and switches to -a case-insensitive treatment of filenames (i.e., 'foo' and 'FOO' are -considered to be the same file). - (OSX is not yet fully working, - however: in particular, files with resource forks will not be - synchronized correctly.) -\item The same hash used to form the archive name is now also added to -the names of the temp files created during file transfer. The reason for -this is that, during update detection, we are going to silently delete -any old temp files that we find along the way, and we want to prevent -ourselves from deleting temp files belonging to other instances of Unison -that may be running in parallel, e.g. synchronizing with a different -host. Thanks to Ruslan Ermilov for this suggestion. -\item Several small user interface improvements -\item Documentation -\begin{itemize} -\item FAQ and bug reporting instructions have been split out as separate - HTML pages, accessible directly from the unison web page. -\item Additions to FAQ, in particular suggestions about performance -tuning. -\end{itemize} -\item Makefile -\begin{itemize} -\item Makefile.OCaml now sets UISTYLE=text or UISTYLE=gtk automatically, - depending on whether it finds lablgtk installed -\item Unison should now compile ``out of the box'' under OSX -\end{itemize} -\end{changesfromversion} - -\begin{changesfromversion}{2.8.1} -\item Changing profile works again under Windows -\item File movement optimization: Unison now tries to use local copy instead of - transfer for moved or copied files. It is controled by a boolean option - ``xferbycopying''. -\item Network statistics window (transfer rate, amount of data transferred). - [NB: not available in Windows-Cygwin version.] -\item symlinks work under the cygwin version (which is dynamically linked). -\item Fixed potential deadlock when synchronizing between Windows and -Unix -\item Small improvements: - \begin{itemize} - \item If neither the {\\tt USERPROFILE} nor the {\\tt HOME} environment - variables are set, then Unison will put its temporary commit log - (called {\\tt DANGER.README}) into the directory named by the - {\\tt UNISON} environment variable, if any; otherwise it will use - {\\tt C:}. - \item alternative set of values for fastcheck: yes = true; no = false; - default = auto. - \item -silent implies -contactquietly - \end{itemize} -\item Source code: - \begin{itemize} - \item Code reorganization and tidying. (Started breaking up some of the - basic utility modules so that the non-unison-specific stuff can be - made available for other projects.) - \item several Makefile and docs changes (for release); - \item further comments in ``update.ml''; - \item connection information is not stored in global variables anymore. - \end{itemize} -\end{changesfromversion} - -\begin{changesfromversion}{2.7.78} -\item Small bugfix to textual user interface under Unix (to avoid leaving - the terminal in a bad state where it would not echo inputs after Unison - exited). -\end{changesfromversion} - -\begin{changesfromversion}{2.7.39} -\item Improvements to the main web page (stable and beta version docs are - now both accessible). -\item User manual revised. -\item Added some new preferences: -\begin{itemize} -\item ``sshcmd'' and ``rshcmd'' for specifying paths to ssh and rsh programs. -\item ``contactquietly'' for suppressing the ``contacting server'' message -during Unison startup (under the graphical UI). -\end{itemize} -\item Bug fixes: -\begin{itemize} -\item Fixed small bug in UI that neglected to change the displayed column - headers if loading a new profile caused the roots to change. -\item Fixed a bug that would put the text UI into an infinite loop if it - encountered a conflict when run in batch mode. -\item Added some code to try to fix the display of non-Ascii characters in - filenames on Windows systems in the GTK UI. (This code is currently - untested---if you're one of the people that had reported problems with - display of non-ascii filenames, we'd appreciate knowing if this actually - fixes things.) -\item `\verb|-prefer/-force newer|' works properly now. - (The bug was reported by Sebastian Urbaniak and Sean Fulton.) -\end{itemize} -\item User interface and Unison behavior: -\begin{itemize} -\item Renamed `Proceed' to `Go' in the graphical UI. -\item Added exit status for the textual user interface. -\item Paths that are not synchronized because of conflicts or errors during - update detection are now noted in the log file. -\item \verb|[END]| messages in log now use a briefer format -\item Changed the text UI startup sequence so that - {\\tt ./unison -ui text} will use the default profile instead of failing. -\item Made some improvements to the error messages. -\item Added some debugging messages to remote.ml. -\end{itemize} -\end{changesfromversion} - -\begin{changesfromversion}{2.7.7} -\item Incorporated, once again, a multi-threaded transport sub-system. - It transfers several files at the same time, thereby making much - more effective use of available network bandwidth. Unlike the - earlier attempt, this time we do not rely on the native thread - library of OCaml. Instead, we implement a light-weight, - non-preemptive multi-thread library in OCaml directly. This version - appears stable. - - Some adjustments to unison are made to accommodate the multi-threaded - version. These include, in particular, changes to the - user interface and logging, for example: - \begin{itemize} - \item Two log entries for each transferring task, one for the - beginning, one for the end. - \item Suppressed warning messages against removing temp files left - by a previous unison run, because warning does not work nicely - under multi-threading. The temp file names are made less likely - to coincide with the name of a file created by the user. They - take the form \\ \verb|.#..unison.tmp|. - [N.b. This was later changed to \verb|.unison...unison.tmp|.] - \end{itemize} -\item Added a new command to the GTK user interface: pressing 'f' causes - Unison to start a new update detection phase, using as paths {\em just} - those paths that have been detected as changed and not yet marked as - successfully completed. Use this command to quickly restart Unison on - just the set of paths still needing attention after a previous run. -\item Made the {\tt ignorecase} preference user-visible, and changed the - initialization code so that it can be manually set to true, even if - neither host is running Windows. (This may be useful, e.g., when using - Unison running on a Unix system with a FAT volume mounted.) -\item Small improvements and bug fixes: - \begin{itemize} - \item Errors in preference files now generate fatal errors rather than - warnings at startup time. (I.e., you can't go on from them.) Also, - we fixed a bug that was preventing these warnings from appearing in the - text UI, so some users who have been running (unsuspectingly) with - garbage in their prefs files may now get error reports. - \item Error reporting for preference files now provides file name and - line number. - \item More intelligible message in the case of identical change to the same - files: ``Nothing to do: replicas have been changed only in identical - ways since last sync.'' - \item Files with prefix '.\#' excluded when scanning for preference - files. - \item Rsync instructions are send directly instead of first - marshaled. - \item Won't try forever to get the fingerprint of a continuously changing file: - unison will give up after certain number of retries. - \item Other bug fixes, including the one reported by Peter Selinger - (\verb|force=older preference| not working). - \end{itemize} -\item Compilation: - \begin{itemize} - \item Upgraded to the new OCaml 3.04 compiler, with the LablGtk - 1.2.3 library (patched version used for compiling under Windows). - \item Added the option to compile unison on the Windows platform with - Cygwin GNU C compiler. This option only supports building - dynamically linked unison executables. - \end{itemize} -\end{changesfromversion} - -\begin{changesfromversion}{2.7.4} -\item Fixed a silly (but debilitating) bug in the client startup sequence. -\end{changesfromversion} - -\begin{changesfromversion}{2.7.1} -\item Added \verb|addprefsto| preference, which (when set) controls which -preference file new preferences (e.g. new ignore patterns) are added to. -\item Bug fix: read the initial connection header one byte at a time, so -that we don't block if the header is shorter than expected. (This bug -did not affect normal operation --- it just made it hard to tell when you -were trying to use Unison incorrectly with an old version of the server, -since it would hang instead of giving an error message.) -\end{changesfromversion} - -\begin{changesfromversion}{2.6.59} -\item Changed \verb|fastcheck| from a boolean to a string preference. Its - legal values are \verb|yes| (for a fast check), \verb|no| (for a safe - check), or \verb|default| (for a fast check---which also happens to be - safe---when running on Unix and a safe check when on Windows). The default - is \verb|default|. - \item Several preferences have been renamed for consistency. All - preference names are now spelled out in lowercase. For backward - compatibility, the old names still work, but they are not mentioned in - the manual any more. -\item The temp files created by the 'diff' and 'merge' commands are now - named by {\em pre}pending a new prefix to the file name, rather than - appending a suffix. This should avoid confusing diff/merge programs - that depend on the suffix to guess the type of the file contents. -\item We now set the keepalive option on the server socket, to make sure - that the server times out if the communication link is unexpectedly broken. -\item Bug fixes: -\begin{itemize} -\item When updating small files, Unison now closes the destination file. -\item File permissions are properly updated when the file is behind a - followed link. -\item Several other small fixes. -\end{itemize} -\end{changesfromversion} - - -\begin{changesfromversion}{2.6.38} -\item Major Windows performance improvement! - -We've added a preference \verb|fastcheck| that makes Unison look only at -a file's creation time and last-modified time to check whether it has -changed. This should result in a huge speedup when checking for updates -in large replicas. - - When this switch is set, Unison will use file creation times as - 'pseudo inode numbers' when scanning Windows replicas for updates, - instead of reading the full contents of every file. This may cause - Unison to miss propagating an update if the create time, - modification time, and length of the file are all unchanged by - the update (this is not easy to achieve, but it can be done). - However, Unison will never {\em overwrite} such an update with - a change from the other replica, since it - always does a safe check for updates just before propagating a - change. Thus, it is reasonable to use this switch most of the time - and occasionally run Unison once with {\tt fastcheck} set to false, - if you are worried that Unison may have overlooked an update. - - Warning: This change is has not yet been thoroughly field-tested. If you - set the \verb|fastcheck| preference, pay careful attention to what - Unison is doing. - -\item New functionality: centralized backups and merging -\begin{itemize} -\item This version incorporates two pieces of major new functionality, - implemented by Sylvain Roy during a summer internship at Penn: a - {\em centralized backup} facility that keeps a full backup of - (selected files - in) each replica, and a {\em merging} feature that allows Unison to - invoke an external file-merging tool to resolve conflicting changes to - individual files. - -\item Centralized backups: -\begin{itemize} - \item Unison now maintains full backups of the last-synchronized versions - of (some of) the files in each replica; these function both as - backups in the usual sense - and as the ``common version'' when invoking external - merge programs. - \item The backed up files are stored in a directory ~/.unison/backup on each - host. (The name of this directory can be changed by setting - the environment variable \verb|UNISONBACKUPDIR|.) - \item The predicate \verb|backup| controls which files are actually - backed up: - giving the preference '\verb|backup = Path *|' causes backing up - of all files. - \item Files are added to the backup directory whenever unison updates - its archive. This means that - \begin{itemize} - \item When unison reconstructs its archive from scratch (e.g., - because of an upgrade, or because the archive files have - been manually deleted), all files will be backed up. - \item Otherwise, each file will be backed up the first time unison - propagates an update for it. - \end{itemize} - \item The preference \verb|backupversions| controls how many previous - versions of each file are kept. The default is 2 (i.e., the last - synchronized version plus one backup). - \item For backward compatibility, the \verb|backups| preference is also - still supported, but \verb|backup| is now preferred. - \item It is OK to manually delete files from the backup directory (or to throw - away the directory itself). Before unison uses any of these files for - anything important, it checks that its fingerprint matches the one - that it expects. -\end{itemize} - -\item Merging: -\begin{itemize} - \item Both user interfaces offer a new 'merge' command, invoked by pressing - 'm' (with a changed file selected). - \item The actual merging is performed by an external program. - The preferences \verb|merge| and \verb|merge2| control how this - program is invoked. If a backup exists for this file (see the - \verb|backup| preference), then the \verb|merge| preference is used for - this purpose; otherwise \verb|merge2| is used. In both cases, the - value of the preference should be a string representing the command - that should be passed to a shell to invoke the - merge program. Within this string, the special substrings - \verb|CURRENT1|, \verb|CURRENT2|, \verb|NEW|, and \verb|OLD| may appear - at any point. Unison will substitute these as follows before invoking - the command: - \begin{itemize} - \item \relax\verb|CURRENT1| is replaced by the name of the local - copy of the file; - \item \relax\verb|CURRENT2| is replaced by the name of a temporary - file, into which the contents of the remote copy of the file have - been transferred by Unison prior to performing the merge; - \item \relax\verb|NEW| is replaced by the name of a temporary - file that Unison expects to be written by the merge program when - it finishes, giving the desired new contents of the file; and - \item \relax\verb|OLD| is replaced by the name of the backed up - copy of the original version of the file (i.e., its state at the - end of the last successful run of Unison), if one exists - (applies only to \verb|merge|, not \verb|merge2|). - \end{itemize} - For example, on Unix systems setting the \verb|merge| preference to -\begin{verbatim} - merge = diff3 -m CURRENT1 OLD CURRENT2 > NEW -\end{verbatim} - will tell Unison to use the external \verb|diff3| program for merging. - - A large number of external merging programs are available. For - example, \verb|emacs| users may find the following convenient: -\begin{verbatim} - merge2 = emacs -q --eval '(ediff-merge-files "CURRENT1" "CURRENT2" - nil "NEW")' - merge = emacs -q --eval '(ediff-merge-files-with-ancestor - "CURRENT1" "CURRENT2" "OLD" nil "NEW")' -\end{verbatim} -(These commands are displayed here on two lines to avoid running off the -edge of the page. In your preference file, each should be written on a -single line.) - - \item If the external program exits without leaving any file at the - path \verb|NEW|, - Unison considers the merge to have failed. If the merge program writes - a file called \verb|NEW| but exits with a non-zero status code, - then Unison - considers the merge to have succeeded but to have generated conflicts. - In this case, it attempts to invoke an external editor so that the - user can resolve the conflicts. The value of the \verb|editor| - preference controls what editor is invoked by Unison. The default - is \verb|emacs|. - - \item Please send us suggestions for other useful values of the - \verb|merge2| and \verb|merge| preferences -- we'd like to give several - examples in the manual. -\end{itemize} -\end{itemize} - -\item Smaller changes: -\begin{itemize} -\item When one preference file includes another, unison no longer adds the - suffix '\verb|.prf|' to the included file by default. If a file with - precisely the given name exists in the .unison directory, it will be used; - otherwise Unison will - add \verb|.prf|, as it did before. (This change means that included - preference files can be named \verb|blah.include| instead of - \verb|blah.prf|, so that unison will not offer them in its 'choose - a preference file' dialog.) -\item For Linux systems, we now offer both a statically linked and a dynamically - linked executable. The static one is larger, but will probably run on more - systems, since it doesn't depend on the same versions of dynamically - linked library modules being available. -\item Fixed the \verb|force| and \verb|prefer| preferences, which were - getting the propagation direction exactly backwards. -\item Fixed a bug in the startup code that would cause unison to crash - when the default profile (\verb|~/.unison/default.prf|) does not exist. -\item Fixed a bug where, on the run when a profile is first created, - Unison would confusingly display the roots in reverse order in the user - interface. -\end{itemize} - -\item For developers: -\begin{itemize} -\item We've added a module dependency diagram to the source distribution, in - \verb|src/DEPENDENCIES.ps|, to help new prospective developers with - navigating the code. -\end{itemize} -\end{changesfromversion} - -\begin{changesfromversion}{2.6.11} -\item \incompatible{} Archive format has changed. - -\item \incompatible{} The startup sequence has been completely rewritten -and greatly simplified. The main user-visible change is that the -\verb|defaultpath| preference has been removed. Its effect can be -approximated by using multiple profiles, with \verb|include| directives -to incorporate common settings. All uses of \verb|defaultpath| in -existing profiles should be changed to \verb|path|. - -Another change in startup behavior that will affect some users is that it -is no longer possible to specify roots {\em both} in the profile {\em - and} on the command line. - -You can achieve a similar effect, though, by breaking your profile into -two: -\begin{verbatim} - - default.prf = - root = blah - root = foo - include common - - common.prf = - -\end{verbatim} -Now do -\begin{verbatim} - unison common root1 root2 -\end{verbatim} -when you want to specify roots explicitly. - -\item The \verb|-prefer| and \verb|-force| options have been extended to -allow users to specify that files with more recent modtimes should be -propagated, writing either \verb|-prefer newer| or \verb|-force newer|. -(For symmetry, Unison will also accept \verb|-prefer older| or -\verb|-force older|.) The \verb|-force older/newer| options can only be -used when \verb|-times| is also set. - -The graphical user interface provides access to these facilities on a -one-off basis via the \verb|Actions| menu. - -\item Names of roots can now be ``aliased'' to allow replicas to be -relocated without changing the name of the archive file where Unison -stores information between runs. (This feature is for experts only. See -the ``Archive Files'' section of the manual for more information.) - -\item Graphical user-interface: -\begin{itemize} -\item A new command is provided in the Synchronization menu for - switching to a new profile without restarting Unison from scratch. -\item The GUI also supports one-key shortcuts for commonly -used profiles. If a profile contains a preference of the form -% -'\verb|key = n|', where \verb|n| is a single digit, then pressing this -key will cause Unison to immediately switch to this profile and begin -synchronization again from scratch. (Any actions that may have been -selected for a set of changes currently being displayed will be -discarded.) - -\item Each profile may include a preference '\verb|label = |' giving a - descriptive string that described the options selected in this profile. - The string is listed along with the profile name in the profile selection - dialog, and displayed in the top-right corner of the main Unison window. -\end{itemize} - -\item Minor: -\begin{itemize} -\item Fixed a bug that would sometimes cause the 'diff' display to order - the files backwards relative to the main user interface. (Thanks - to Pascal Brisset for this fix.) -\item On Unix systems, the graphical version of Unison will check the - \verb|DISPLAY| variable and, if it is not set, automatically fall back - to the textual user interface. -\item Synchronization paths (\verb|path| preferences) are now matched - against the ignore preferences. So if a path is both specified in a - \verb|path| preference and ignored, it will be skipped. -\item Numerous other bugfixes and small improvements. -\end{itemize} -\end{changesfromversion} - -\begin{changesfromversion}{2.6.1} -\item The synchronization of modification times has been disabled for - directories. - -\item Preference files may now include lines of the form - \verb+include +, which will cause \verb+name.prf+ to be read - at that point. - -\item The synchronization of permission between Windows and Unix now - works properly. - -\item A binding \verb|CYGWIN=binmode| in now added to the environment - so that the Cygwin port of OpenSSH works properly in a non-Cygwin - context. - -\item The \verb|servercmd| and \verb|addversionno| preferences can now - be used together: \verb|-addversionno| appends an appropriate - \verb+-NNN+ to the server command, which is found by using the value - of the \verb|-servercmd| preference if there is one, or else just - \verb|unison|. - -\item Both \verb|'-pref=val'| and \verb|'-pref val'| are now allowed for - boolean values. (The former can be used to set a preference to false.) - -\item Lot of small bugs fixed. -\end{changesfromversion} - -\begin{changesfromversion}{2.5.31} -\item The \verb|log| preference is now set to \verb|true| by default, - since the log file seems useful for most users. -\item Several miscellaneous bugfixes (most involving symlinks). -\end{changesfromversion} - -\begin{changesfromversion}{2.5.25} -\item \incompatible{} Archive format has changed (again). - -\item Several significant bugs introduced in 2.5.25 have been fixed. -\end{changesfromversion} - -\begin{changesfromversion}{2.5.1} -\item \incompatible{} Archive format has changed. Make sure you -synchronize your replicas before upgrading, to avoid spurious -conflicts. The first sync after upgrading will be slow. - -\item New functionality: -\begin{itemize} -\item Unison now synchronizes file modtimes, user-ids, and group-ids. - -These new features are controlled by a set of new preferences, all of -which are currently \verb|false| by default. - -\begin{itemize} -\item When the \verb|times| preference is set to \verb|true|, file -modification times are propaged. (Because the representations of time -may not have the same granularity on both replicas, Unison may not always -be able to make the modtimes precisely equal, but it will get them as -close as the operating systems involved allow.) -\item When the \verb|owner| preference is set to \verb|true|, file -ownership information is synchronized. -\item When the \verb|group| preference is set to \verb|true|, group -information is synchronized. -\item When the \verb|numericIds| preference is set to \verb|true|, owner -and group information is synchronized numerically. By default, owner and -group numbers are converted to names on each replica and these names are -synchronized. (The special user id 0 and the special group 0 are never -mapped via user/group names even if this preference is not set.) -\end{itemize} - -\item Added an integer-valued preference \verb|perms| that can be used to -control the propagation of permission bits. The value of this preference -is a mask indicating which permission bits should be synchronized. It is -set by default to $0o1777$: all bits but the set-uid and set-gid bits are -synchronised (synchronizing theses latter bits can be a security hazard). -If you want to synchronize all bits, you can set the value of this -preference to $-1$. - -\item Added a \verb|log| preference (default \verb|false|), which makes -Unison keep a complete record of the changes it makes to the replicas. -By default, this record is written to a file called \verb|unison.log| in -the user's home directory (the value of the \verb|HOME| environment -variable). If you want it someplace else, set the \verb|logfile| -preference to the full pathname you want Unison to use. - -\item Added an \verb|ignorenot| preference that maintains a set of patterns - for paths that should definitely {\em not} be ignored, whether or not - they match an \verb|ignore| pattern. (That is, a path will now be ignored - iff it matches an ignore pattern and does not match any ignorenot patterns.) -\end{itemize} - -\item User-interface improvements: -\begin{itemize} -\item Roots are now displayed in the user interface in the same order -as they were given on the command line or in the preferences file. -\item When the \verb|batch| preference is set, the graphical user interface no - longer waits for user confirmation when it displays a warning message: it - simply pops up an advisory window with a Dismiss button at the bottom and - keeps on going. -\item Added a new preference for controlling how many status messages are - printed during update detection: \verb|statusdepth| controls the maximum - depth for paths on the local machine (longer paths are not displayed, nor - are non-directory paths). The value should be an integer; default is 1. -\item Removed the \verb|trace| and \verb|silent| preferences. They did -not seem very useful, and there were too many preferences for controlling -output in various ways. -\item The text UI now displays just the default command (the one that -will be used if the user just types \verb||) instead of all -available commands. Typing \verb|?| will print the full list of -possibilities. -\item The function that finds the canonical hostname of the local host -(which is used, for example, in calculating the name of the archive file -used to remember which files have been synchronized) normally uses the -\verb|gethostname| operating system call. However, if the environment -variable \verb|UNISONLOCALHOSTNAME| is set, its value will now be used -instead. This makes it easier to use Unison in situations where a -machine's name changes frequently (e.g., because it is a laptop and gets -moved around a lot). -\item File owner and group are now displayed in the ``detail window'' at -the bottom of the screen, when unison is configured to synchronize them. -\end{itemize} - -\item For hackers: -\begin{itemize} -\item Updated to Jacques Garrigue's new version of \verb|lablgtk|, which - means we can throw away our local patched version. - - If you're compiling the GTK version of unison from sources, you'll need - to update your copy of lablgtk to the developers release. - (Warning: installing lablgtk under Windows is currently a bit - challenging.) - -\item The TODO.txt file (in the source distribution) has been cleaned up -and reorganized. The list of pending tasks should be much easier to -make sense of, for people that may want to contribute their programming -energies. There is also a separate file BUGS.txt for open bugs. -\item The Tk user interface has been removed (it was not being maintained -and no longer compiles). -\item The \verb|debug| preference now prints quite a bit of additional -information that should be useful for identifying sources of problems. -\item The version number of the remote server is now checked right away - during the connection setup handshake, rather than later. (Somebody - sent a bug report of a server crash that turned out to come from using - inconsistent versions: better to check this earlier and in a way that - can't crash either client or server.) -\item Unison now runs correctly on 64-bit architectures (e.g. Alpha -linux). We will not be distributing binaries for these architectures -ourselves (at least for a while) but if someone would like to make them -available, we'll be glad to provide a link to them. -\end{itemize} - -\item Bug fixes: -\begin{itemize} -\item Pattern matching (e.g. for \verb|ignore|) is now case-insensitive - when Unison is in case-insensitive mode (i.e., when one of the replicas - is on a windows machine). -\item Some people had trouble with mysterious failures during - propagation of updates, where files would be falsely reported as having - changed during synchronization. This should be fixed. -\item Numerous smaller fixes. -\end{itemize} -\end{changesfromversion} - -\begin{changesfromversion}{2.4.1} -\item Added a number of 'sorting modes' for the user interface. By -default, conflicting changes are displayed at the top, and the rest of -the entries are sorted in alphabetical order. This behavior can be -changed in the following ways: -\begin{itemize} -\item Setting the \verb|sortnewfirst| preference to \verb|true| causes -newly created files to be displayed before changed files. -\item Setting \verb|sortbysize| causes files to be displayed in -increasing order of size. -\item Giving the preference \verb|sortfirst=| (where -\verb|| is a path descriptor in the same format as 'ignore' and 'follow' -patterns, causes paths matching this pattern to be displayed first. -\item Similarly, giving the preference \verb|sortlast=| -causes paths matching this pattern to be displayed last. -\end{itemize} -The sorting preferences are described in more detail in the user manual. -The \verb|sortnewfirst| and \verb|sortbysize| flags can also be accessed -from the 'Sort' menu in the grpahical user interface. - -\item Added two new preferences that can be used to change unison's -fundamental behavior to make it more like a mirroring tool instead of -a synchronizer. -\begin{itemize} -\item Giving the preference \verb|prefer| with argument \verb|| -(by adding \verb|-prefer | to the command line or \verb|prefer=|) -to your profile) means that, if there is a conflict, the contents of -\verb|| -should be propagated to the other replica (with no questions asked). -Non-conflicting changes are treated as usual. -\item Giving the preference \verb|force| with argument \verb|| -will make unison resolve {\em all} differences in favor of the given -root, even if it was the other replica that was changed. -\end{itemize} -These options should be used with care! (More information is available in -the manual.) - -\item Small changes: -\begin{itemize} -\item -Changed default answer to 'Yes' in all two-button dialogs in the - graphical interface (this seems more intuitive). - -\item The \verb|rsync| preference has been removed (it was used to -activate rsync compression for file transfers, but rsync compression is -now enabled by default). -\item In the text user interface, the arrows indicating which direction -changes are being - propagated are printed differently when the user has overridded Unison's - default recommendation (\verb|====>| instead of \verb|---->|). This - matches the behavior of the graphical interface, which displays such - arrows in a different color. -\item Carriage returns (Control-M's) are ignored at the ends of lines in - profiles, for Windows compatibility. -\item All preferences are now fully documented in the user manual. -\end{itemize} -\end{changesfromversion} - -\begin{changesfromversion}{2.3.12} -\item \incompatible{} Archive format has changed. Make sure you -synchronize your replicas before upgrading, to avoid spurious -conflicts. The first sync after upgrading will be slow. - -\item New/improved functionality: -\begin{itemize} -\item A new preference -sortbysize controls the order in which changes - are displayed to the user: when it is set to true, the smallest - changed files are displayed first. (The default setting is false.) -\item A new preference -sortnewfirst causes newly created files to be - listed before other updates in the user interface. -\item We now allow the ssh protocol to specify a port. -\item Incompatible change: The unison: protocol is deprecated, and we added - file: and socket:. You may have to modify your profiles in the - .unison directory. - If a replica is specified without an explicit protocol, we now - assume it refers to a file. (Previously "//saul/foo" meant to use - SSH to connect to saul, then access the foo directory. Now it means - to access saul via a remote file mechanism such as samba; the old - effect is now achieved by writing {\tt ssh://saul/foo}.) -\item Changed the startup sequence for the case where roots are given but - no profile is given on the command line. The new behavior is to - use the default profile (creating it if it does not exist), and - temporarily override its roots. The manual claimed that this case - would work by reading no profile at all, but AFAIK this was never - true. -\item In all user interfaces, files with conflicts are always listed first -\item A new preference 'sshversion' can be used to control which version - of ssh should be used to connect to the server. Legal values are 1 and 2. - (Default is empty, which will make unison use whatever version of ssh - is installed as the default 'ssh' command.) -\item The situation when the permissions of a file was updated the same on - both side is now handled correctly (we used to report a spurious conflict) - -\end{itemize} - -\item Improvements for the Windows version: -\begin{itemize} -\item The fact that filenames are treated case-insensitively under -Windows should now be handled correctly. The exact behavior is described -in the cross-platform section of the manual. -\item It should be possible to synchronize with Windows shares, e.g., - //host/drive/path. -\item Workarounds to the bug in syncing root directories in Windows. -The most difficult thing to fix is an ocaml bug: Unix.opendir fails on -c: in some versions of Windows. -\end{itemize} - -\item Improvements to the GTK user interface (the Tk interface is no -longer being maintained): -\begin{itemize} -\item The UI now displays actions differently (in blue) when they have been - explicitly changed by the user from Unison's default recommendation. -\item More colorful appearance. -\item The initial profile selection window works better. -\item If any transfers failed, a message to this effect is displayed along with - 'Synchronization complete' at the end of the transfer phase (in case they - may have scrolled off the top). -\item Added a global progress meter, displaying the percentage of {\em total} - bytes that have been transferred so far. -\end{itemize} - -\item Improvements to the text user interface: -\begin{itemize} -\item The file details will be displayed automatically when a - conflict is been detected. -\item when a warning is generated (e.g. for a temporary - file left over from a previous run of unison) Unison will no longer - wait for a response if it is running in -batch mode. -\item The UI now displays a short list of possible inputs each time it waits - for user interaction. -\item The UI now quits immediately (rather than looping back and starting - the interaction again) if the user presses 'q' when asked whether to - propagate changes. -\item Pressing 'g' in the text user interface will proceed immediately - with propagating updates, without asking any more questions. -\end{itemize} - -\item Documentation and installation changes: -\begin{itemize} -\item The manual now includes a FAQ, plus sections on common problems and -on tricks contributed by users. -\item Both the download page and the download directory explicitly say -what are the current stable and beta-test version numbers. -\item The OCaml sources for the up-to-the-minute developers' version (not -guaranteed to be stable, or even to compile, at any given time!) are now -available from the download page. -\item Added a subsection to the manual describing cross-platform - issues (case conflicts, illegal filenames) -\end{itemize} - -\item Many small bug fixes and random improvements. - -\end{changesfromversion} - -\begin{changesfromversion}{2.3.1} -\item Several bug fixes. The most important is a bug in the rsync -module that would occasionally cause change propagation to fail with a -'rename' error. -\end{changesfromversion} - -\begin{changesfromversion}{2.2} -\item The multi-threaded transport system is now disabled by default. -(It is not stable enough yet.) -\item Various bug fixes. -\item A new experimental feature: - - The final component of a -path argument may now be the wildcard - specifier \verb|*|. When Unison sees such a path, it expands this path on - the client into into the corresponding list of paths by listing the - contents of that directory. - - Note that if you use wildcard paths from the command line, you will - probably need to use quotes or a backslash to prevent the * from - being interpreted by your shell. - - If both roots are local, the contents of the first one will be used - for expanding wildcard paths. (Nb: this is the first one {\em after} the - canonization step -- i.e., the one that is listed first in the user - interface -- not the one listed first on the command line or in the - preferences file.) -\end{changesfromversion} - -\begin{changesfromversion}{2.1} -\item The transport subsystem now includes an implementation by -Sylvain Gommier and Norman Ramsey of Tridgell and Mackerras's -\verb|rsync| protocol. This protocol achieves much faster -transfers when only a small part of a large file has been changed by -sending just diffs. This feature is mainly helpful for transfers over -slow links---on fast local area networks it can actually degrade -performance---so we have left it off by default. Start unison with -the \verb|-rsync| option (or put \verb|rsync=true| in your preferences -file) to turn it on. - -\item ``Progress bars'' are now diplayed during remote file transfers, -showing what percentage of each file has been transferred so far. - -\item The version numbering scheme has changed. New releases will now - be have numbers like 2.2.30, where the second component is - incremented on every significant public release and the third - component is the ``patch level.'' - -\item Miscellaneous improvements to the GTK-based user interface. -\item The manual is now available in PDF format. - -\item We are experimenting with using a multi-threaded transport -subsystem to transfer several files at the same time, making -much more effective use of available network bandwidth. This feature -is not completely stable yet, so by default it is disabled in the -release version of Unison. - -If you want to play with the multi-threaded version, you'll need to -recompile Unison from sources (as described in the documentation), -setting the THREADS flag in Makefile.OCaml to true. Make sure that -your OCaml compiler has been installed with the \verb|-with-pthreads| -configuration option. (You can verify this by checking whether the -file \verb|threads/threads.cma| in the OCaml standard library -directory contains the string \verb|-lpthread| near the end.) -\end{changesfromversion} - -\begin{changesfromversion}{1.292} -\item Reduced memory footprint (this is especially important during -the first run of unison, where it has to gather information about all -the files in both repositories). -\item Fixed a bug that would cause the socket server under NT to fail - after the client exits. -\item Added a SHIFT modifier to the Ignore menu shortcut keys in GTK - interface (to avoid hitting them accidentally). -\end{changesfromversion} - -\begin{changesfromversion}{1.231} -\item Tunneling over ssh is now supported in the Windows version. See -the installation section of the manual for detailed instructions. - -\item The transport subsystem now includes an implementation of the -\verb|rsync| protocol, built by Sylvain Gommier and Norman Ramsey. -This protocol achieves much faster transfers when only a small part of -a large file has been changed by sending just diffs. The rsync -feature is off by default in the current version. Use the -\verb|-rsync| switch to turn it on. (Nb. We still have a lot of -tuning to do: you may not notice much speedup yet.) - -\item We're experimenting with a multi-threaded transport subsystem, -written by Jerome Vouillon. The downloadable binaries are still -single-threaded: if you want to try the multi-threaded version, you'll -need to recompile from sources. (Say \verb|make THREADS=true|.) -Native thread support from the compiler is required. Use the option -\verb|-threads N| to select the maximal number of concurrent -threads (default is 5). Multi-threaded -and single-threaded clients/servers can interoperate. - -\item A new GTK-based user interface is now available, thanks to -Jacques Garrigue. The Tk user interface still works, but we'll be -shifting development effort to the GTK interface from now on. -\item OCaml 3.00 is now required for compiling Unison from sources. -The modules \verb|uitk| and \verb|myfileselect| have been changed to -use labltk instead of camltk. To compile the Tk interface in Windows, -you must have ocaml-3.00 and tk8.3. When installing tk8.3, put it in -\verb|c:\Tcl| rather than the suggested \verb|c:\Program Files\Tcl|, -and be sure to install the headers and libraries (which are not -installed by default). - -\item Added a new \verb|-addversionno| switch, which causes unison to -use \verb|unison-| instead of just \verb|unison| -as the remote server command. This allows multiple versions of unison -to coexist conveniently on the same server: whichever version is run -on the client, the same version will be selected on the server. -\end{changesfromversion} - -\begin{changesfromversion}{1.219} -\item \incompatible{} Archive format has changed. Make sure you -synchronize your replicas before upgrading, to avoid spurious -conflicts. The first sync after upgrading will be slow. - -\item This version fixes several annoying bugs, including: -\begin{itemize} -\item Some cases where propagation of file permissions was not -working. -\item umask is now ignored when creating directories -\item directories are create writable, so that a read-only directory and - its contents can be propagated. -\item Handling of warnings generated by the server. -\item Synchronizing a path whose parent is not a directory on both sides is -now flagged as erroneous. -\item Fixed some bugs related to symnbolic links and nonexistant roots. -\begin{itemize} -\item - When a change (deletion or new contents) is propagated onto a - 'follow'ed symlink, the file pointed to by the link is now changed. - (We used to change the link itself, which doesn't fit our assertion - that 'follow' means the link is completely invisible) - \item When one root did not exist, propagating the other root on top of it - used to fail, becuase unison could not calculate the working directory - into which to write changes. This should be fixed. -\end{itemize} -\end{itemize} - -\item A human-readable timestamp has been added to Unison's archive files. - -\item The semantics of Path and Name regular expressions now -correspond better. - -\item Some minor improvements to the text UI (e.g. a command for going -back to previous items) - -\item The organization of the export directory has changed --- should -be easier to find / download things now. -\end{changesfromversion} - -\begin{changesfromversion}{1.200} -\item \incompatible{} Archive format has changed. Make sure you -synchronize your replicas before upgrading, to avoid spurious -conflicts. The first sync after upgrading will be slow. - -\item This version has not been tested extensively on Windows. - -\item Major internal changes designed to make unison safer to run -at the same time as the replicas are being changed by the user. - -\item Internal performance improvements. -\end{changesfromversion} - -\begin{changesfromversion}{1.190} -\item \incompatible{} Archive format has changed. Make sure you -synchronize your replicas before upgrading, to avoid spurious -conflicts. The first sync after upgrading will be slow. - -\item A number of internal functions have been changed to reduce the -amount of memory allocation, especially during the first -synchronization. This should help power users with very big replicas. - -\item Reimplementation of low-level remote procedure call stuff, in -preparation for adding rsync-like smart file transfer in a later -release. - -\item Miscellaneous bug fixes. -\end{changesfromversion} - -\begin{changesfromversion}{1.180} -\item \incompatible{} Archive format has changed. Make sure you -synchronize your replicas before upgrading, to avoid spurious -conflicts. The first sync after upgrading will be slow. - -\item Fixed some small bugs in the interpretation of ignore patterns. - -\item Fixed some problems that were preventing the Windows version -from working correctly when click-started. - -\item Fixes to treatment of file permissions under Windows, which were -causing spurious reports of different permissions when synchronizing -between windows and unix systems. - -\item Fixed one more non-tail-recursive list processing function, -which was causing stack overflows when synchronizing very large -replicas. -\end{changesfromversion} - -\begin{changesfromversion}{1.169} -\item The text user interface now provides commands for ignoring - files. -\item We found and fixed some {\em more} non-tail-recursive list - processing functions. Some power users have reported success with - very large replicas. -\item \incompatible -Files ending in \verb|.tmp| are no longer ignored automatically. If you want -to ignore such files, put an appropriate ignore pattern in your profile. - -\item \incompatible{} The syntax of {\tt ignore} and {\tt follow} -patterns has changed. Instead of putting a line of the form -\begin{verbatim} - ignore = -\end{verbatim} - in your profile ({\tt .unison/default.prf}), you should put: -\begin{verbatim} - ignore = Regexp -\end{verbatim} -Moreover, two other styles of pattern are also recognized: -\begin{verbatim} - ignore = Name -\end{verbatim} -matches any path in which one component matches \verb||, while -\begin{verbatim} - ignore = Path -\end{verbatim} -matches exactly the path \verb||. - -Standard ``globbing'' conventions can be used in \verb|| and -\verb||: -\begin{itemize} -\item a \verb|?| matches any single character except \verb|/| -\item a \verb|*| matches any sequence of characters not including \verb|/| -\item \verb|[xyz]| matches any character from the set $\{{\tt x}, - {\tt y}, {\tt z} \}$ -\item \verb|{a,bb,ccc}| matches any one of \verb|a|, \verb|bb|, or - \verb|ccc|. -\end{itemize} - -See the user manual for some examples. -\end{changesfromversion} - -\begin{changesfromversion}{1.146} -\item Some users were reporting stack overflows when synchronizing - huge directories. We found and fixed some non-tail-recursive list - processing functions, which we hope will solve the problem. Please - give it a try and let us know. -\item Major additions to the documentation. -\end{changesfromversion} - -\begin{changesfromversion}{1.142} -\item Major internal tidying and many small bugfixes. -\item Major additions to the user manual. -\item Unison can now be started with no arguments -- it will prompt -automatically for the name of a profile file containing the roots to -be synchronized. This makes it possible to start the graphical UI -from a desktop icon. -\item Fixed a small bug where the text UI on NT was raising a 'no such - signal' exception. -\end{changesfromversion} - -\begin{changesfromversion}{1.139} -\item The precompiled windows binary in the last release was compiled -with an old OCaml compiler, causing propagation of permissions not to -work (and perhaps leading to some other strange behaviors we've heard -reports about). This has been corrected. If you're using precompiled -binaries on Windows, please upgrade. -\item Added a \verb|-debug| command line flag, which controls debugging -of various modules. Say \verb|-debug XXX| to enable debug tracing for -module \verb|XXX|, or \verb|-debug all| to turn on absolutely everything. -\item Fixed a small bug where the text UI on NT was raising a 'no such signal' -exception. -\end{changesfromversion} - -\begin{changesfromversion}{1.111} -\item \incompatible{} The names and formats of the preference files in -the .unison directory have changed. In particular: -\begin{itemize} -\item the file ``prefs'' should be renamed to default.prf -\item the contents of the file ``ignore'' should be merged into - default.prf. Each line of the form \verb|REGEXP| in ignore should - become a line of the form \verb|ignore = REGEXP| in default.prf. -\end{itemize} -\item Unison now handles permission bits and symbolic links. See the -manual for details. - -\item You can now have different preference files in your .unison -directory. If you start unison like this -\begin{verbatim} - unison profilename -\end{verbatim} -(i.e. with just one ``anonymous'' command-line argument), then the -file \verb|~/.unison/profilename.prf| will be loaded instead of -\verb|default.prf|. - -\item Some improvements to terminal handling in the text user interface - -\item Added a switch -killServer that terminates the remote server process -when the unison client is shutting down, even when using sockets for -communication. (By default, a remote server created using ssh/rsh is -terminated automatically, while a socket server is left running.) -\item When started in 'socket server' mode, unison prints 'server started' on - stderr when it is ready to accept connections. - (This may be useful for scripts that want to tell when a socket-mode server - has finished initalization.) -\item We now make a nightly mirror of our current internal development - tree, in case anyone wants an up-to-the-minute version to hack - around with. -\item Added a file CONTRIB with some suggestions for how to help us -make Unison better. -\end{changesfromversion} - Copied: branches/2.32/doc/changes.tex (from rev 321, trunk/doc/changes.tex) =================================================================== --- branches/2.32/doc/changes.tex (rev 0) +++ branches/2.32/doc/changes.tex 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,1613 @@ +\begin{changesfromversion}{2.31} +\item Small user interface changes +\begin{itemize} +\item Small change to text UI "scanning..." messages, to print just + directories (hopefully making it clearer that individual files are + not necessarily being fingerprinted). +\end{itemize} +\item Minor fixes and improvements: +\begin{itemize} +\item Ignore one hour differences when deciding whether a file may have + been updated. This avoids slow update detection after daylight + saving time changes under Windows. This makes Unison slightly more + likely to miss an update, but it should be safe enough. +\item Fix a small bug that was affecting mainly windows users. We need to + commit the archives at the end of the sync even if there are 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. (Changed the text UI only. It's less clear where + to change the GUI.) +\item Don't delete the temp file when a transfer fails due to a + fingerprint mismatch (so that we can have a look and see why!) We've also + added more debugging code togive more informative error messages when we + encounter the dreaded and longstanding "assert failed during file + transfer" bug +\end{itemize} +\end{changesfromversion} + +\begin{changesfromversion}{2.27} +\item If Unison is interrupted during a directory transfer, it will now +leave the partially transferred directory intact in a temporary +location. (This maintains the invariant that new files/directories are +transferred either completely or not at all.) The next time Unison is run, +it will continue filling in this temporary directory, skipping transferring +files that it finds are already there. +\item We've added experimental support for invoking an external file +transfer tool for whole-file copies instead of Unison's built-in transfer +protocol. Three new preferences have been added: +\begin{itemize} +\item {\tt copyprog} is a string giving the name (and command-line +switches, if needed) of an external program that can be used to copy large +files efficiently. By default, rsync is invoked, but other tools such as +scp can be used instead by changing the value of this preference. (Although +this is not its primary purpose, rsync is actually a pretty fast way of +copying files that don't already exist on the receiving host.) For files +that do already exist on (but that have been changed in one replica), Unison +will always use its built-in implementation of the rsync algorithm. +\item Added a "copyprogrest" preference, so that we can give different +command lines for invoking the external copy utility depending on whether a +partially transferred file already exists or not. (Rsync doesn't seem to +care about this, but other utilities may.) +\item {\tt copythreshold} is an integer (-1 by default), indicating above what +filesize (in megabytes) Unison should use the external copying utility +specified by copyprog. Specifying 0 will cause ALL copies to use the +external program; a negative number will prevent any files from using it. +(Default is -1.) +\end{itemize} +Thanks to Alan Schmitt for a huge amount of hacking and to an anonymous +sponsor for suggesting and underwriting this extension. +\item Small improvements: +\begin{itemize} +\item Added a new preference, {\tt dontchmod}. By default, Unison uses the +{\tt chmod} system call to set the permission bits of files after it has +copied them. But in some circumstances (and under some operating systems), +the chmod call always fails. Setting this preference completely prevents +Unison from ever calling {\tt chmod}. +\item Don't ignore files that look like backup files if the {\tt + backuplocation} preference is set to {\tt central} +\item Shortened the names of several preferences. The old names are also +still supported, for backwards compatibility, but they do not appear in the +documentation. +\item Lots of little documentation tidying. (In particular, preferences are +separated into Basic and Advanced! This should hopefully make Unison a +little more approachable for new users. +\item Unison can sometimes fail to transfer a file, giving the unhelpful +message "Destination updated during synchronization" even though the file +has not been changed. This can be caused by programs that change either the +file's contents \emph{or} the file's extended attributes without changing +its modification time. It's not clear what is the best fix for this -- it +is not Unison's fault, but it makes Unison's behavior puzzling -- but at +least Unison can be more helpful about suggesting a workaround (running once +with {\tt fastcheck} set to false). The failure message has been changed to +give this advice. +\item Further improvements to the OS X GUI (thanks to Alan Schmitt and Craig +Federighi). +\end{itemize} +\item Very preliminary support for triggering Unison from an external + filesystem-watching utility. The current implementation is very + simple, not efficient, and almost completely untested---not ready + for real users. But if someone wants to help improve it (e.g., + by writing a filesystem watcher for your favorite OS), please make + yourself known! + + On the Unison side, the new behavior is very simple: + \begin{itemize} + \item use the text UI + \item start Unison with the command-line flag "-repeat FOO", + where FOO is name of a file where Unison should look + for notifications of changes + \item when it starts up, Unison will read the whole contents + of this file (on both hosts), which should be a + newline-separated list of paths (relative to the root + of the synchronization) and synchronize just these paths, + as if it had been started with the "-path=xxx" option for + each one of them + \item when it finishes, it will sleep for a few seconds and then + examine the watchfile again; if anything has been added, it + will read the new paths, synchronize them, and go back to + sleep + \item that's it! + \end{itemize} + To use this to drive Unison "incrementally," just start it in + this mode and start up a tool (on each host) to watch for + new changes to the filesystem and append the appropriate paths + to the watchfile. Hopefully such tools should not be too hard + to write. +\item Bug fixes: +\begin{itemize} +\item Fixed a bug that was causing new files to be created with + permissions 0x600 instead of using a reasonable default (like + 0x644), if the 'perms' flag was set to 0. (Bug reported by Ben + Crowell.) +\item Follow maxthreads preference when transferring directories. +\end{itemize} +\end{changesfromversion} + +\begin{changesfromversion}{2.17} +\item Major rewrite and cleanup of the whole Mac OS X graphical user +interface by Craig Federighi. Thanks, Craig!!! +\item Small fix to ctime (non-)handling in update detection under windows + with fastcheck. +\item Several small fixes to the GTK2 UI to make it work better under +Windows [thanks to Karl M for these]. +\item The backup functionality has been completely rewritten. The external +interface has not changed, but numerous bugs, irregular behaviors, and +cross-platform inconsistencies have been corrected. +\item The Unison project now accepts donations via PayPal. If you'd like to +donate, you can find a link to the donation page on the +\URL{http://www.cis.upenn.edu/~bcpierce/unison/lists.html}{Unison home + page}. +\item Some important safety improvements: +\begin{itemize} +\item Added a new \verb|mountpoint| preference, which can be used to specify +a path that must exist in both replicas at the end of update detection +(otherwise Unison aborts). This can be used to avoid potentially dangerous +situations when Unison is used with removable media such as external hard +drives and compact flash cards. +\item The confirmation of ``big deletes'' is now controlled by a boolean preference + \verb|confirmbigdeletes|. Default is true, which gives the same behavior as + previously. (This functionality is at least partly superceded by the + \verb|mountpoint| preference, but it has been left in place in case it is + useful to some people.) + \item If Unison is asked to ``follow'' a symbolic link but there is + nothing at the other end of the link, it will now flag this path as an + error, rather than treating the symlink itself as missing or deleted. + This avoids a potentially dangerous situation where a followed symlink + points to an external filesystem that might be offline when Unison is run + (whereupon Unison would cheerfully delete the corresponding files in the + other replica!). +\end{itemize} + +\item Smaller changes: +\begin{itemize} +\item Added \verb|forcepartial| and \verb|preferpartial| preferences, which +behave like \verb|force| and \verb|prefer| but can be specified on a +per-path basis. [Thanks to Alan Schmitt for this.] +\item A bare-bones self test feature was added, which runs unison through + some of its paces and checks that the results are as expected. The + coverage of the tests is still very limited, but the facility has already + been very useful in debugging the new backup functionality (especially in + exposing some subtle cross-platform issues). +\item Refined debugging code so that the verbosity of individual modules + can be controlled separately. Instead of just putting '-debug + verbose' on the command line, you can put '-debug update+', which + causes all the extra messages in the Update module, but not other + modules, to be printed. Putting '-debug verbose' causes all modules + to print with maximum verbosity. +\item Removed \verb|mergebatch| preference. (It never seemed very useful, and + its semantics were confusing.) +\item Rewrote some of the merging functionality, for better cooperation + with external Harmony instances. +\item Changed the temp file prefix from \verb|.#| to \verb|.unison|. +\item Compressed the output from the text user interface (particularly + when run with the \verb|-terse| flag) to make it easier to interpret the + results when Unison is run several times in succession from a script. +\item Diff and merge functions now work under Windows. +\item Changed the order of arguments to the default diff command (so that + the + and - annotations in diff's output are reversed). +\item Added \verb|.mpp| files to the ``never fastcheck'' list (like +\verb|.xls| files). +\end{itemize} + +\item Many small bugfixes, including: +\begin{itemize} +\item Fixed a longstanding bug regarding fastcheck and daylight saving time + under Windows when Unison is set up to synchronize modification times. + (Modification times cannot be updated in the archive in this case, + so we have to ignore one hour differences.) +\item Fixed a bug that would occasionally cause the archives to be left in + non-identical states on the two hosts after synchronization. +\item Fixed a bug that prevented Unison from communicating correctly between + 32- and 64-bit architectures. +\item On windows, file creation times are no longer used as a proxy for + inode numbers. (This is unfortunate, as it makes fastcheck a little less + safe. But it turns out that file creation times are not reliable + under Windows: if a file is removed and a new file is created in its + place, the new one will sometimes be given the same creation date as the + old one!) +\item Set read-only file to R/W on OSX before attempting to change other attributes. +\item Fixed bug resulting in spurious "Aborted" errors during transport +(thanks to Jerome Vouillon) +\item Enable diff if file contents have changed in one replica, but +only properties in the other. +\item Removed misleading documentation for 'repeat' preference. +\item Fixed a bug in merging code where Unison could sometimes deadlock + with the external merge program, if the latter produced large + amounts of output. +\item Workaround for a bug compiling gtk2 user interface against current versions + of gtk2+ libraries. +\item Added a better error message for "ambiguous paths". +\item Squashed a longstanding bug that would cause file transfer to fail + with the message ``Failed: Error in readWrite: Is a directory.'' +\item Replaced symlinks with copies of their targets in the Growl framework in src/uimac. + This should make the sources easier to check out from the svn repository on WinXP + systems. +\item Added a workaround (suggested by Karl M.) for the problem discussed + on the unison users mailing list where, on the Windows platform, the + server would hang when transferring files. I conjecture that + the problem has to do with the RPC mechanism, which was used to + make a call {\em back} from the server to the client (inside the Trace.log + function) so that the log message would be appended to the log file on + the client. The workaround is to dump these messages (about when + xferbycopying shortcuts are applied and whether they succeed) just to the + standard output of the Unison process, not to the log file. +\end{itemize} +\end{changesfromversion} + +\begin{changesfromversion}{2.13.0} +\item The features for performing backups and for invoking external merge +programs have been completely rewritten by Stephane Lescuyer (thanks, +Stephane!). The user-visible functionality should not change, but the +internals have been rationalized and there are a number of new features. +See the manual (in particular, the description of the \verb|backupXXX| +preferences) for details. +\item Incorporated patches for ipv6 support, contributed by Samuel Thibault. +(Note that, due to a bug in the released OCaml 3.08.3 compiler, this code +will not actually work with ipv6 unless compiled with the CVS version of the +OCaml compiler, where the bug has been fixed; however, ipv4 should continue +to work normally.) +\item OSX interface: +\begin{itemize} +\item Incorporated Ben Willmore's cool new icon for the Mac UI. +\end{itemize} +\item Small fixes: +\begin{itemize} +\item Fixed off by one error in month numbers (in printed dates) reported + by Bob Burger +\end{itemize} +\end{changesfromversion} + +\begin{changesfromversion}{2.12.0} +\item New convention for release numbering: Releases will continue to be +given numbers of the form \verb|X.Y.Z|, but, +from now on, just the major version number (\verb|X.Y|) will be considered +significant when checking compatibility between client and server versions. +The third component of the version number will be used only to identify +``patch levels'' of releases. + +This change goes hand in hand with a change to the procedure for making new +releases. Candidate releases will initially be given ``beta release'' +status when they are announced for public consumption. Any bugs that are +discovered will be fixed in a separate branch of the source repository +(without changing the major version number) and new tarballs re-released as +needed. When this process converges, the patched beta version will be +dubbed stable. +\item Warning (failure in batch mode) when one path is completely emptied. + This prevents Unison from deleting everything on one replica when + the other disappear. +\item Fix diff bug (where no difference is shown the first time the diff + command is given). +\item User interface changes: +\begin{itemize} +\item Improved workaround for button focus problem (GTK2 UI) +\item Put leading zeroes in date fields +\item More robust handling of character encodings in GTK2 UI +\item Changed format of modification time displays, from \verb|modified at hh:mm:ss on dd MMM, yyyy| +to \verb|modified on yyyy-mm-dd hh:mm:ss| +\item Changed time display to include seconds (so that people on FAT + filesystems will not be confused when Unison tries to update a file + time to an odd number of seconds and the filesystem truncates it to + an even number!) +\item Use the diff "-u" option by default when showing differences between files + (the output is more readable) +\item In text mode, pipe the diff output to a pager if the environment + variable PAGER is set +\item Bug fixes and cleanups in ssh password prompting. Now works with + the GTK2 UI under Linux. (Hopefully the Mac OS X one is not broken!) +\item Include profile name in the GTK2 window name +\item Added bindings ',' (same as '<') and '.' (same as '>') in the GTK2 UI +\end{itemize} +\item Mac GUI: +\begin{itemize} +\item actions like < and > scroll to the next item as necessary. +\item Restart has a menu item and keyboard shortcut (command-R). +\item + Added a command-line tool for Mac OS X. It can be installed from + the Unison menu. +\item New icon. +\item Handle the "help" command-line argument properly. +\item Handle profiles given on the command line properly. +\item When a profile has been selected, the profile dialog is replaced by a + "connecting" message while the connection is being made. This + gives better feedback. +\item Size of left and right columns is now large enough so that + "PropsChanged" is not cut off. +\end{itemize} +\item Minor changes: +\begin{itemize} +\item Disable multi-threading when both roots are local +\item Improved error handling code. In particular, make sure all files + are closed in case of a transient failure +\item Under Windows, use \verb|$UNISON| for home directory as a last resort + (it was wrongly moved before \verb|$HOME| and \verb|$USERPROFILE| in + Unison 2.12.0) +\item Reopen the logfile if its name changes (profile change) +\item Double-check that permissions and modification times have been + properly set: there are some combination of OS and filesystem on + which setting them can fail in a silent way. +\item Check for bad Windows filenames for pure Windows synchronization + also (not just cross architecture synchronization). + This way, filenames containing backslashes, which are not correctly + handled by unison, are rejected right away. +\item Attempt to resolve issues with synchronizing modification times + of read-only files under Windows +\item Ignore chmod failures when deleting files +\item Ignore trailing dots in filenames in case insensitive mode +\item Proper quoting of paths, files and extensions ignored using the UI +\item The strings CURRENT1 and CURRENT2 are now correctly substitued when + they occur in the diff preference +\item Improvements to syncing resource forks between Macs via a non-Mac system. +\end{itemize} +\end{changesfromversion} + +\begin{changesfromversion}{2.10.2} +\item \incompatible{} Archive format has changed. +\item Source code availability: The Unison sources are now managed using + Subversion. One nice side-effect is that anonymous checkout is now + possible, like this: +\begin{verbatim} + svn co https://cvs.cis.upenn.edu:3690/svnroot/unison/ +\end{verbatim} +We will also continue to export a ``developer tarball'' of the current +(modulo one day) sources in the web export directory. To receive commit logs +for changes to the sources, subscribe to the \verb|unison-hackers| list +(\ONEURL{http://www.cis.upenn.edu/~bcpierce/unison/lists.html}). +\item Text user interface: +\begin{itemize} +\item Substantial reworking of the internal logic of the text UI to make it +a bit easier to modify. +\item The {\tt dumbtty} flag in the text UI is automatically set to true if +the client is running on a Unix system and the {\tt EMACS} environment +variable is set to anything other than the empty string. +\end{itemize} +\item Native OS X gui: +\begin{itemize} +\item Added a synchronize menu item with keyboard shortcut +\item Added a merge menu item, still needs to be debugged +\item Fixes to compile for Panther +\item Miscellaneous improvements and bugfixes +\end{itemize} +\item Small changes: +\begin{itemize} +\item Changed the filename checking code to apply to Windows only, instead + of OS X as well. +\item Finder flags now synchronized +\item Fallback in copy.ml for filesystem that do not support \verb|O_EXCL| +\item Changed buffer size for local file copy (was highly inefficient with + synchronous writes) +\item Ignore chmod failure when deleting a directory +\item Fixed assertion failure when resolving a conflict content change / + permission changes in favor of the content change. +\item Workaround for transferring large files using rsync. +\item Use buffered I/O for files (this is the only way to open files in binary + mode under Cygwin). +\item On non-Cygwin Windows systems, the UNISON environment variable is now checked first to determine + where to look for Unison's archive and preference files, followed by \verb|HOME| and + \verb|USERPROFILE| in that order. On Unix and Cygwin systems, \verb|HOME| is used. +\item Generalized \verb|diff| preference so that it can be given either as just + the command name to be used for calculating diffs or else a whole command + line, containing the strings \verb|CURRENT1| and \verb|CURRENT2|, which will be replaced + by the names of the files to be diff'ed before the command is called. +\item Recognize password prompts in some newer versions of ssh. +\end{itemize} +\end{changesfromversion} + +\begin{changesfromversion}{2.9.20} +\item \incompatible{} Archive format has changed. +\item Major functionality changes: +\begin{itemize} +\item Major tidying and enhancement of 'merge' functionality. The main + user-visible change is that the external merge program may either write + the merged output to a single new file, as before, or it may modify one or + both of its input files, or it may write {\em two} new files. In the + latter cases, its modifications will be copied back into place on both the + local and the remote host, and (if the two files are now equal) the + archive will be updated appropriately. More information can be found in + the user manual. Thanks to Malo Denielou and Alan Schmitt for these + improvements. + + Warning: the new merging functionality is not completely compatible with + old versions! Check the manual for details. +\item Files larger than 2Gb are now supported. +\item Added preliminary (and still somewhat experimental) support for the + Apple OS X operating system. +\begin{itemize} +\item Resource forks should be transferred correctly. (See the manual for +details of how this works when synchronizing HFS with non-HFS volumes.) +Synchronization of file type and creator information is also supported. +\item On OSX systems, the name of the directory for storing Unison's +archives, preference files, etc., is now determined as follows: +\begin{itemize} + \item if \verb+~/.unison+ exists, use it + \item otherwise, use \verb|~/Library/Application Support/Unison|, + creating it if necessary. +\end{itemize} +\item A preliminary native-Cocoa user interface is under construction. This +still needs some work, and some users experience unpredictable crashes, so +it is only for hackers for now. Run make with {\tt UISTYLE=mac} to build +this interface. +\end{itemize} +\end{itemize} + +\item Minor functionality changes: +\begin{itemize} +\item Added an {\tt ignorelocks} preference, which forces Unison to override left-over + archive locks. (Setting this preference is dangerous! Use it only if you + are positive you know what you are doing.) +% BCP: removed later +% \item Running with the {\tt -timers} flag set to true will now show the total time taken +% to check for updates on each directory. (This can be helpful for tidying directories to improve +% update detection times.) +\item Added a new preference {\tt assumeContentsAreImmutable}. If a directory + matches one of the patterns set in this preference, then update detection + is skipped for files in this directory. (The + purpose is to speed update detection for cases like Mail folders, which + contain lots and lots of immutable files.) Also a preference + {\tt assumeContentsAreImmutableNot}, which overrides the first, similarly + to {\tt ignorenot}. (Later amendment: these preferences are now called + {\tt immutable} and {\tt immutablenot}.) +\item The {\tt ignorecase} flag has been changed from a boolean to a three-valued + preference. The default setting, called {\tt default}, checks the operating systems + running on the client and server and ignores filename case if either of them is + OSX or Windows. Setting ignorecase to {\tt true} or {\tt false} overrides + this behavior. If you have been setting {\tt ignorecase} on the command + line using {\tt -ignorecase=true} or {\tt -ignorecase=false}, you will + need to change to {\tt -ignorecase true} or {\tt -ignorecase false}. +\item a new preference, 'repeat', for the text user interface (only). If 'repeat' is set to + a number, then, after it finishes synchronizing, Unison will wait for that many seconds and + then start over, continuing this way until it is killed from outside. Setting repeat to true + will automatically set the batch preference to true. +\item Excel files are now handled specially, so that the {\tt fastcheck} + optimization is skipped even if the {\tt fastcheck} flag is set. (Excel + does some naughty things with modtimes, making this optimization + unreliable and leading to failures during change propagation.) +\item The ignorecase flag has been changed from a boolean to a three-valued + preference. The default setting, called 'default', checks the operating systems + running on the client and server and ignores filename case if either of them is + OSX or Windows. Setting ignorecase to 'true' or 'false' overrides this behavior. +\item Added a new preference, 'repeat', for the text user interface (only, + at the moment). If 'repeat' is set to a number, then, after it finishes + synchronizing, Unison will wait for that many seconds and then start over, + continuing this way until it is killed from outside. Setting repeat to + true will automatically set the batch preference to true. +\item The 'rshargs' preference has been split into 'rshargs' and 'sshargs' + (mainly to make the documentation clearer). In fact, 'rshargs' is no longer + mentioned in the documentation at all, since pretty much everybody uses + ssh now anyway. +\end{itemize} +\item Documentation +\begin{itemize} +\item The web pages have been completely redesigned and reorganized. + (Thanks to Alan Schmitt for help with this.) +\end{itemize} +\item User interface improvements +\begin{itemize} +\item Added a GTK2 user interface, capable (among other things) of displaying filenames + in any locale encoding. Kudos to Stephen Tse for contributing this code! +\item The text UI now prints a list of failed and skipped transfers at the end of + synchronization. +\item Restarting update detection from the graphical UI will reload the current + profile (which in particular will reset the -path preference, in case + it has been narrowed by using the ``Recheck unsynchronized items'' + command). +\item Several small improvements to the text user interface, including a + progress display. +\end{itemize} +\item Bug fixes (too numerous to count, actually, but here are some): +\begin{itemize} +\item The {\tt maxthreads} preference works now. +\item Fixed bug where warning message about uname returning an unrecognized + result was preventing connection to server. (The warning is no longer + printed, and all systems where 'uname' returns anything other than 'Darwin' + are assumed not to be running OS X.) +\item Fixed a problem on OS X that caused some valid file names (e.g., + those including colons) to be considered invalid. +\item Patched Path.followLink to follow links under cygwin in addition to Unix + (suggested by Matt Swift). +\item Small change to the storeRootsName function, suggested by bliviero at + ichips.intel.com, to fix a problem in unison with the `rootalias' + option, which allows you to tell unison that two roots contain the same + files. Rootalias was being applied after the hosts were + sorted, so it wouldn't work properly in all cases. +\item Incorporated a fix by Dmitry Bely for setting utimes of read-only files + on Win32 systems. +\end{itemize} +\item Installation / portability: +\begin{itemize} +\item Unison now compiles with OCaml version 3.07 and later out of the box. +\item Makefile.OCaml fixed to compile out of the box under OpenBSD. +\item a few additional ports (e.g. OpenBSD, Zaurus/IPAQ) are now mentioned in + the documentation +\item Unison can now be installed easily on OSX systems using the Fink + package manager +\end{itemize} +\end{changesfromversion} + +\begin{changesfromversion}{2.9.1} +\item Added a preference {\tt maxthreads} that can be used to limit the +number of simultaneous file transfers. +\item Added a {\tt backupdir} preference, which controls where backup +files are stored. +\item Basic support added for OSX. In particular, Unison now recognizes +when one of the hosts being synchronized is running OSX and switches to +a case-insensitive treatment of filenames (i.e., 'foo' and 'FOO' are +considered to be the same file). + (OSX is not yet fully working, + however: in particular, files with resource forks will not be + synchronized correctly.) +\item The same hash used to form the archive name is now also added to +the names of the temp files created during file transfer. The reason for +this is that, during update detection, we are going to silently delete +any old temp files that we find along the way, and we want to prevent +ourselves from deleting temp files belonging to other instances of Unison +that may be running in parallel, e.g. synchronizing with a different +host. Thanks to Ruslan Ermilov for this suggestion. +\item Several small user interface improvements +\item Documentation +\begin{itemize} +\item FAQ and bug reporting instructions have been split out as separate + HTML pages, accessible directly from the unison web page. +\item Additions to FAQ, in particular suggestions about performance +tuning. +\end{itemize} +\item Makefile +\begin{itemize} +\item Makefile.OCaml now sets UISTYLE=text or UISTYLE=gtk automatically, + depending on whether it finds lablgtk installed +\item Unison should now compile ``out of the box'' under OSX +\end{itemize} +\end{changesfromversion} + +\begin{changesfromversion}{2.8.1} +\item Changing profile works again under Windows +\item File movement optimization: Unison now tries to use local copy instead of + transfer for moved or copied files. It is controled by a boolean option + ``xferbycopying''. +\item Network statistics window (transfer rate, amount of data transferred). + [NB: not available in Windows-Cygwin version.] +\item symlinks work under the cygwin version (which is dynamically linked). +\item Fixed potential deadlock when synchronizing between Windows and +Unix +\item Small improvements: + \begin{itemize} + \item If neither the {\tt USERPROFILE} nor the {\tt HOME} environment + variables are set, then Unison will put its temporary commit log + (called {\tt DANGER.README}) into the directory named by the + {\tt UNISON} environment variable, if any; otherwise it will use + {\tt C:}. + \item alternative set of values for fastcheck: yes = true; no = false; + default = auto. + \item -silent implies -contactquietly + \end{itemize} +\item Source code: + \begin{itemize} + \item Code reorganization and tidying. (Started breaking up some of the + basic utility modules so that the non-unison-specific stuff can be + made available for other projects.) + \item several Makefile and docs changes (for release); + \item further comments in ``update.ml''; + \item connection information is not stored in global variables anymore. + \end{itemize} +\end{changesfromversion} + +\begin{changesfromversion}{2.7.78} +\item Small bugfix to textual user interface under Unix (to avoid leaving + the terminal in a bad state where it would not echo inputs after Unison + exited). +\end{changesfromversion} + +\begin{changesfromversion}{2.7.39} +\item Improvements to the main web page (stable and beta version docs are + now both accessible). +\item User manual revised. +\item Added some new preferences: +\begin{itemize} +\item ``sshcmd'' and ``rshcmd'' for specifying paths to ssh and rsh programs. +\item ``contactquietly'' for suppressing the ``contacting server'' message +during Unison startup (under the graphical UI). +\end{itemize} +\item Bug fixes: +\begin{itemize} +\item Fixed small bug in UI that neglected to change the displayed column + headers if loading a new profile caused the roots to change. +\item Fixed a bug that would put the text UI into an infinite loop if it + encountered a conflict when run in batch mode. +\item Added some code to try to fix the display of non-Ascii characters in + filenames on Windows systems in the GTK UI. (This code is currently + untested---if you're one of the people that had reported problems with + display of non-ascii filenames, we'd appreciate knowing if this actually + fixes things.) +\item `\verb|-prefer/-force newer|' works properly now. + (The bug was reported by Sebastian Urbaniak and Sean Fulton.) +\end{itemize} +\item User interface and Unison behavior: +\begin{itemize} +\item Renamed `Proceed' to `Go' in the graphical UI. +\item Added exit status for the textual user interface. +\item Paths that are not synchronized because of conflicts or errors during + update detection are now noted in the log file. +\item \verb|[END]| messages in log now use a briefer format +\item Changed the text UI startup sequence so that + {\tt ./unison -ui text} will use the default profile instead of failing. +\item Made some improvements to the error messages. +\item Added some debugging messages to remote.ml. +\end{itemize} +\end{changesfromversion} + +\begin{changesfromversion}{2.7.7} +\item Incorporated, once again, a multi-threaded transport sub-system. + It transfers several files at the same time, thereby making much + more effective use of available network bandwidth. Unlike the + earlier attempt, this time we do not rely on the native thread + library of OCaml. Instead, we implement a light-weight, + non-preemptive multi-thread library in OCaml directly. This version + appears stable. + + Some adjustments to unison are made to accommodate the multi-threaded + version. These include, in particular, changes to the + user interface and logging, for example: + \begin{itemize} + \item Two log entries for each transferring task, one for the + beginning, one for the end. + \item Suppressed warning messages against removing temp files left + by a previous unison run, because warning does not work nicely + under multi-threading. The temp file names are made less likely + to coincide with the name of a file created by the user. They + take the form \\ \verb|.#..unison.tmp|. + [N.b. This was later changed to \verb|.unison...unison.tmp|.] + \end{itemize} +\item Added a new command to the GTK user interface: pressing 'f' causes + Unison to start a new update detection phase, using as paths {\em just} + those paths that have been detected as changed and not yet marked as + successfully completed. Use this command to quickly restart Unison on + just the set of paths still needing attention after a previous run. +\item Made the {\tt ignorecase} preference user-visible, and changed the + initialization code so that it can be manually set to true, even if + neither host is running Windows. (This may be useful, e.g., when using + Unison running on a Unix system with a FAT volume mounted.) +\item Small improvements and bug fixes: + \begin{itemize} + \item Errors in preference files now generate fatal errors rather than + warnings at startup time. (I.e., you can't go on from them.) Also, + we fixed a bug that was preventing these warnings from appearing in the + text UI, so some users who have been running (unsuspectingly) with + garbage in their prefs files may now get error reports. + \item Error reporting for preference files now provides file name and + line number. + \item More intelligible message in the case of identical change to the same + files: ``Nothing to do: replicas have been changed only in identical + ways since last sync.'' + \item Files with prefix '.\#' excluded when scanning for preference + files. + \item Rsync instructions are send directly instead of first + marshaled. + \item Won't try forever to get the fingerprint of a continuously changing file: + unison will give up after certain number of retries. + \item Other bug fixes, including the one reported by Peter Selinger + (\verb|force=older preference| not working). + \end{itemize} +\item Compilation: + \begin{itemize} + \item Upgraded to the new OCaml 3.04 compiler, with the LablGtk + 1.2.3 library (patched version used for compiling under Windows). + \item Added the option to compile unison on the Windows platform with + Cygwin GNU C compiler. This option only supports building + dynamically linked unison executables. + \end{itemize} +\end{changesfromversion} + +\begin{changesfromversion}{2.7.4} +\item Fixed a silly (but debilitating) bug in the client startup sequence. +\end{changesfromversion} + +\begin{changesfromversion}{2.7.1} +\item Added \verb|addprefsto| preference, which (when set) controls which +preference file new preferences (e.g. new ignore patterns) are added to. +\item Bug fix: read the initial connection header one byte at a time, so +that we don't block if the header is shorter than expected. (This bug +did not affect normal operation --- it just made it hard to tell when you +were trying to use Unison incorrectly with an old version of the server, +since it would hang instead of giving an error message.) +\end{changesfromversion} + +\begin{changesfromversion}{2.6.59} +\item Changed \verb|fastcheck| from a boolean to a string preference. Its + legal values are \verb|yes| (for a fast check), \verb|no| (for a safe + check), or \verb|default| (for a fast check---which also happens to be + safe---when running on Unix and a safe check when on Windows). The default + is \verb|default|. + \item Several preferences have been renamed for consistency. All + preference names are now spelled out in lowercase. For backward + compatibility, the old names still work, but they are not mentioned in + the manual any more. +\item The temp files created by the 'diff' and 'merge' commands are now + named by {\em pre}pending a new prefix to the file name, rather than + appending a suffix. This should avoid confusing diff/merge programs + that depend on the suffix to guess the type of the file contents. +\item We now set the keepalive option on the server socket, to make sure + that the server times out if the communication link is unexpectedly broken. +\item Bug fixes: +\begin{itemize} +\item When updating small files, Unison now closes the destination file. +\item File permissions are properly updated when the file is behind a + followed link. +\item Several other small fixes. +\end{itemize} +\end{changesfromversion} + + +\begin{changesfromversion}{2.6.38} +\item Major Windows performance improvement! + +We've added a preference \verb|fastcheck| that makes Unison look only at +a file's creation time and last-modified time to check whether it has +changed. This should result in a huge speedup when checking for updates +in large replicas. + + When this switch is set, Unison will use file creation times as + 'pseudo inode numbers' when scanning Windows replicas for updates, + instead of reading the full contents of every file. This may cause + Unison to miss propagating an update if the create time, + modification time, and length of the file are all unchanged by + the update (this is not easy to achieve, but it can be done). + However, Unison will never {\em overwrite} such an update with + a change from the other replica, since it + always does a safe check for updates just before propagating a + change. Thus, it is reasonable to use this switch most of the time + and occasionally run Unison once with {\tt fastcheck} set to false, + if you are worried that Unison may have overlooked an update. + + Warning: This change is has not yet been thoroughly field-tested. If you + set the \verb|fastcheck| preference, pay careful attention to what + Unison is doing. + +\item New functionality: centralized backups and merging +\begin{itemize} +\item This version incorporates two pieces of major new functionality, + implemented by Sylvain Roy during a summer internship at Penn: a + {\em centralized backup} facility that keeps a full backup of + (selected files + in) each replica, and a {\em merging} feature that allows Unison to + invoke an external file-merging tool to resolve conflicting changes to + individual files. + +\item Centralized backups: +\begin{itemize} + \item Unison now maintains full backups of the last-synchronized versions + of (some of) the files in each replica; these function both as + backups in the usual sense + and as the ``common version'' when invoking external + merge programs. + \item The backed up files are stored in a directory ~/.unison/backup on each + host. (The name of this directory can be changed by setting + the environment variable \verb|UNISONBACKUPDIR|.) + \item The predicate \verb|backup| controls which files are actually + backed up: + giving the preference '\verb|backup = Path *|' causes backing up + of all files. + \item Files are added to the backup directory whenever unison updates + its archive. This means that + \begin{itemize} + \item When unison reconstructs its archive from scratch (e.g., + because of an upgrade, or because the archive files have + been manually deleted), all files will be backed up. + \item Otherwise, each file will be backed up the first time unison + propagates an update for it. + \end{itemize} + \item The preference \verb|backupversions| controls how many previous + versions of each file are kept. The default is 2 (i.e., the last + synchronized version plus one backup). + \item For backward compatibility, the \verb|backups| preference is also + still supported, but \verb|backup| is now preferred. + \item It is OK to manually delete files from the backup directory (or to throw + away the directory itself). Before unison uses any of these files for + anything important, it checks that its fingerprint matches the one + that it expects. +\end{itemize} + +\item Merging: +\begin{itemize} + \item Both user interfaces offer a new 'merge' command, invoked by pressing + 'm' (with a changed file selected). + \item The actual merging is performed by an external program. + The preferences \verb|merge| and \verb|merge2| control how this + program is invoked. If a backup exists for this file (see the + \verb|backup| preference), then the \verb|merge| preference is used for + this purpose; otherwise \verb|merge2| is used. In both cases, the + value of the preference should be a string representing the command + that should be passed to a shell to invoke the + merge program. Within this string, the special substrings + \verb|CURRENT1|, \verb|CURRENT2|, \verb|NEW|, and \verb|OLD| may appear + at any point. Unison will substitute these as follows before invoking + the command: + \begin{itemize} + \item \relax\verb|CURRENT1| is replaced by the name of the local + copy of the file; + \item \relax\verb|CURRENT2| is replaced by the name of a temporary + file, into which the contents of the remote copy of the file have + been transferred by Unison prior to performing the merge; + \item \relax\verb|NEW| is replaced by the name of a temporary + file that Unison expects to be written by the merge program when + it finishes, giving the desired new contents of the file; and + \item \relax\verb|OLD| is replaced by the name of the backed up + copy of the original version of the file (i.e., its state at the + end of the last successful run of Unison), if one exists + (applies only to \verb|merge|, not \verb|merge2|). + \end{itemize} + For example, on Unix systems setting the \verb|merge| preference to +\begin{verbatim} + merge = diff3 -m CURRENT1 OLD CURRENT2 > NEW +\end{verbatim} + will tell Unison to use the external \verb|diff3| program for merging. + + A large number of external merging programs are available. For + example, \verb|emacs| users may find the following convenient: +\begin{verbatim} + merge2 = emacs -q --eval '(ediff-merge-files "CURRENT1" "CURRENT2" + nil "NEW")' + merge = emacs -q --eval '(ediff-merge-files-with-ancestor + "CURRENT1" "CURRENT2" "OLD" nil "NEW")' +\end{verbatim} +(These commands are displayed here on two lines to avoid running off the +edge of the page. In your preference file, each should be written on a +single line.) + + \item If the external program exits without leaving any file at the + path \verb|NEW|, + Unison considers the merge to have failed. If the merge program writes + a file called \verb|NEW| but exits with a non-zero status code, + then Unison + considers the merge to have succeeded but to have generated conflicts. + In this case, it attempts to invoke an external editor so that the + user can resolve the conflicts. The value of the \verb|editor| + preference controls what editor is invoked by Unison. The default + is \verb|emacs|. + + \item Please send us suggestions for other useful values of the + \verb|merge2| and \verb|merge| preferences -- we'd like to give several + examples in the manual. +\end{itemize} +\end{itemize} + +\item Smaller changes: +\begin{itemize} +\item When one preference file includes another, unison no longer adds the + suffix '\verb|.prf|' to the included file by default. If a file with + precisely the given name exists in the .unison directory, it will be used; + otherwise Unison will + add \verb|.prf|, as it did before. (This change means that included + preference files can be named \verb|blah.include| instead of + \verb|blah.prf|, so that unison will not offer them in its 'choose + a preference file' dialog.) +\item For Linux systems, we now offer both a statically linked and a dynamically + linked executable. The static one is larger, but will probably run on more + systems, since it doesn't depend on the same versions of dynamically + linked library modules being available. +\item Fixed the \verb|force| and \verb|prefer| preferences, which were + getting the propagation direction exactly backwards. +\item Fixed a bug in the startup code that would cause unison to crash + when the default profile (\verb|~/.unison/default.prf|) does not exist. +\item Fixed a bug where, on the run when a profile is first created, + Unison would confusingly display the roots in reverse order in the user + interface. +\end{itemize} + +\item For developers: +\begin{itemize} +\item We've added a module dependency diagram to the source distribution, in + \verb|src/DEPENDENCIES.ps|, to help new prospective developers with + navigating the code. +\end{itemize} +\end{changesfromversion} + +\begin{changesfromversion}{2.6.11} +\item \incompatible{} Archive format has changed. + +\item \incompatible{} The startup sequence has been completely rewritten +and greatly simplified. The main user-visible change is that the +\verb|defaultpath| preference has been removed. Its effect can be +approximated by using multiple profiles, with \verb|include| directives +to incorporate common settings. All uses of \verb|defaultpath| in +existing profiles should be changed to \verb|path|. + +Another change in startup behavior that will affect some users is that it +is no longer possible to specify roots {\em both} in the profile {\em + and} on the command line. + +You can achieve a similar effect, though, by breaking your profile into +two: +\begin{verbatim} + + default.prf = + root = blah + root = foo + include common + + common.prf = + +\end{verbatim} +Now do +\begin{verbatim} + unison common root1 root2 +\end{verbatim} +when you want to specify roots explicitly. + +\item The \verb|-prefer| and \verb|-force| options have been extended to +allow users to specify that files with more recent modtimes should be +propagated, writing either \verb|-prefer newer| or \verb|-force newer|. +(For symmetry, Unison will also accept \verb|-prefer older| or +\verb|-force older|.) The \verb|-force older/newer| options can only be +used when \verb|-times| is also set. + +The graphical user interface provides access to these facilities on a +one-off basis via the \verb|Actions| menu. + +\item Names of roots can now be ``aliased'' to allow replicas to be +relocated without changing the name of the archive file where Unison +stores information between runs. (This feature is for experts only. See +the ``Archive Files'' section of the manual for more information.) + +\item Graphical user-interface: +\begin{itemize} +\item A new command is provided in the Synchronization menu for + switching to a new profile without restarting Unison from scratch. +\item The GUI also supports one-key shortcuts for commonly +used profiles. If a profile contains a preference of the form +% +'\verb|key = n|', where \verb|n| is a single digit, then pressing this +key will cause Unison to immediately switch to this profile and begin +synchronization again from scratch. (Any actions that may have been +selected for a set of changes currently being displayed will be +discarded.) + +\item Each profile may include a preference '\verb|label = |' giving a + descriptive string that described the options selected in this profile. + The string is listed along with the profile name in the profile selection + dialog, and displayed in the top-right corner of the main Unison window. +\end{itemize} + +\item Minor: +\begin{itemize} +\item Fixed a bug that would sometimes cause the 'diff' display to order + the files backwards relative to the main user interface. (Thanks + to Pascal Brisset for this fix.) +\item On Unix systems, the graphical version of Unison will check the + \verb|DISPLAY| variable and, if it is not set, automatically fall back + to the textual user interface. +\item Synchronization paths (\verb|path| preferences) are now matched + against the ignore preferences. So if a path is both specified in a + \verb|path| preference and ignored, it will be skipped. +\item Numerous other bugfixes and small improvements. +\end{itemize} +\end{changesfromversion} + +\begin{changesfromversion}{2.6.1} +\item The synchronization of modification times has been disabled for + directories. + +\item Preference files may now include lines of the form + \verb+include +, which will cause \verb+name.prf+ to be read + at that point. + +\item The synchronization of permission between Windows and Unix now + works properly. + +\item A binding \verb|CYGWIN=binmode| in now added to the environment + so that the Cygwin port of OpenSSH works properly in a non-Cygwin + context. + +\item The \verb|servercmd| and \verb|addversionno| preferences can now + be used together: \verb|-addversionno| appends an appropriate + \verb+-NNN+ to the server command, which is found by using the value + of the \verb|-servercmd| preference if there is one, or else just + \verb|unison|. + +\item Both \verb|'-pref=val'| and \verb|'-pref val'| are now allowed for + boolean values. (The former can be used to set a preference to false.) + +\item Lot of small bugs fixed. +\end{changesfromversion} + +\begin{changesfromversion}{2.5.31} +\item The \verb|log| preference is now set to \verb|true| by default, + since the log file seems useful for most users. +\item Several miscellaneous bugfixes (most involving symlinks). +\end{changesfromversion} + +\begin{changesfromversion}{2.5.25} +\item \incompatible{} Archive format has changed (again). + +\item Several significant bugs introduced in 2.5.25 have been fixed. +\end{changesfromversion} + +\begin{changesfromversion}{2.5.1} +\item \incompatible{} Archive format has changed. Make sure you +synchronize your replicas before upgrading, to avoid spurious +conflicts. The first sync after upgrading will be slow. + +\item New functionality: +\begin{itemize} +\item Unison now synchronizes file modtimes, user-ids, and group-ids. + +These new features are controlled by a set of new preferences, all of +which are currently \verb|false| by default. + +\begin{itemize} +\item When the \verb|times| preference is set to \verb|true|, file +modification times are propaged. (Because the representations of time +may not have the same granularity on both replicas, Unison may not always +be able to make the modtimes precisely equal, but it will get them as +close as the operating systems involved allow.) +\item When the \verb|owner| preference is set to \verb|true|, file +ownership information is synchronized. +\item When the \verb|group| preference is set to \verb|true|, group +information is synchronized. +\item When the \verb|numericIds| preference is set to \verb|true|, owner +and group information is synchronized numerically. By default, owner and +group numbers are converted to names on each replica and these names are +synchronized. (The special user id 0 and the special group 0 are never +mapped via user/group names even if this preference is not set.) +\end{itemize} + +\item Added an integer-valued preference \verb|perms| that can be used to +control the propagation of permission bits. The value of this preference +is a mask indicating which permission bits should be synchronized. It is +set by default to $0o1777$: all bits but the set-uid and set-gid bits are +synchronised (synchronizing theses latter bits can be a security hazard). +If you want to synchronize all bits, you can set the value of this +preference to $-1$. + +\item Added a \verb|log| preference (default \verb|false|), which makes +Unison keep a complete record of the changes it makes to the replicas. +By default, this record is written to a file called \verb|unison.log| in +the user's home directory (the value of the \verb|HOME| environment +variable). If you want it someplace else, set the \verb|logfile| +preference to the full pathname you want Unison to use. + +\item Added an \verb|ignorenot| preference that maintains a set of patterns + for paths that should definitely {\em not} be ignored, whether or not + they match an \verb|ignore| pattern. (That is, a path will now be ignored + iff it matches an ignore pattern and does not match any ignorenot patterns.) +\end{itemize} + +\item User-interface improvements: +\begin{itemize} +\item Roots are now displayed in the user interface in the same order +as they were given on the command line or in the preferences file. +\item When the \verb|batch| preference is set, the graphical user interface no + longer waits for user confirmation when it displays a warning message: it + simply pops up an advisory window with a Dismiss button at the bottom and + keeps on going. +\item Added a new preference for controlling how many status messages are + printed during update detection: \verb|statusdepth| controls the maximum + depth for paths on the local machine (longer paths are not displayed, nor + are non-directory paths). The value should be an integer; default is 1. +\item Removed the \verb|trace| and \verb|silent| preferences. They did +not seem very useful, and there were too many preferences for controlling +output in various ways. +\item The text UI now displays just the default command (the one that +will be used if the user just types \verb||) instead of all +available commands. Typing \verb|?| will print the full list of +possibilities. +\item The function that finds the canonical hostname of the local host +(which is used, for example, in calculating the name of the archive file +used to remember which files have been synchronized) normally uses the +\verb|gethostname| operating system call. However, if the environment +variable \verb|UNISONLOCALHOSTNAME| is set, its value will now be used +instead. This makes it easier to use Unison in situations where a +machine's name changes frequently (e.g., because it is a laptop and gets +moved around a lot). +\item File owner and group are now displayed in the ``detail window'' at +the bottom of the screen, when unison is configured to synchronize them. +\end{itemize} + +\item For hackers: +\begin{itemize} +\item Updated to Jacques Garrigue's new version of \verb|lablgtk|, which + means we can throw away our local patched version. + + If you're compiling the GTK version of unison from sources, you'll need + to update your copy of lablgtk to the developers release. + (Warning: installing lablgtk under Windows is currently a bit + challenging.) + +\item The TODO.txt file (in the source distribution) has been cleaned up +and reorganized. The list of pending tasks should be much easier to +make sense of, for people that may want to contribute their programming +energies. There is also a separate file BUGS.txt for open bugs. +\item The Tk user interface has been removed (it was not being maintained +and no longer compiles). +\item The \verb|debug| preference now prints quite a bit of additional +information that should be useful for identifying sources of problems. +\item The version number of the remote server is now checked right away + during the connection setup handshake, rather than later. (Somebody + sent a bug report of a server crash that turned out to come from using + inconsistent versions: better to check this earlier and in a way that + can't crash either client or server.) +\item Unison now runs correctly on 64-bit architectures (e.g. Alpha +linux). We will not be distributing binaries for these architectures +ourselves (at least for a while) but if someone would like to make them +available, we'll be glad to provide a link to them. +\end{itemize} + +\item Bug fixes: +\begin{itemize} +\item Pattern matching (e.g. for \verb|ignore|) is now case-insensitive + when Unison is in case-insensitive mode (i.e., when one of the replicas + is on a windows machine). +\item Some people had trouble with mysterious failures during + propagation of updates, where files would be falsely reported as having + changed during synchronization. This should be fixed. +\item Numerous smaller fixes. +\end{itemize} +\end{changesfromversion} + +\begin{changesfromversion}{2.4.1} +\item Added a number of 'sorting modes' for the user interface. By +default, conflicting changes are displayed at the top, and the rest of +the entries are sorted in alphabetical order. This behavior can be +changed in the following ways: +\begin{itemize} +\item Setting the \verb|sortnewfirst| preference to \verb|true| causes +newly created files to be displayed before changed files. +\item Setting \verb|sortbysize| causes files to be displayed in +increasing order of size. +\item Giving the preference \verb|sortfirst=| (where +\verb|| is a path descriptor in the same format as 'ignore' and 'follow' +patterns, causes paths matching this pattern to be displayed first. +\item Similarly, giving the preference \verb|sortlast=| +causes paths matching this pattern to be displayed last. +\end{itemize} +The sorting preferences are described in more detail in the user manual. +The \verb|sortnewfirst| and \verb|sortbysize| flags can also be accessed +from the 'Sort' menu in the grpahical user interface. + +\item Added two new preferences that can be used to change unison's +fundamental behavior to make it more like a mirroring tool instead of +a synchronizer. +\begin{itemize} +\item Giving the preference \verb|prefer| with argument \verb|| +(by adding \verb|-prefer | to the command line or \verb|prefer=|) +to your profile) means that, if there is a conflict, the contents of +\verb|| +should be propagated to the other replica (with no questions asked). +Non-conflicting changes are treated as usual. +\item Giving the preference \verb|force| with argument \verb|| +will make unison resolve {\em all} differences in favor of the given +root, even if it was the other replica that was changed. +\end{itemize} +These options should be used with care! (More information is available in +the manual.) + +\item Small changes: +\begin{itemize} +\item +Changed default answer to 'Yes' in all two-button dialogs in the + graphical interface (this seems more intuitive). + +\item The \verb|rsync| preference has been removed (it was used to +activate rsync compression for file transfers, but rsync compression is +now enabled by default). +\item In the text user interface, the arrows indicating which direction +changes are being + propagated are printed differently when the user has overridded Unison's + default recommendation (\verb|====>| instead of \verb|---->|). This + matches the behavior of the graphical interface, which displays such + arrows in a different color. +\item Carriage returns (Control-M's) are ignored at the ends of lines in + profiles, for Windows compatibility. +\item All preferences are now fully documented in the user manual. +\end{itemize} +\end{changesfromversion} + +\begin{changesfromversion}{2.3.12} +\item \incompatible{} Archive format has changed. Make sure you +synchronize your replicas before upgrading, to avoid spurious +conflicts. The first sync after upgrading will be slow. + +\item New/improved functionality: +\begin{itemize} +\item A new preference -sortbysize controls the order in which changes + are displayed to the user: when it is set to true, the smallest + changed files are displayed first. (The default setting is false.) +\item A new preference -sortnewfirst causes newly created files to be + listed before other updates in the user interface. +\item We now allow the ssh protocol to specify a port. +\item Incompatible change: The unison: protocol is deprecated, and we added + file: and socket:. You may have to modify your profiles in the + .unison directory. + If a replica is specified without an explicit protocol, we now + assume it refers to a file. (Previously "//saul/foo" meant to use + SSH to connect to saul, then access the foo directory. Now it means + to access saul via a remote file mechanism such as samba; the old + effect is now achieved by writing {\tt ssh://saul/foo}.) +\item Changed the startup sequence for the case where roots are given but + no profile is given on the command line. The new behavior is to + use the default profile (creating it if it does not exist), and + temporarily override its roots. The manual claimed that this case + would work by reading no profile at all, but AFAIK this was never + true. +\item In all user interfaces, files with conflicts are always listed first +\item A new preference 'sshversion' can be used to control which version + of ssh should be used to connect to the server. Legal values are 1 and 2. + (Default is empty, which will make unison use whatever version of ssh + is installed as the default 'ssh' command.) +\item The situation when the permissions of a file was updated the same on + both side is now handled correctly (we used to report a spurious conflict) + +\end{itemize} + +\item Improvements for the Windows version: +\begin{itemize} +\item The fact that filenames are treated case-insensitively under +Windows should now be handled correctly. The exact behavior is described +in the cross-platform section of the manual. +\item It should be possible to synchronize with Windows shares, e.g., + //host/drive/path. +\item Workarounds to the bug in syncing root directories in Windows. +The most difficult thing to fix is an ocaml bug: Unix.opendir fails on +c: in some versions of Windows. +\end{itemize} + +\item Improvements to the GTK user interface (the Tk interface is no +longer being maintained): +\begin{itemize} +\item The UI now displays actions differently (in blue) when they have been + explicitly changed by the user from Unison's default recommendation. +\item More colorful appearance. +\item The initial profile selection window works better. +\item If any transfers failed, a message to this effect is displayed along with + 'Synchronization complete' at the end of the transfer phase (in case they + may have scrolled off the top). +\item Added a global progress meter, displaying the percentage of {\em total} + bytes that have been transferred so far. +\end{itemize} + +\item Improvements to the text user interface: +\begin{itemize} +\item The file details will be displayed automatically when a + conflict is been detected. +\item when a warning is generated (e.g. for a temporary + file left over from a previous run of unison) Unison will no longer + wait for a response if it is running in -batch mode. +\item The UI now displays a short list of possible inputs each time it waits + for user interaction. +\item The UI now quits immediately (rather than looping back and starting + the interaction again) if the user presses 'q' when asked whether to + propagate changes. +\item Pressing 'g' in the text user interface will proceed immediately + with propagating updates, without asking any more questions. +\end{itemize} + +\item Documentation and installation changes: +\begin{itemize} +\item The manual now includes a FAQ, plus sections on common problems and +on tricks contributed by users. +\item Both the download page and the download directory explicitly say +what are the current stable and beta-test version numbers. +\item The OCaml sources for the up-to-the-minute developers' version (not +guaranteed to be stable, or even to compile, at any given time!) are now +available from the download page. +\item Added a subsection to the manual describing cross-platform + issues (case conflicts, illegal filenames) +\end{itemize} + +\item Many small bug fixes and random improvements. + +\end{changesfromversion} + +\begin{changesfromversion}{2.3.1} +\item Several bug fixes. The most important is a bug in the rsync +module that would occasionally cause change propagation to fail with a +'rename' error. +\end{changesfromversion} + +\begin{changesfromversion}{2.2} +\item The multi-threaded transport system is now disabled by default. +(It is not stable enough yet.) +\item Various bug fixes. +\item A new experimental feature: + + The final component of a -path argument may now be the wildcard + specifier \verb|*|. When Unison sees such a path, it expands this path on + the client into into the corresponding list of paths by listing the + contents of that directory. + + Note that if you use wildcard paths from the command line, you will + probably need to use quotes or a backslash to prevent the * from + being interpreted by your shell. + + If both roots are local, the contents of the first one will be used + for expanding wildcard paths. (Nb: this is the first one {\em after} the + canonization step -- i.e., the one that is listed first in the user + interface -- not the one listed first on the command line or in the + preferences file.) +\end{changesfromversion} + +\begin{changesfromversion}{2.1} +\item The transport subsystem now includes an implementation by +Sylvain Gommier and Norman Ramsey of Tridgell and Mackerras's +\verb|rsync| protocol. This protocol achieves much faster +transfers when only a small part of a large file has been changed by +sending just diffs. This feature is mainly helpful for transfers over +slow links---on fast local area networks it can actually degrade +performance---so we have left it off by default. Start unison with +the \verb|-rsync| option (or put \verb|rsync=true| in your preferences +file) to turn it on. + +\item ``Progress bars'' are now diplayed during remote file transfers, +showing what percentage of each file has been transferred so far. + +\item The version numbering scheme has changed. New releases will now + be have numbers like 2.2.30, where the second component is + incremented on every significant public release and the third + component is the ``patch level.'' + +\item Miscellaneous improvements to the GTK-based user interface. +\item The manual is now available in PDF format. + +\item We are experimenting with using a multi-threaded transport +subsystem to transfer several files at the same time, making +much more effective use of available network bandwidth. This feature +is not completely stable yet, so by default it is disabled in the +release version of Unison. + +If you want to play with the multi-threaded version, you'll need to +recompile Unison from sources (as described in the documentation), +setting the THREADS flag in Makefile.OCaml to true. Make sure that +your OCaml compiler has been installed with the \verb|-with-pthreads| +configuration option. (You can verify this by checking whether the +file \verb|threads/threads.cma| in the OCaml standard library +directory contains the string \verb|-lpthread| near the end.) +\end{changesfromversion} + +\begin{changesfromversion}{1.292} +\item Reduced memory footprint (this is especially important during +the first run of unison, where it has to gather information about all +the files in both repositories). +\item Fixed a bug that would cause the socket server under NT to fail + after the client exits. +\item Added a SHIFT modifier to the Ignore menu shortcut keys in GTK + interface (to avoid hitting them accidentally). +\end{changesfromversion} + +\begin{changesfromversion}{1.231} +\item Tunneling over ssh is now supported in the Windows version. See +the installation section of the manual for detailed instructions. + +\item The transport subsystem now includes an implementation of the +\verb|rsync| protocol, built by Sylvain Gommier and Norman Ramsey. +This protocol achieves much faster transfers when only a small part of +a large file has been changed by sending just diffs. The rsync +feature is off by default in the current version. Use the +\verb|-rsync| switch to turn it on. (Nb. We still have a lot of +tuning to do: you may not notice much speedup yet.) + +\item We're experimenting with a multi-threaded transport subsystem, +written by Jerome Vouillon. The downloadable binaries are still +single-threaded: if you want to try the multi-threaded version, you'll +need to recompile from sources. (Say \verb|make THREADS=true|.) +Native thread support from the compiler is required. Use the option +\verb|-threads N| to select the maximal number of concurrent +threads (default is 5). Multi-threaded +and single-threaded clients/servers can interoperate. + +\item A new GTK-based user interface is now available, thanks to +Jacques Garrigue. The Tk user interface still works, but we'll be +shifting development effort to the GTK interface from now on. +\item OCaml 3.00 is now required for compiling Unison from sources. +The modules \verb|uitk| and \verb|myfileselect| have been changed to +use labltk instead of camltk. To compile the Tk interface in Windows, +you must have ocaml-3.00 and tk8.3. When installing tk8.3, put it in +\verb|c:\Tcl| rather than the suggested \verb|c:\Program Files\Tcl|, +and be sure to install the headers and libraries (which are not +installed by default). + +\item Added a new \verb|-addversionno| switch, which causes unison to +use \verb|unison-| instead of just \verb|unison| +as the remote server command. This allows multiple versions of unison +to coexist conveniently on the same server: whichever version is run +on the client, the same version will be selected on the server. +\end{changesfromversion} + +\begin{changesfromversion}{1.219} +\item \incompatible{} Archive format has changed. Make sure you +synchronize your replicas before upgrading, to avoid spurious +conflicts. The first sync after upgrading will be slow. + +\item This version fixes several annoying bugs, including: +\begin{itemize} +\item Some cases where propagation of file permissions was not +working. +\item umask is now ignored when creating directories +\item directories are create writable, so that a read-only directory and + its contents can be propagated. +\item Handling of warnings generated by the server. +\item Synchronizing a path whose parent is not a directory on both sides is +now flagged as erroneous. +\item Fixed some bugs related to symnbolic links and nonexistant roots. +\begin{itemize} +\item + When a change (deletion or new contents) is propagated onto a + 'follow'ed symlink, the file pointed to by the link is now changed. + (We used to change the link itself, which doesn't fit our assertion + that 'follow' means the link is completely invisible) + \item When one root did not exist, propagating the other root on top of it + used to fail, becuase unison could not calculate the working directory + into which to write changes. This should be fixed. +\end{itemize} +\end{itemize} + +\item A human-readable timestamp has been added to Unison's archive files. + +\item The semantics of Path and Name regular expressions now +correspond better. + +\item Some minor improvements to the text UI (e.g. a command for going +back to previous items) + +\item The organization of the export directory has changed --- should +be easier to find / download things now. +\end{changesfromversion} + +\begin{changesfromversion}{1.200} +\item \incompatible{} Archive format has changed. Make sure you +synchronize your replicas before upgrading, to avoid spurious +conflicts. The first sync after upgrading will be slow. + +\item This version has not been tested extensively on Windows. + +\item Major internal changes designed to make unison safer to run +at the same time as the replicas are being changed by the user. + +\item Internal performance improvements. +\end{changesfromversion} + +\begin{changesfromversion}{1.190} +\item \incompatible{} Archive format has changed. Make sure you +synchronize your replicas before upgrading, to avoid spurious +conflicts. The first sync after upgrading will be slow. + +\item A number of internal functions have been changed to reduce the +amount of memory allocation, especially during the first +synchronization. This should help power users with very big replicas. + +\item Reimplementation of low-level remote procedure call stuff, in +preparation for adding rsync-like smart file transfer in a later +release. + +\item Miscellaneous bug fixes. +\end{changesfromversion} + +\begin{changesfromversion}{1.180} +\item \incompatible{} Archive format has changed. Make sure you +synchronize your replicas before upgrading, to avoid spurious +conflicts. The first sync after upgrading will be slow. + +\item Fixed some small bugs in the interpretation of ignore patterns. + +\item Fixed some problems that were preventing the Windows version +from working correctly when click-started. + +\item Fixes to treatment of file permissions under Windows, which were +causing spurious reports of different permissions when synchronizing +between windows and unix systems. + +\item Fixed one more non-tail-recursive list processing function, +which was causing stack overflows when synchronizing very large +replicas. +\end{changesfromversion} + +\begin{changesfromversion}{1.169} +\item The text user interface now provides commands for ignoring + files. +\item We found and fixed some {\em more} non-tail-recursive list + processing functions. Some power users have reported success with + very large replicas. +\item \incompatible +Files ending in \verb|.tmp| are no longer ignored automatically. If you want +to ignore such files, put an appropriate ignore pattern in your profile. + +\item \incompatible{} The syntax of {\tt ignore} and {\tt follow} +patterns has changed. Instead of putting a line of the form +\begin{verbatim} + ignore = +\end{verbatim} + in your profile ({\tt .unison/default.prf}), you should put: +\begin{verbatim} + ignore = Regexp +\end{verbatim} +Moreover, two other styles of pattern are also recognized: +\begin{verbatim} + ignore = Name +\end{verbatim} +matches any path in which one component matches \verb||, while +\begin{verbatim} + ignore = Path +\end{verbatim} +matches exactly the path \verb||. + +Standard ``globbing'' conventions can be used in \verb|| and +\verb||: +\begin{itemize} +\item a \verb|?| matches any single character except \verb|/| +\item a \verb|*| matches any sequence of characters not including \verb|/| +\item \verb|[xyz]| matches any character from the set $\{{\tt x}, + {\tt y}, {\tt z} \}$ +\item \verb|{a,bb,ccc}| matches any one of \verb|a|, \verb|bb|, or + \verb|ccc|. +\end{itemize} + +See the user manual for some examples. +\end{changesfromversion} + +\begin{changesfromversion}{1.146} +\item Some users were reporting stack overflows when synchronizing + huge directories. We found and fixed some non-tail-recursive list + processing functions, which we hope will solve the problem. Please + give it a try and let us know. +\item Major additions to the documentation. +\end{changesfromversion} + +\begin{changesfromversion}{1.142} +\item Major internal tidying and many small bugfixes. +\item Major additions to the user manual. +\item Unison can now be started with no arguments -- it will prompt +automatically for the name of a profile file containing the roots to +be synchronized. This makes it possible to start the graphical UI +from a desktop icon. +\item Fixed a small bug where the text UI on NT was raising a 'no such + signal' exception. +\end{changesfromversion} + +\begin{changesfromversion}{1.139} +\item The precompiled windows binary in the last release was compiled +with an old OCaml compiler, causing propagation of permissions not to +work (and perhaps leading to some other strange behaviors we've heard +reports about). This has been corrected. If you're using precompiled +binaries on Windows, please upgrade. +\item Added a \verb|-debug| command line flag, which controls debugging +of various modules. Say \verb|-debug XXX| to enable debug tracing for +module \verb|XXX|, or \verb|-debug all| to turn on absolutely everything. +\item Fixed a small bug where the text UI on NT was raising a 'no such signal' +exception. +\end{changesfromversion} + +\begin{changesfromversion}{1.111} +\item \incompatible{} The names and formats of the preference files in +the .unison directory have changed. In particular: +\begin{itemize} +\item the file ``prefs'' should be renamed to default.prf +\item the contents of the file ``ignore'' should be merged into + default.prf. Each line of the form \verb|REGEXP| in ignore should + become a line of the form \verb|ignore = REGEXP| in default.prf. +\end{itemize} +\item Unison now handles permission bits and symbolic links. See the +manual for details. + +\item You can now have different preference files in your .unison +directory. If you start unison like this +\begin{verbatim} + unison profilename +\end{verbatim} +(i.e. with just one ``anonymous'' command-line argument), then the +file \verb|~/.unison/profilename.prf| will be loaded instead of +\verb|default.prf|. + +\item Some improvements to terminal handling in the text user interface + +\item Added a switch -killServer that terminates the remote server process +when the unison client is shutting down, even when using sockets for +communication. (By default, a remote server created using ssh/rsh is +terminated automatically, while a socket server is left running.) +\item When started in 'socket server' mode, unison prints 'server started' on + stderr when it is ready to accept connections. + (This may be useful for scripts that want to tell when a socket-mode server + has finished initalization.) +\item We now make a nightly mirror of our current internal development + tree, in case anyone wants an up-to-the-minute version to hack + around with. +\item Added a file CONTRIB with some suggestions for how to help us +make Unison better. +\end{changesfromversion} + Deleted: branches/2.32/src/Makefile.OCaml =================================================================== --- trunk/src/Makefile.OCaml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/Makefile.OCaml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,392 +0,0 @@ -#################################################################### -# Makefile rules for compiling ocaml programs # -#################################################################### - -#################################################################### -### Try to automatically guess OS - -ifeq (${OSCOMP},cygwingnuc) # Define this if compiling with Cygwin GNU C - OSARCH=win32gnuc - ETAGS=/bin/etags - buildexecutable:: win32rc/unison.res.lib -else -# Win32 system -ifeq (${OSTYPE},cygwin32) # Cygwin Beta 19 - OSARCH=win32 - ETAGS=/bin/etags -else -ifeq (${OSTYPE},cygwin) # Cygwin Beta 20 - OSARCH=win32 - ETAGS=/bin/etags -else - -# Unix system -ifeq ($(shell uname),SunOS) - OSARCH=solaris -else -ifeq ($(shell uname),Darwin) - OSARCH=osx -else -ifeq ($(shell uname),OpenBSD) - OSARCH=OpenBSD -else -ifeq ($(shell uname),NetBSD) - OSARCH=NetBSD -endif -endif -endif -endif -ETAGS=etags -endif -endif -endif - -# The OCaml lib dir is used by all versions -# It is extracted from 'ocamlc -v' and Windows '\' separators are turned -# to Unix '/' separators, and extraneous control-M's are deleted. -# Unfortunately there is a literal control-M buried in this, I'd rather -# get rid of it... -# OCAMLLIBDIR=$(shell ocamlc -v | tail -n -1 | sed -e 's/.* //g' | sed -e 's/\\/\//g' | sed -e 's///g') -# Better(?) version, June 2005: -OCAMLLIBDIR=$(shell ocamlc -v | tail -n -1 | sed -e 's/.* //g' | sed -e 's/\\/\//g' | tr -d '\r') - -## BCP (6/05) an alternative, but not quite working, version -## suggested by Nick Montfort: -# OCAMLLIBDIR=$(shell ocamlc -v | sed -n '$p' | sed -e 's/^Standard library directory: //' | sed -e 's/\\/\//g' | sed -e 's/\r//g') - -# User interface style: -# Legal values are -# UISTYLE=text -# UISTYLE=gtk -# UISTYLE=gtk2 -# UISTYLE=mac (old and limited, but working) -# UISTYLE=macnew (spiffy, but not yet extensively tested) -# -# This should be set to an appropriate value automatically, depending -# on whether the lablgtk library is available -LABLGTKLIB=$(OCAMLLIBDIR)/lablgtk -LABLGTK2LIB=$(OCAMLLIBDIR)/lablgtk2 -##BCP [3/2007]: Removed temporarily, since the OSX UI is not working well -## at the moment and we don't want to confuse people by building it by default -ifeq ($(OSARCH),osx) - UISTYLE=macnew -else - ifeq ($(wildcard $(LABLGTK2LIB)),$(LABLGTK2LIB)) - UISTYLE=gtk2 - else - UISTYLE=text -endif -endif -buildexecutable:: - @echo UISTYLE = $(UISTYLE) - -#################################################################### -### Default parameters - -INCLFLAGS=-I lwt -I ubase -CAMLFLAGS+=$(INCLFLAGS) - -ifeq ($(OSARCH),win32) - # Win32 system - EXEC_EXT=.exe - OBJ_EXT=.obj - CWD=. -# Fix suggested by Karl M, Jan 2009: -# "The new flexlink wrapper that OCaml 3.11 uses was gagging on the res -# file. So the res file has to be passed through flexlink untouched to -# the linker. I only touched the MSVC side, but mingw may have the same -# issue." -# CLIBS+=-cclib win32rc/unison.res -# STATICLIBS+=-cclib win32rc/unison.res - CLIBS+=-cclib "-link win32rc/unison.res" - STATICLIBS+=-cclib "-link win32rc/unison.res" - buildexecutable:: - @echo Building for Windows -else - # Unix system, or Cygwin with GNU C compiler - OBJ_EXT=.o - CWD=$(shell pwd) - ifeq ($(OSARCH),win32gnuc) - EXEC_EXT=.exe - CLIBS+=-cclib win32rc/unison.res.lib - STATIC=false # Cygwin is not MinGW :-( - buildexecutable:: - @echo Building for Windows with Cygwin GNU C - else - EXEC_EXT= - # openpty is in the libutil library - ifneq ($(OSARCH),solaris) - ifneq ($(OSARCH),osx) - CLIBS+=-cclib -lutil - endif - endif - buildexecutable:: - @echo Building for Unix - endif -endif - -buildexecutable:: - @echo NATIVE = $(NATIVE) - @echo THREADS = $(THREADS) - @echo STATIC = $(STATIC) - @echo OSTYPE = $(OSTYPE) - @echo OSARCH = $(OSARCH) - -ubase/projectInfo.ml: mkProjectInfo - echo 'let myName = "'$(NAME)'";;' > $@ - echo 'let myVersion = "'$(VERSION)'";;' >> $@ - echo 'let myMajorVersion = "'$(MAJORVERSION)'";;' >> $@ - -clean:: - $(RM) ubase/projectInfo.ml - -#################################################################### -### Unison objects and libraries - -ifeq ($(UISTYLE),mac) - buildexecutable:: macexecutable - UIMACDIR=uimac -else -ifeq ($(UISTYLE),macnew) - buildexecutable:: macexecutable - UIMACDIR=uimacnew -else - buildexecutable:: $(NAME)$(EXEC_EXT) -endif -endif - -# NOTE: the OCAMLLIBDIR is not getting passed correctly? -# The two cases for cltool are needed because Xcode 2.1+ -# builds in build/Default/, and earlier versions use build/ -macexecutable: $(NAME)-blob.o -# sed -e's/@@VERSION@@/$(VERSION)/' $(UIMACDIR)/Info.plist.template > $(UIMACDIR)/Info.plist - (cd $(UIMACDIR); xcodebuild OCAMLLIBDIR="$(OCAMLLIBDIR)" SYMROOT=build) - if [ -e $(UIMACDIR)/build/Default ]; then \ - gcc -mmacosx-version-min=10.4 $(UIMACDIR)/cltool.c -o $(UIMACDIR)/build/Default/Unison.app/Contents/MacOS/cltool -framework Carbon; \ - else \ - gcc -mmacosx-version-min=10.4 $(UIMACDIR)/cltool.c -o $(UIMACDIR)/build/Unison.app/Contents/MacOS/cltool -framework Carbon; \ - fi - -# OCaml objects for the bytecode version -# File extensions will be substituted for the native code version - -OCAMLOBJS += \ - ubase/projectInfo.cmo ubase/myMap.cmo ubase/safelist.cmo \ - ubase/uprintf.cmo ubase/util.cmo ubase/rx.cmo ubase/uarg.cmo \ - ubase/prefs.cmo ubase/trace.cmo \ - \ - lwt/pqueue.cmo lwt/lwt.cmo lwt/lwt_util.cmo lwt/lwt_unix.cmo \ - \ - case.cmo pred.cmo uutil.cmo \ - fileutil.cmo name.cmo path.cmo fspath.cmo fingerprint.cmo \ - abort.cmo osx.cmo external.cmo \ - props.cmo fileinfo.cmo os.cmo lock.cmo clroot.cmo common.cmo \ - tree.cmo checksum.cmo terminal.cmo \ - transfer.cmo xferhint.cmo remote.cmo globals.cmo copy.cmo \ - stasher.cmo update.cmo \ - files.cmo sortri.cmo recon.cmo transport.cmo \ - strings.cmo uicommon.cmo uitext.cmo test.cmo - -OCAMLOBJS+=main.cmo - -# OCaml libraries for the bytecode version -# File extensions will be substituted for the native code version -OCAMLLIBS+=unix.cma str.cma - -COBJS+=osxsupport$(OBJ_EXT) pty$(OBJ_EXT) - -######################################################################## -### User Interface setup - -## Text UI -ifeq ($(UISTYLE), text) - OCAMLOBJS+=linktext.cmo -endif - -## Old Mac UI -ifeq ($(UISTYLE),mac) - OCAMLOBJS+=uimacbridge.cmo -endif - -## New Mac UI -ifeq ($(UISTYLE),macnew) - OCAMLOBJS+=uimacbridgenew.cmo - THREADS=true - OCAMLLIBS+=threads.cma - INCLFLAGS+=-thread -endif - -## Graphic UI - -# Setup the lib directories - -# Win32 system : this very Makefile must be used with GNU Make, so that we -# expect CygWin Bash to be used. -# The directory must be provided following one of the model below : -# - unix, relative ../../ocaml/lib/labltk -# - unix, absolute d:/home/foobar/ocaml/lib/labltk -# - dos, relative ..\\..\\ocaml\\lib\\labltk -# - dos, absolute d:\\home\\foobar\\ocaml\\lib\\labltk - -# Patch to make a Windows GUI version come up with no -# console when click-started -# ifeq ($(OSARCH), win32) -# COBJS+=winmain.c -# CFLAGS+=-cclib /subsystem:windows -# endif - -# Gtk GUI -ifeq ($(UISTYLE), gtk) - CAMLFLAGS+=-I +lablgtk - OCAMLOBJS+=pixmaps.cmo uigtk.cmo linkgtk.cmo - OCAMLLIBS+=lablgtk.cma -endif - -# Gtk2 GUI -ifeq ($(UISTYLE), gtk2) - CAMLFLAGS+=-I +lablgtk2 - OCAMLOBJS+=pixmaps.cmo uigtk2.cmo linkgtk2.cmo - OCAMLLIBS+=lablgtk.cma -endif - -#################################################################### -### Static build setup - -ifeq ($(STATIC), true) - STATICLIBS+=-cclib -static -endif - -#################################################################### -### Dependencies - -# Include an automatically generated list of dependencies -include .depend - -ifeq ($(OSARCH), OpenBSD) - ifeq ($(shell echo type ocamldot | ksh), file) - OCAMLDOT=true - endif -else - ifeq ($(shell echo type -t ocamldot | bash), file) - OCAMLDOT=true - endif -endif - -ifeq ($(OSARCH), NetBSD) - OCAMLDOT=false -endif - -# Rebuild dependencies (must be invoked manually) -.PHONY: depend -depend:: - ocamldep $(INCLFLAGS) *.mli *.ml */*.ml */*.mli > .depend -ifdef OCAMLDOT - echo 'digraph G {' > dot.tmp - echo '{ rank = same; "Fileinfo"; "Props"; "Fspath"; "Os"; "Path"; }'\ - >>dot.tmp - echo '{ rank = same; "Uitext"; "Uigtk"; }'>>dot.tmp - echo '{ rank = same; "Recon"; "Update"; "Transport"; "Files"; }'\ - >>dot.tmp - echo '{ rank = same; "Tree"; "Safelist"; }'>>dot.tmp - echo '{ rank = same; "Uarg"; "Prefs"; }'>>dot.tmp - ocamldot .depend | tail -n +2 >> dot.tmp - -dot -Tps -o DEPENDENCIES.ps dot.tmp -endif - -#################################################################### -### Compilation boilerplate - -ifeq ($(DEBUGGING), false) - ifneq ($(OSARCH), win32) - ifneq ($(OSARCH), osx) - # Strip the binary (does not work with MS compiler; might not work - # under OSX) - CFLAGS+=-cclib -Wl,-s - endif - endif -endif - -ifeq ($(PROFILING), true) - OCAMLC=ocamlcp -else - OCAMLC=ocamlc -endif -OCAMLOPT=ocamlopt - -ifeq ($(NATIVE), true) - ## Set up for native code compilation - - CAMLC=$(OCAMLOPT) - ifeq ($(PROFILING), true) - CAMLFLAGS+=-p - CLIBS+=-cclib -ldl - endif - - CAMLOBJS=$(subst .cmo,.cmx, $(subst .cma,.cmxa, $(OCAMLOBJS))) - CAMLLIBS=$(subst .cma,.cmxa, $(OCAMLLIBS)) - -else - ## Set up for bytecode compilation - - CAMLC=$(OCAMLC) - CAMLFLAGS+=-custom - ifeq ($(DEBUGGING), true) - CAMLFLAGS+=-g - endif - - CAMLOBJS=$(OCAMLOBJS) - CAMLLIBS=$(OCAMLLIBS) - -endif - -win32rc/unison.res.lib: win32rc/unison.res - windres win32rc/unison.res win32rc/unison.res.lib - -%.ml: %.mll - -$(RM) $@ - ocamllex $< - -%.cmi : %.mli - @echo "$(CAMLC): $< ---> $@" - $(CAMLC) $(CAMLFLAGS) -c $(CWD)/$< - -%.cmo: %.ml - @echo "$(OCAMLC): $< ---> $@" - $(OCAMLC) $(CAMLFLAGS) -c $(CWD)/$< - -%.cmx: %.ml - @echo "$(OCAMLOPT): $< ---> $@" - $(OCAMLOPT) $(CAMLFLAGS) -c $(CWD)/$< - -%.o %.obj: %.c - @echo "$(OCAMLOPT): $< ---> $@" - $(CAMLC) $(CAMLFLAGS) -c $(CWD)/$< - -$(NAME)$(EXEC_EXT): $(CAMLOBJS) $(COBJS) - @echo Linking $@ - $(CAMLC) -verbose $(CAMLFLAGS) -o $@ $(CFLAGS) $(CAMLLIBS) $(CLIBS) $^ - -# Unfortunately -output-obj does not put .o files into the output, only .cmx -# files, so we have to use $(LD) to take care of COBJS. -$(NAME)-blob.o: $(CAMLOBJS) $(COBJS) - @echo Linking $@ - $(CAMLC) -output-obj -verbose $(CAMLFLAGS) -o u-b.o $(CFLAGS) $(CAMLLIBS) $(CLIBS) $(CAMLOBJS) - $(LD) -r -o $@ u-b.o $(COBJS) - $(RM) u-b.o - -%$(EXEC_EXT): %.ml - $(OCAMLC) -verbose -o $@ $^ - -###################################################################### -### Misc - -clean:: - -$(RM) -r *.cmi *.cmo *.cmx *.cma *.cmxa TAGS tags - -$(RM) -r *.o core gmon.out *~ .*~ - -$(RM) -r *.obj *.lib *.exp - -$(RM) -r *.tmp *.bak?.tmp .*.bak?.tmp - -paths: - @echo PATH = $(PATH) - @echo OCAMLLIBDIR = $(OCAMLLIBDIR) - Copied: branches/2.32/src/Makefile.OCaml (from rev 320, trunk/src/Makefile.OCaml) =================================================================== --- branches/2.32/src/Makefile.OCaml (rev 0) +++ branches/2.32/src/Makefile.OCaml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,394 @@ +#################################################################### +# Makefile rules for compiling ocaml programs # +#################################################################### + +#################################################################### +### Try to automatically guess OS + +ifeq (${OSCOMP},cygwingnuc) # Define this if compiling with Cygwin GNU C + OSARCH=win32gnuc + ETAGS=/bin/etags + buildexecutable:: win32rc/unison.res.lib +else +# Win32 system +ifeq (${OSTYPE},cygwin32) # Cygwin Beta 19 + OSARCH=win32 + ETAGS=/bin/etags +else +ifeq (${OSTYPE},cygwin) # Cygwin Beta 20 + OSARCH=win32 + ETAGS=/bin/etags +else + +# Unix system +ifeq ($(shell uname),SunOS) + OSARCH=solaris +else +ifeq ($(shell uname),Darwin) + OSARCH=osx +else +ifeq ($(shell uname),OpenBSD) + OSARCH=OpenBSD +else +ifeq ($(shell uname),NetBSD) + OSARCH=NetBSD +endif +endif +endif +endif +ETAGS=etags +endif +endif +endif + +# The OCaml lib dir is used by all versions +# It is extracted from 'ocamlc -v' and Windows '\' separators are turned +# to Unix '/' separators, and extraneous control-M's are deleted. +# Unfortunately there is a literal control-M buried in this, I'd rather +# get rid of it... +# OCAMLLIBDIR=$(shell ocamlc -v | tail -n -1 | sed -e 's/.* //g' | sed -e 's/\\/\//g' | sed -e 's///g') +# Better(?) version, June 2005: +OCAMLLIBDIR=$(shell ocamlc -v | tail -n -1 | sed -e 's/.* //g' | sed -e 's/\\/\//g' | tr -d '\r') + +## BCP (6/05) an alternative, but not quite working, version +## suggested by Nick Montfort: +# OCAMLLIBDIR=$(shell ocamlc -v | sed -n '$p' | sed -e 's/^Standard library directory: //' | sed -e 's/\\/\//g' | sed -e 's/\r//g') + +# User interface style: +# Legal values are +# UISTYLE=text +# UISTYLE=gtk +# UISTYLE=gtk2 +# UISTYLE=mac (old and limited, but working) +# UISTYLE=macnew (spiffy, but not yet extensively tested) +# +# This should be set to an appropriate value automatically, depending +# on whether the lablgtk library is available +LABLGTKLIB=$(OCAMLLIBDIR)/lablgtk +LABLGTK2LIB=$(OCAMLLIBDIR)/lablgtk2 +##BCP [3/2007]: Removed temporarily, since the OSX UI is not working well +## at the moment and we don't want to confuse people by building it by default +ifeq ($(OSARCH),osx) + UISTYLE=macnew +else + ifeq ($(wildcard $(LABLGTK2LIB)),$(LABLGTK2LIB)) + UISTYLE=gtk2 + else + UISTYLE=text +endif +endif +buildexecutable:: + @echo UISTYLE = $(UISTYLE) + +#################################################################### +### Default parameters + +INCLFLAGS=-I lwt -I ubase +CAMLFLAGS+=$(INCLFLAGS) + +ifeq ($(OSARCH),win32) + # Win32 system + EXEC_EXT=.exe + OBJ_EXT=.obj + CWD=. +# Fix suggested by Karl M, Jan 2009: +# "The new flexlink wrapper that OCaml 3.11 uses was gagging on the res +# file. So the res file has to be passed through flexlink untouched to +# the linker. I only touched the MSVC side, but mingw may have the same +# issue." +# CLIBS+=-cclib win32rc/unison.res +# STATICLIBS+=-cclib win32rc/unison.res + CLIBS+=-cclib "-link win32rc/unison.res" + STATICLIBS+=-cclib "-link win32rc/unison.res" + buildexecutable:: + @echo Building for Windows +else + # Unix system, or Cygwin with GNU C compiler + OBJ_EXT=.o + CWD=$(shell pwd) + ifeq ($(OSARCH),win32gnuc) + EXEC_EXT=.exe + CLIBS+=-cclib win32rc/unison.res.lib + STATIC=false # Cygwin is not MinGW :-( + buildexecutable:: + @echo Building for Windows with Cygwin GNU C + else + EXEC_EXT= + # openpty is in the libutil library + ifneq ($(OSARCH),solaris) + ifneq ($(OSARCH),osx) + CLIBS+=-cclib -lutil + endif + endif + buildexecutable:: + @echo Building for Unix + endif +endif + +buildexecutable:: + @echo NATIVE = $(NATIVE) + @echo THREADS = $(THREADS) + @echo STATIC = $(STATIC) + @echo OSTYPE = $(OSTYPE) + @echo OSARCH = $(OSARCH) + +ubase/projectInfo.ml: mkProjectInfo + echo 'let myName = "'$(NAME)'";;' > $@ + echo 'let myVersion = "'$(VERSION)'";;' >> $@ + echo 'let myMajorVersion = "'$(MAJORVERSION)'";;' >> $@ + +clean:: + $(RM) ubase/projectInfo.ml + +#################################################################### +### Unison objects and libraries + +ifeq ($(UISTYLE),mac) + buildexecutable:: macexecutable + UIMACDIR=uimac +else +ifeq ($(UISTYLE),macnew) + buildexecutable:: macexecutable + UIMACDIR=uimacnew +else + buildexecutable:: $(NAME)$(EXEC_EXT) +endif +endif + +MINOSXVERSION=10.5 + +# NOTE: the OCAMLLIBDIR is not getting passed correctly? +# The two cases for cltool are needed because Xcode 2.1+ +# builds in build/Default/, and earlier versions use build/ +macexecutable: $(NAME)-blob.o +# sed -e's/@@VERSION@@/$(VERSION)/' $(UIMACDIR)/Info.plist.template > $(UIMACDIR)/Info.plist + (cd $(UIMACDIR); xcodebuild OCAMLLIBDIR="$(OCAMLLIBDIR)" SYMROOT=build) + if [ -e $(UIMACDIR)/build/Default ]; then \ + gcc -mmacosx-version-min=$(MINOSXVERSION) $(UIMACDIR)/cltool.c -o $(UIMACDIR)/build/Default/Unison.app/Contents/MacOS/cltool -framework Carbon; \ + else \ + gcc -mmacosx-version-min=$(MINOSXVERSION) $(UIMACDIR)/cltool.c -o $(UIMACDIR)/build/Unison.app/Contents/MacOS/cltool -framework Carbon; \ + fi + +# OCaml objects for the bytecode version +# File extensions will be substituted for the native code version + +OCAMLOBJS += \ + ubase/projectInfo.cmo ubase/myMap.cmo ubase/safelist.cmo \ + ubase/uprintf.cmo ubase/util.cmo ubase/rx.cmo ubase/uarg.cmo \ + ubase/prefs.cmo ubase/trace.cmo \ + \ + lwt/pqueue.cmo lwt/lwt.cmo lwt/lwt_util.cmo lwt/lwt_unix.cmo \ + \ + case.cmo pred.cmo uutil.cmo \ + fileutil.cmo name.cmo path.cmo fspath.cmo fingerprint.cmo \ + abort.cmo osx.cmo external.cmo \ + props.cmo fileinfo.cmo os.cmo lock.cmo clroot.cmo common.cmo \ + tree.cmo checksum.cmo terminal.cmo \ + transfer.cmo xferhint.cmo remote.cmo globals.cmo copy.cmo \ + stasher.cmo update.cmo \ + files.cmo sortri.cmo recon.cmo transport.cmo \ + strings.cmo uicommon.cmo uitext.cmo test.cmo + +OCAMLOBJS+=main.cmo + +# OCaml libraries for the bytecode version +# File extensions will be substituted for the native code version +OCAMLLIBS+=unix.cma str.cma + +COBJS+=osxsupport$(OBJ_EXT) pty$(OBJ_EXT) + +######################################################################## +### User Interface setup + +## Text UI +ifeq ($(UISTYLE), text) + OCAMLOBJS+=linktext.cmo +endif + +## Old Mac UI +ifeq ($(UISTYLE),mac) + OCAMLOBJS+=uimacbridge.cmo +endif + +## New Mac UI +ifeq ($(UISTYLE),macnew) + OCAMLOBJS+=uimacbridgenew.cmo + THREADS=true + OCAMLLIBS+=threads.cma + INCLFLAGS+=-thread +endif + +## Graphic UI + +# Setup the lib directories + +# Win32 system : this very Makefile must be used with GNU Make, so that we +# expect CygWin Bash to be used. +# The directory must be provided following one of the model below : +# - unix, relative ../../ocaml/lib/labltk +# - unix, absolute d:/home/foobar/ocaml/lib/labltk +# - dos, relative ..\\..\\ocaml\\lib\\labltk +# - dos, absolute d:\\home\\foobar\\ocaml\\lib\\labltk + +# Patch to make a Windows GUI version come up with no +# console when click-started +# ifeq ($(OSARCH), win32) +# COBJS+=winmain.c +# CFLAGS+=-cclib /subsystem:windows +# endif + +# Gtk GUI +ifeq ($(UISTYLE), gtk) + CAMLFLAGS+=-I +lablgtk + OCAMLOBJS+=pixmaps.cmo uigtk.cmo linkgtk.cmo + OCAMLLIBS+=lablgtk.cma +endif + +# Gtk2 GUI +ifeq ($(UISTYLE), gtk2) + CAMLFLAGS+=-I +lablgtk2 + OCAMLOBJS+=pixmaps.cmo uigtk2.cmo linkgtk2.cmo + OCAMLLIBS+=lablgtk.cma +endif + +#################################################################### +### Static build setup + +ifeq ($(STATIC), true) + STATICLIBS+=-cclib -static +endif + +#################################################################### +### Dependencies + +# Include an automatically generated list of dependencies +include .depend + +ifeq ($(OSARCH), OpenBSD) + ifeq ($(shell echo type ocamldot | ksh), file) + OCAMLDOT=true + endif +else + ifeq ($(shell echo type -t ocamldot | bash), file) + OCAMLDOT=true + endif +endif + +ifeq ($(OSARCH), NetBSD) + OCAMLDOT=false +endif + +# Rebuild dependencies (must be invoked manually) +.PHONY: depend +depend:: + ocamldep $(INCLFLAGS) *.mli *.ml */*.ml */*.mli > .depend +ifdef OCAMLDOT + echo 'digraph G {' > dot.tmp + echo '{ rank = same; "Fileinfo"; "Props"; "Fspath"; "Os"; "Path"; }'\ + >>dot.tmp + echo '{ rank = same; "Uitext"; "Uigtk"; }'>>dot.tmp + echo '{ rank = same; "Recon"; "Update"; "Transport"; "Files"; }'\ + >>dot.tmp + echo '{ rank = same; "Tree"; "Safelist"; }'>>dot.tmp + echo '{ rank = same; "Uarg"; "Prefs"; }'>>dot.tmp + ocamldot .depend | tail -n +2 >> dot.tmp + -dot -Tps -o DEPENDENCIES.ps dot.tmp +endif + +#################################################################### +### Compilation boilerplate + +ifeq ($(DEBUGGING), false) + ifneq ($(OSARCH), win32) + ifneq ($(OSARCH), osx) + # Strip the binary (does not work with MS compiler; might not work + # under OSX) + CFLAGS+=-cclib -Wl,-s + endif + endif +endif + +ifeq ($(PROFILING), true) + OCAMLC=ocamlcp +else + OCAMLC=ocamlc +endif +OCAMLOPT=ocamlopt + +ifeq ($(NATIVE), true) + ## Set up for native code compilation + + CAMLC=$(OCAMLOPT) + ifeq ($(PROFILING), true) + CAMLFLAGS+=-p + CLIBS+=-cclib -ldl + endif + + CAMLOBJS=$(subst .cmo,.cmx, $(subst .cma,.cmxa, $(OCAMLOBJS))) + CAMLLIBS=$(subst .cma,.cmxa, $(OCAMLLIBS)) + +else + ## Set up for bytecode compilation + + CAMLC=$(OCAMLC) + CAMLFLAGS+=-custom + ifeq ($(DEBUGGING), true) + CAMLFLAGS+=-g + endif + + CAMLOBJS=$(OCAMLOBJS) + CAMLLIBS=$(OCAMLLIBS) + +endif + +win32rc/unison.res.lib: win32rc/unison.res + windres win32rc/unison.res win32rc/unison.res.lib + +%.ml: %.mll + -$(RM) $@ + ocamllex $< + +%.cmi : %.mli + @echo "$(CAMLC): $< ---> $@" + $(CAMLC) $(CAMLFLAGS) -c $(CWD)/$< + +%.cmo: %.ml + @echo "$(OCAMLC): $< ---> $@" + $(OCAMLC) $(CAMLFLAGS) -c $(CWD)/$< + +%.cmx: %.ml + @echo "$(OCAMLOPT): $< ---> $@" + $(OCAMLOPT) $(CAMLFLAGS) -c $(CWD)/$< + +%.o %.obj: %.c + @echo "$(OCAMLOPT): $< ---> $@" + $(CAMLC) $(CAMLFLAGS) -c $(CWD)/$< + +$(NAME)$(EXEC_EXT): $(CAMLOBJS) $(COBJS) + @echo Linking $@ + $(CAMLC) -verbose $(CAMLFLAGS) -o $@ $(CFLAGS) $(CAMLLIBS) $(CLIBS) $^ + +# Unfortunately -output-obj does not put .o files into the output, only .cmx +# files, so we have to use $(LD) to take care of COBJS. +$(NAME)-blob.o: $(CAMLOBJS) $(COBJS) + @echo Linking $@ + $(CAMLC) -output-obj -verbose $(CAMLFLAGS) -o u-b.o $(CFLAGS) $(CAMLLIBS) $(CLIBS) $(CAMLOBJS) + $(LD) -r -o $@ u-b.o $(COBJS) + $(RM) u-b.o + +%$(EXEC_EXT): %.ml + $(OCAMLC) -verbose -o $@ $^ + +###################################################################### +### Misc + +clean:: + -$(RM) -r *.cmi *.cmo *.cmx *.cma *.cmxa TAGS tags + -$(RM) -r *.o core gmon.out *~ .*~ + -$(RM) -r *.obj *.lib *.exp + -$(RM) -r *.tmp *.bak?.tmp .*.bak?.tmp + +paths: + @echo PATH = $(PATH) + @echo OCAMLLIBDIR = $(OCAMLLIBDIR) + Deleted: branches/2.32/src/RECENTNEWS =================================================================== --- trunk/src/RECENTNEWS 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/RECENTNEWS 2009-05-02 02:31:27 UTC (rev 322) @@ -1,585 +0,0 @@ -CHANGES FROM VERSION 2.32.5 - -* Ignore one hour differences for deciding whether a file may have - been updated. This avoids slow update detection after daylight - saving time changes under Windows. This makes it slightly more - likely to miss an update, but that should be safe enough. - -------------------------------- -CHANGES FROM VERSION 2.32.4 - -* Text UI now includes the current time in its completion message - -* Fix a small bug that was affecting mainly windows users. We need to - commit the archives at the end of the sync even if there are 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. (Changed the text UI only. It's less clear where - to change the GUI.) - -* Small improvement to text UI "scanning..." messages, to print just - directories (hopefully making it clearer that individual files are - not necessarily being fingerprinted). - - -------------------------------- -CHANGES FROM VERSION 2.32.2 - -* Don't delete the temp file when a transfer fails due to a - fingerprint mismatch (so that we can have a look and see why!) - -------------------------------- -CHANGES FROM VERSION 2.32.1 - -* Applied a patch from Karl M to make the GTK2 version build with - OCaml 3.11 on Windows. - -* Don't use shortcuts or external copy programs to transfer - zero-length files (to avoid confusing status messages about - shortcut-copying completely unrelated files that happen to also have - zero length!). - - - - - - - -------------------------------- -CHANGES FROM VERSION 2.32.0 - -* Bumped version number to reflect newly added preference - - - - -------------------------------- -CHANGES FROM VERSION 2.31.11 - -* Fixed a bug that was causing new files to be created with - permissions 0x600 instead of using a reasonable default (like - 0x644), if the 'perms' flag was set to 0. (Bug reported by Ben - Crowell.) - -* Added a new preference, 'dontchmod'. By default, Unison uses the - 'chmod' system call to set the permission bits of files after it has - copied them. But in some circumstances (and under some operating - systems), the chmod call always fails. Setting this preference - completely prevents Unison from ever calling chmod. - -* Add some suggestions to TODO file - - - - - - -------------------------------- -CHANGES FROM VERSION 2.31.10 - -* Another slight tweak. - - - - - -------------------------------- -CHANGES FROM VERSION 2.31.9 - -* Slight tweak to the last commit, suggested by Rasmus. - - - - -------------------------------- -CHANGES FROM VERSION 2.31.8 - -* (Forgot to add a couple of new files.) - - - -------------------------------- -CHANGES FROM VERSION 2.31.5 - -* A special hack for Rasmus, who has a special situation that requires - the utimes-setting program to run 'setuid root' (and we do not want - all of Unison to run setuid, so we just spin off an external utility - to do it). This functionality is disabled by default and requires - editing the source code (changing 'false' to 'true' on line 496 of - props.ml) and recompiling to enable. If there are other people that - want it, we can easily make it accessible using a preference - instead, but I prefer not to add a preference until someone else - requests it, to avoid creating an incompatible version. - -* Logging tweak. - - - -------------------------------- -CHANGES FROM VERSION 2.31.5 - -* A special hack for Rasmus, who has a special situation that requires - the utimes-setting program to run 'setuid root' (and we do not want - all of Unison to run setuid, so we just spin off an external utility - to do it). This functionality is disabled by default and requires - editing the source code (changing 'false' to 'true' on line 496 of - props.ml) and recompiling to enable. If there are other people that - want it, we can easily make it accessible using a preference - instead, but I prefer not to add a preference until someone else - requests it, to avoid creating an incompatible version. - -* Logging tweak. - - - -------------------------------- -CHANGES FROM VERSION 2.31.5 - -* A special hack for Rasmus, who has a special situation that requires - the utimes-setting program to run 'setuid root' (and we do not want - all of Unison to run setuid, so we just spin off an external utility - to do it). This functionality is disabled by default and requires - editing the source code (changing 'false' to 'true' on line 496 of - props.ml) and recompiling to enable. If there are other people that - want it, we can easily make it accessible using a preference - instead, but I prefer not to add a preference until someone else - requests it, to avoid creating an incompatible version. - -* Logging tweak. - - -CHANGES FROM VERSION 2.31.5 - -Resizing the update window vertically no longer moves the status label. Fix contributed by Pedro Melo. -------------------------------- - -CHANGES FROM VERSION 2.31.4 - -* Don't ignore files that look like backup files if the {\\tt - backuplocation} preference is set to {\\tt central} - -------------------------------- -CHANGES FROM VERSION 2.31.3 - -* Updated documentation with recently added preferences. - -* Applied patch from Antoine Reilles for NetBSD compilation - -* Makefile tidying - -------------------------------- -CHANGES FROM VERSION 2.31.2 - -* Added a bit of debugging code for Alan. - -------------------------------- -CHANGES FROM VERSION 2.31.1 - -* Fixed a small bug with resuming interrupted file transfers when both - replicas are local. -------------------------------- -CHANGES FROM VERSION 2.31.-1 - -* Fixed a couple of file-transfer bugs. (One was about copying - resource forks. Another was about restarting interrupted transfers - on files where exactly zero bytes had been transferred so far and - the file had been created with null permissions -- believe it or - not, this is possible with rsync!) This required a protocol change, - so I'm also bumping the version number. - -------------------------------- -CHANGES FROM VERSION 2.30.4 - -* Work on text UI to prepare for new filesystem watcher functionality - -* Record some current TODO items - - - - -------------------------------- -CHANGES FROM VERSION 2.30.3 - -* Update docs - - - -------------------------------- -CHANGES FROM VERSION 2.30.2 - -fix quoting for Unix - -------------------------------- -CHANGES FROM VERSION 2.30.1 - -- Fixed handling of paths containing spaces when using rsync -- Better error report for fingerprint mismatch -------------------------------- -CHANGES FROM VERSION 2.30.0 - -* A better fix for the "single file transfer failed in large directory" issue. - - -------------------------------- -CHANGES FROM VERSION 2.29.9 - -* Trying a possible fix for the "assert failure in remote.ml" bug - (thanks Jerome!) - - -------------------------------- -CHANGES FROM VERSION 2.29.8 - -* Updated documentation. - -* Shortened the names of several preferences. The old names are also - still supported, for backwards compatibility, but they do not appear - in the documentation. - - -------------------------------- -CHANGES FROM VERSION 2.29.7 - -* Squashed a bug in transferring partially transferred directories - containing symlinks. - -* Squashed some more bugs in partial rsync transfers (rsync, oddly, - creates files with zero permissions and then on the next run - discovers that it cannot write to the file it partially wrote - before!). - -* Added a "copyprogrest" preference, so that we can give different - command lines for invoking the external copy utility depending on - whether a partially transferred file already exists or not. (Rsync - doesn't seem to care about this, but other utilities may.) - - - - -------------------------------- -CHANGES FROM VERSION 2.29.7 - -* Squashed a bug in transferring partially transferred directories - containing symlinks. - -* Squashed some more bugs in partial rsync transfers (rsync, oddly, - creates files with zero permissions and then on the next run - discovers that it cannot write to the file it partially wrote - before!). - -* Added a "copyprogrest" preference, so that we can give different - command lines for invoking the external copy utility depending on - whether a partially transferred file already exists or not. (Rsync - doesn't seem to care about this, but other utilities may.) - - - - -------------------------------- -CHANGES FROM VERSION 2.29.6 - -* Fix a small bug in the external copyprog setup. - - -------------------------------- -CHANGES FROM VERSION 2.29.5 - -* Lots of little documentation tidying. (In particular, I finally - spent the time to separate preferences into Basic and Advanced! - This should hopefully make Unison a little more approachable for new - users.) - - - -------------------------------- -CHANGES FROM VERSION 2.29.4 - -* When using the internal transfer method, remove any temp file on the - destination (which may be left over from a previous interrupted run - of Unison) before starting the transfer. - -* Fixed (hopefully!) the bug causing Unison to backup the new archive - version after a (partially or fully) successful merge. - -* Updated copyright notices to 2008. :-) - - -------------------------------- -CHANGES FROM VERSION 2.29.3 - -* Updated documentation to describe new features - -* Changed units of copythreshold to kilobytes - -* Added -z to flags for external rsync program -------------------------------- -CHANGES FROM VERSION 2.29.2 - -* Automatically supply "user@" in argument to external copy program. - - -------------------------------- -CHANGES FROM VERSION 2.29.1 - -Follow maxthreads preference when transferring directories. -------------------------------- -CHANGES FROM VERSION 2.29.0 - -This version introduces some pretty big changes, by BCP in -collaboration with Alan Schmitt. We've tested them minimally, but -this version should be considered "only for the adventurous" for the -moment. - -* Added some more debugging code to remote.ml to give more informative - error messages when we encounter the (dreaded and longstanding) - "assert failed during file transfer" bug - -* Experimental support for invoking an external file transfer tool for - whole-file copies instead of Unison's built-in transfer protocol. - - Two new preferences have been added: - - - copyprog is a string giving the name (and command-line switches, - if needed) of an external program that can be used to copy large - files efficiently. By default, rsync is invoked, but other - tools such as scp can be used instead by changing the value of - this preference. (Although this is not its primary purpose, - rsync is actually a pretty fast way of copying files that don't - already exist on the receiving host.) For files that do already - exist on (but that have been changed in one replica), Unison - will always use its built-in implementation of the rsync - algorithm. - - - copythreshold is an integer (-1 by default), indicating above - what filesize (in megabytes) Unison should use the external - copying utility specified by copyprog. Specifying 0 will cause - ALL copies to use the external program; a negative number will - prevent any files from using it. (Default is -1.) - -* If Unison is interrupted during a directory transfer, it will now - leave the partially transferred directory intact in a temporary - location. (This maintains the invariant that new files/directories - are transferred either completely or not at all.) The next time - Unison is run, it will continue filling in this temporary directory, - skipping transferring files that it finds are already there. - - -------------------------------- -CHANGES FROM VERSION 2.28.51 - -* Propagating changes from 2.27 branch - - -------------------------------- -CHANGES FROM VERSION 2.28.51 - -* Propagating changes from 2.27 branch - - -------------------------------- -CHANGES FROM VERSION 2.28.45 - -* Unison can sometimes fail to transfer a file, giving the unhelpful - message "Destination updated during synchronization" even though the - file has not been changed. This can be caused by programs that - change either the file's contents *or* the file's extended - attributes without changing its modification time. I'm not sure - what is the best fix for this -- it is not Unison's fault, but it - makes Unison's behavior puzzling -- but at least Unison can be more - helpful about suggesting a workaround (running once with 'fastcheck' - set to false). The failure message has been changed to give this - advice. - -* Upgraded to GPL version 3 and added copyright notice to - documentation files. - -------------------------------- -CHANGES FROM VERSION 2.28.36 - -* Transfer changes from 2.27 branch - -------------------------------- -------------------------------- -CHANGES FROM VERSION 2.28.29 - -* Propagage changes from 2.27 branch. - - -------------------------------- -CHANGES FROM VERSION 2.28.23 - -* Small improvement to error message when no archive files are - found (thanks to Norman Ramsey). - -* Patch from Karl M for GTK2 UI: - 1) reverts the problematic (when no profile is used) - reloadProfile on the restart button. - 2) it adds a reloadProfile call after the detectCmd for - rescanning unsynchronized items. - 3) it turns off confirmBigDeletes on a rescan and checks it - before issuing a warning popup. - 4) it adjusts the status results width so that everything fits. - -------------------------------- -CHANGES FROM VERSION 2.28.17 - -* Applying a patch from Karl M to make the Restart button reload the - profile in the uigtk2 UI. - -* Fixed a bug in the merge code (new archive was not being backed up). - Minor improvements to the merge code to make it say more about what - it's doing and why. - - -------------------------------- -CHANGES FROM VERSION 2.28.16 - -More Mac UI improvements -* Revert the combo ProgressIndicator / status message (couldn't get the flicker to go away...) -* Improved file change icons - - Lighter color / slight gradient wash - - Icons for Absent (opposite side of an add) and Unmodified (opposite side of a one sided change) -- these give the line balance -* Display panel for errors occuring during Connecting... phase - -------------------------------- -CHANGES FROM VERSION 2.28.15 - -Test commit. - -------------------------------- -CHANGES FROM VERSION 2.28.13 - -* Roll back non-fix for GTK2 UI - -------------------------------- -CHANGES FROM VERSION 2.28.11 - -* Added some files left out of the previous commit. - -* Fix for GTK2 UI, suggested by Karl M - -------------------------------- -CHANGES FROM VERSION 2.28.9 - -* More Mac GUI goodness from Craig. - -Enhancements: - - Default table layout is now outline view (middle choice in outline control) - - Outline layout initial does "smart expand" to open one screen full - - Action icons - Lighter parent icons - - Icons for Left / Right work (Added, Modified, Deleted) - -Bug Fixes: - - Fix problem with file Details not showing - - Sort by Action not working - - Missing status for some items (on right) - - Reset view contents (clear recon items) when re-syncing - - Action icons -- Fix upside-down question mark - - Fix centering of "Connecting..." message when panel is resized - - Force to progress to 100% when done - -Known Issues: - -1) The most controversial "enhancement" here is the replacement of the - text for Left / Right (e.g. "Modified", "Deleted") with more - compact / colorful icons. These icons are perhaps was too "loud", - but Craig thinks that if he can tone them down a bit that this will - be an improvement. [Actually, I like them pretty well as-is.] - - Any icon artists out there? - -2) The rendering of the status message in the main ProgressIndicator - is currently leading to flicker. - -------------------------------- -CHANGES FROM VERSION 2.28.8 - -* Some more files needed for Craig's updated Mac GUI. - -------------------------------- -CHANGES FROM VERSION 2.28.6 - -* More improvements to the OSX GUI from Craig Federighi, including a very - nice new "nested directory" display style and per-file progress bars. Any - unison hackers using Macs are invited to check out the new UI and post - any bugs or suggestions for improvement to the unison-hackers list. - - (There is one known issue that sometimes causes the list of changes to be - redisplayed incorrectly after an Ignore command.) - -------------------------------- -CHANGES FROM VERSION 2.28.5 - -* Add couple of missing files. - - -------------------------------- -CHANGES FROM VERSION 2.28.4 - -* Apply experimental patch from Craig Federighi, which seems to fix - the deadlocks and crashes in new OSX UI. (Actually, this is a major - rewrite and cleanup of the whole Cocoa UI.) Thanks, Craig!!! - - It would be great if some Mac users could help stress-test this fix. - -------------------------------- -CHANGES FROM VERSION 2.28.4 - -* Apply experimental patch from Craig Federighi, which seems to fix - the deadlocks and crashes in new OSX UI. (Actually, this is a major - rewrite and cleanup of the whole Cocoa UI.) Thanks, Craig!!! - - It would be great if some Mac users could help stress-test this fix. - -------------------------------- -CHANGES FROM VERSION 2.28.3 - -* Another fix to ctime (non-)handling - -------------------------------- -CHANGES FROM VERSION 2.28.1 - -* Small fix to ctime (non-)handling in update detection under windows - with fastcheck. This *might* fix the bug that Karl M. has reported. - (Copying fix into trunk.) - - -------------------------------- -CHANGES FROM VERSION 2.28.-2 - -* Very preliminary support for triggering Unison from an external - filesystem-watching utility. The current implementation is very - simple, not efficient, and almost completely untested. Not ready - for real users. But if someone wants to help me improve it (e.g., - by writing a filesystem watcher for your favorite OS), please let - me know. - - On the Unison side, the new behavior is incredibly simple: - - use the text UI - - start Unison with the command-line flag "-repeat FOO", - where FOO is name of a file where Unison should look - for notifications of changes - - when it starts up, Unison will read the whole contents - of this file (on both hosts), which should be a - newline-separated list of paths (relative to the root - of the synchronization) and synchronize just these paths, - as if it had been started with the "-path=xxx" option for - each one of them - - when it finishes, it will sleep for a few seconds and then - examine the watchfile again; if anything has been added, it - will read the new paths, synchronize them, and go back to - sleep - - that's it! - - To use this to drive Unison "incrementally," just start it in - this mode and start up a tool (on each host) to watch for - new changes to the filesystem and append the appropriate paths - to the watchfile. Hopefully such tools should not be too hard - to write. - - Since I'm an OSX user, I'm particularly interested in writing a - watcher tool for this platform. If anybody knows about - programming against the Spotlight API and can give me a hand, - that would be much appreciated. - -------------------------------- Copied: branches/2.32/src/RECENTNEWS (from rev 321, trunk/src/RECENTNEWS) =================================================================== --- branches/2.32/src/RECENTNEWS (rev 0) +++ branches/2.32/src/RECENTNEWS 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,6 @@ +CHANGES FROM VERSION 2.32.7 + +* Move descriptions of recent changes to documentation. + + +------------------------------- Deleted: branches/2.32/src/TODO.txt =================================================================== --- trunk/src/TODO.txt 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/TODO.txt 2009-05-02 02:31:27 UTC (rev 322) @@ -1,1120 +0,0 @@ -Here we list planned and imagined improvements to Unison. Ones that we -regard as most important are marked with more *s. (Unfortunately, since -Unison is no longer under active development [though it is still heavily -used by its original developers], the presence of a suggestion in this file -is not promise that anybody is going to implement it!) - -See the file BUGS.txt for a list of currently open bugs. - -########################################################################### - -* CURRENT -* ======= - -* Merge issues: - - It would be better to ignore the exit status of the external merge - tool and just look at what files it produced to decide what happened - - The function that runs the external program should not grab stdin / - stdout / stderr if Unison is running with the text UI. - - The confirmation step should offer to display the new merged file. - - (There are some older merge issues documented below) - -* Makefile for fstest - -* Work on the Unison side - - create temp file - - start watcher based on watcherosx switch, passing all paths as args - - on each loop - - parse results into shallow and deep ones - - combine the two lists (marking which is which) - - sort the list - - if there are any adjacent pairs where the first is a prefix of the - second, drop the second and mark the first as deep - - go through the list and drop any item for whioch any PREFIX of - its path matches 'ignore' and doesn't match 'ignorenot' - - bulletproof, handling fatal errors and restarting completely from - scratch if necessary - -* See if there are other hacks that should be propagated to 2.27 (the - directory transfer throttle for sure!), and Jerome's recent suggested fix - -* Rsync debugging - - - R can't run with debugging (even in 2.13) -- Alan cannot reproduce - - - when using socket mode under windows, upon completion of the first - external rsync call, the connection to the server is dropped (the - server gets an EOF and closes the connection; the client sees a - broken connection) - - - only with rsync, not scp - - only with socket mode connection by Unison, not ssh mode - - seems to have nothing to do with ssh tunneling - - - calling Unix.open_process_in instead of - Lwt_unix.open_process_full seems to make no difference - - - one difference we can see is that, at the end of the transfer, - the ssh started by rsync (when run with with -v -v) says - something like "FD1 clearing O_NONBLOCK". The similar call to - ssh from scp does not print this. - - We're running under Cygwin (which is needed to have rsync) - -########################################################################### - -* SOON -* ==== - -**** Document: root, fspath, path (local/not) - -**** Nice code cleanup trick: Add a phantom type param to Pref (and Pred?) - that prevents mutation from outside the module where the preference is - defined (by exposing it with a weak type). - -**** The third assertion in Remote.fill_buffer failed for me (BCP) during a transfer! - -**** Remaining problem with merging code: - - create two directories, each containing a .txt file - - sync so they are equal - - change the file so that one region is in conflict and another - region has changes that can be propagated correctly - - sync - - now we should be able to change the second region in just one file, - sync again, and see the change propagate; instead, it conflicts - - diagnosis: the merge stuff is not correctly updating the archive in - the event of a partial reconciliation - -**** When deleting a directory, we should *not* skip over Unison temp files - in the process of listing children - -*** Un-writeable directories can't be copied. - The 'rename' operation at the end of Files.copy will fail (at least on - OSX) if the path being renamed points to a directory and that directory - (not the one containing it!) is not writeable by the user. To fix this, - we'd need to notice when we are renaming a directory and temporarily - make it writeable just before the rename and then make it what it should - be just after. But I don't feel like writing this bit of code right - now, to handle such a corner case. [BCP, November 2008] - -*** make the ETA bar show which file is actually transferring bytes at the - moment - -*** Fix the pred module to understand negation and delete XXXnot predicates - -*** Web - - Add a "supported platforms" page mentioning system-specific stuff - - Add an installation instructions page, removing it from the manual - -*** See if we can get rid of some Osx.XXX stuff (e.g. ressLength!?) - -*** Add the following to the Problems FAQ: - - --- In unison-hackers at y..., "Matt Swift" wrote: - > I just posted a msg to cygwin at c... detailing some very strange - > behavior of chmod when a file's owner is also the file's group. It - - I was right about the crucial circumstances of owner = group. Moral: - do not let user=group under Cygwin. I know it causes a problem when - you make unison use the full permissions model on Cygwin systems; I - think this may also explain similar problems I had using the default - unison behavior (which treats Cygwin files as read-only or read-write - only) -- though there are several possible causes of like failures to - syncrhonize permissions. - - The answer is obvious, following from the basic handling of permissions - in Cygwin (in NT permissions mode), but I didn't see it. Users and - groups to Windows are the same kind of object (SID), and permissions on - a file or directory are represented as a list of (any number of) SIDs - paired with permissions such as read, write, execute (and quite a few - more). When you try to map this to the Unix model of user and group, - when the user and group happen to be the same, the user-permissions and - the group-permissions are operating on the same underlying Windows - object, and so they cannot be different. I think the user-permissions - prevail. - - For example, if you try to sync a Unix file with permissions rw-r--r-- - with a Cygwin file with permissions rw-rw-r-- whose owner happens to be - the same as the group, unison will report success, but the actual - permissions will not be changed. Moreover, during the next sync, - unison will by default propogate the Cygwin file back to the Unix file, - so that the degenerate permissions under Cygwin will migrate to the - Unix system unless you are careful to prevent unison from doing it. - (When you are trying to sync some 75,000 email and font files, this all - is more than a little exasperating!) - - --- - - Further important advice if you are going to synchronize Cygwin - filesystems with unison's full Unix permissions model (and perhaps it - is also important even with unison's default behavior): - - Background: the flags "ntsec" or "ntea" in the CYGWIN environment - variable signals Cygwin's libraries to use the richer NT permissions - model rather than a simplified Win95-98 model. "ntsec" requires an - NTFS filesystem, "ntea" will work with FAT filesystems. I use - "ntsec". - - If unison does not have CYGWIN set appropriately in its environment, - some chmod calls will not do the expected thing, even though they - return with success. This will result in the file coming up again in - the next synchronization, and unison will then by default propagate the - (wrong) permissions from the Cygwin file back to the Unix system. (The - first chmod apparently succeeded, so unison records the new permissions - in its archive; the second time, when the file does not match the - archive, it seems to unison that the Cygwin file has been changed.) - - If you run unison from the bash command line, you will most likely not - have a problem, since CYGWIN is probably set appropriately and exported - in the .bat script that launches bash. Likewise, when the Cygwin - filesystem is the remote one, Cygwin's sshd is by default set up (by - /usr/bin/ssh-host-config) to establish and export an appropriate value - of CYGWIN to ssh clients. - - If you launch unison directly from a Windows shortcut, however, you - must set CYGWIN in your Windows environment variables. This is - certainly a convenient way to launch unison either with a particular - profile or generically. The instructions for setting up Cygwin and the - discussions of the CYGWIN envariable in the user manual never mention - any need to put CYGWIN in the Windows envariables, however. (I'm - writing them to suggest they do.) - - >From the unison standpoint, the code which chooses to use the full - permissions model on Cygwin hosts (right now I have it hacked simply to - always use full permissions, by commenting out a line) perhaps ought to - confirm that "ntsec" or "ntea" is in the CYGWIN envariable and issue a - big warning that permissions may not be properly synchronized if - neither value is there. - -** add '' - to the head section of all the unison web pages. - -** Peter Selinger has built an SHA256 implementation that should be usable - as a drop-in replacement for MD5, if we ever need to do that - -* BUILDING AND INSTALLING -* ======================= - -** 'make install' could be improved (and documented) - 1. Typing "make install' after a "make" should simply install the - program that was made, not attempt to do a remake with different options. - ===> Doesn't it??? - 2. "make install' should try to install as /usr/local/bin/unison, not - ~/bin/, especially considering that ~/bin is the wrong place to do the - install under OSX (it should be ~/Apps or ~/Apps/bin) - -** document the dynamically linked version, as some user already reported - that it works fine. Also, try to make the statistics window work with - this version. [This is "under windows," I think.] - -should strip symbols from binary files in 'make exportnative' - - -* DOCUMENTATION -* ============= - -** Put a little more order on the flags and preferences -- e.g., - organize them into "basic preferences", "advanced preferences," - "expert preferences," etc. Requires hacking the Uarg module. - -** Add something to docs about how to use 'rootalias'. Include an - explanation of the semantics, a couple of examples, and a suggestion - for how to debug what it's doing by turning on appropriate debugging - flags. (And maybe we should actually make the debug output there a - bit more verbose?) - -** Misc: - - document good trick: use -1 switch to ssh if the paths are set up wrong - on the remote host - - should say whether trailing slashes are ok for paths; should say - that leading slashes are illegal. - ===> check - - not so clear what you have to do with a Regex to match a directory - and all its subfiles: foo or foo/ or foo/.* ? - ===> the first. document it. (Does foo/ match foo? I don't think so. - Document, one way or the other.) - - what happens when files are included whose parent dirs are - excluded? (With Regex? With multiple Path and Name?) - ===> document - - the documentation is very good, but i couldn't find a description of how - to respond to the prompts in the textual ui. is that explained - somewhere? a few typos i noticed: "with t fast", "nison", "off of". - -** what happens when we ssh through loopback and sync the same - directory? - ===> Needs to be thought about. In particular, what is the name of the - archive in this case? Could they ever be exactly the same? - ===> Try it and see. - - -* SMALL FUNCTIONALITY IMPROVEMENTS -* ================================ - -**** The archive should indicate whether it is case-dependant or not. - (This is important for correctness -- if the case-insensitive flag is - set differently on different runs, things can get very confused!) - -**** Use LargeFile (submodule of Unix) instead of standard file commands, - to avoid problems with huge files - DONE - -*** [Marcus Sundman, 2008] Unison can't propagate changes in read-only - folders. The correct way to do it is to temporarily add write - permissions for the user to the folder, then do the changes and then - reset the permissions. Now unison tries to just do the changes, which - fails with a "permission denied" error. - -*** [Adrian Stephens, 2007] I would like the scope of rootalias to be - expanded so that any command that expects a root will perform aliasing - on the command. In my application, I need to change the root statement - as I move my machine from desk to the road. I also have a "force" - statement, and I also have to remember to edit this to match. It would - be more convenient to have to edit in a single place and, more - importantly, avoids introducing any inconsistency. - --- [BCP:] I like this idea. However, since I'm struggling at the - moment to find time to finish polishing 2.27 to become the new stable - release, I am not going to undertake to implement it. If you (or - someone else) would like to give it a shot, here is what I think needs - to happen: - - Move the rootalias preference and the rootalias-expanding code from - Update.root2stringOrAlias into the Common module (creating a new - function there for rootalias expansion). - - Find places like Recon.lookupPreferredRoot that deal with names of - roots and add a call to the rootalias-expanding function. - -*** Delete old backups mechanism and, instead, extend new one to cover its - functionality - - put backups in same dir as files by default - - otherwise, put them in a central place if one is given - - Update.incrVersionsOfBackups should not be externally visible - -*** there's an HFS+ aware version of rsync called rsyncx. It should be - relatively easy to import that functionality into unison. - -*** Consider altering the socket method, so the server accepts connections - only on a particular address? This would be very useful, because many people - tunnel unison over an OpenVPN Link, and this software works with virtual - devices and additional IP addresses on it. If unison would accept - connections only on the virtual device, the security would be enhanced, - because the OpenVPN key should be unavailable for the black hats. - -*** unison -help doesn't go to stdout so it's hard to pipe it into less - ===> Probably *all* output should go to stdout, not stderr (but maybe - we need a switch to recover the current behavior) - -*** for the MSVC version of unison, we should deal with the nonstandard - semantics regarding read-only files. - ===> What does that mean?? - -*** If a root resides on a `host' with an ever and unpredictably changing - host name (like a public login cluster with dozens of machines and a - shared file system), listing each possible host name for this root is - not feasible. The ability of specifing patterns in rootaliases would - help a lot in this case. I'm thinking of something like this: - rootalias = //.*//afs/cern.ch/user/n/nagya -> - //cern.ch//afs/cern.ch/user/n/nagya [NAGY Andras , - March 12] - ===> We definitely ought to do something about this problem -- it's - increasingly common. Not sure if this is the right proposal, but - something. - -*** Currently, if a file changes on either side between the initial update - detection and the time when the transport module tries to propagate - changes, the transport is aborted. But if the change occurred on the - replica that is being used as the source for the transfer (which will - be the common case!), then there is no reason to abort -- we should - just propagate the newest version. - -*** When unison notices lock files in the archive directory, it should - offer to delete them *for* the user, rather than forcing the user to - delete them manually. - -*** improve error reporting when Unison is started with different versions of - client and server - -*** A switch to delete files before replication. It's not something I - would have considered doing, and in normal replication, there have - already been pointed out good reasons why Unison works the way it - does, but Roman makes a good reason for why this is useful in CD-RW - backups, and why this could be useful on a general to do list. And - this is certainly *generic*, which my point is not (as it only applies - to the Microsoft Windows NTFS situation). - -*** A switch to include NTFS ACE/ACL file permissions to be copied when - copying from one NTFS location to another NTFS location. As I - mentioned this is less generic, but of fundamental usefullness in - Windows usage, as NTFS permissions are absolutely essential in many - backup/replication situations in Windows systems. Robocopy has the - /SEC switch, but Unison is a far better tool, and I was hoping in that - light that Unison could implement the rights/permissions stuff also. - -*** There is no command-line argument to tell Unison where the .unison - directory is; Unison finds it in the environment or not at all. I was - able to workaround this with a symbolic link to put .unison where it was - expected, but it seems like an easy option to add. - -*** The other is possibly a bit more difficult, but more useful as well. There - is a brief window of vulnerability between when the local server is started - and when the remote client connects to it. (It's no longer than that - because Unison won't take more than one connection at a time.) I can - tolerate it, but the window could be eliminated entirely by allowing socket - connections to require a nonce. - -** Would be nice to transfer directories "incrementally" rather than - atomically (i.e., if Unison is interrupted during the transfer of a - directory, the partially-transferred directory should persist). Is - this allowed by the specification? (If so, then it should just become - the default behavior.) - ===> BCP and William Lovas have discussed how to do this, but it is - not all that straightforward. - -** we should reload the current preference file (if it's changed, at least) - when we restart - -** [A good idea for the ssh prompt issue...] I'm not sure why you would - need a C implementation; you could do the same thing in CAML that expect - does: allocate a PTY, start up ssh on that, and interact with it. On - Windows, you can probably do the same with the Win32 console API, - although I don't see why such an improvement needs to work uniformly - across all platforms to be useful. [Note that allocating PTYs is not - very portable, but we could at least try allocating one and see if - something useful comes back...] - -** An idea for the interface to the external merge functionality: - created a general mechanism for invoking external functionality... - - in profile, declare a command of the form - key M = external "merge ##1 ##2 ###" --> overwriting originals - (concrete syntax open to discussion!). Main parts are - - what key to bind it to in the UI(s) - - the command line to start up - - variables (##1 and ##2) for the local and remote files - (the remote file will automatically be copied to a local temp - file, if this variable is used) - - a variable (###) for a temporary output file - - an indication of what to do with this output file - (or maybe this could be automatic) - - (should also indicate which machine(s) to run the command on?) - -** small additions to merge functionality: - - if the external merge program *deletes* one of the files it is given, - Unison should interpret this as "Copy the other file onto this location - (instead of merging)". This will allow some other interesting - functionality, e.g. external programs that may decide to keep both - versions by moving one of them out of the way (mh-rename). - - the invocation of the external 'diff' program should be selectable - using the same conventions as the 'merge' program - - would be nice to be able to invoke DIFFERENT merge programs - depending on paths - -** We should document other available merge tools, e.g., - idiff [BCP has a copy of the code for idiff that Norman sent.] - -** Allow 'default.prf' in place of 'default' for profile names - -** [dlux at dlux.hu, Feb 2002] For some apps (e.g., some mail readers?), - putting temp files in the same directory as the file we're about to - overwrite is bad/dangerous. Some alternatives that we could - consider... - - Add a configuration option for temporary directory and notice the - user about the volume restrictions in the docs and then if the user - does not consider it, then we use a non-atomic (copy + unlink) - rename. In an ideal environment (where the user consider this - restriction), it makes possible to sync a maildir folder while it is - online! - - An even better solution: One more temporary file step. If the user - sets the temporary directory, then we synchronize the files to that - directory, and if the file is downloaded/uploaded fully, then we move - it to a tempfile into the target directory (with .unison.tmp - extension) and then rename it into the final name. - -** Suggestion for extending merge functionality - - add a new kind of preference -- a conditional stringlist preference - - in the preference file, each value looks like either - prefname = string - or - prefname = string WHEN Path PPPPP - prefname = string WHEN Name XXXXX - prefname = string WHEN Regex XXXXX - - when we look up such a preference, we provide a current path, and it - returns the one that matches the current path, if any - -** Would be good to (optionally) change the semantics of the "backup" - functionality, so that Unison would not insist on making a *full* - backup of the whole replica, but just do so lazily. (I.e., it would - not make backups when files get put into the archive, but only when - they actually get changed.) - -** Would also be nice to allow the backup preference to be set - differently on different hosts -- so that all the backups could be - kept on one side (if there is no space on the other side, e.g.). The - obvious way to do this is to add a switch like '-suppressbackupsonroot - BLAH' but this feels a bit ad hoc. It would be nicer to decide, in - general, which preferences can sensibly have different settings on - different roots (e.g., the location of the archive dir, ...) and - provide a general mechanism for setting them per-host. - -** ~/foo seems to work on the command line but not in root = ~/foo in the - config file. - -- - Similarly: It seems that when one specifies logfile = foobar - in the preferences file, then unison assumes that it is relative to the - current directory. Since neither ~ nor $HOME are understood in the - preference file, this is an inconvenience, because it forces the user to - remember to run unison from the root directory. - ===> Would be nice to support ~ internally - -** giving a -path preference whose parent dir doesn't exist currently causes - Unison to abort with a fatal error. Would be better if it just - signalled an error for that file. - -** no spec for escaping regexp chars; spaces? newlines? tabs? others? - mechanism for getting the list of files from another program (plugin)? - ===> needs to be documented (look at rx.ml) - -** seems not to recognise ignores when they are inside a path that has - just been added. -===> Jamey claims that if we add a new directory, some of whose children - are ignored, then when this new dir is propagated, also the ignored - stuff gets copied (if this is true, then it's probably a bug in - update.ml) - -* When loading archives (not just when dumping them), one should check that - they have the same checksum. - -* [July 2002, S. Garfinkel] Maybe we should turn the 'time' option on by - default. We might need to help people a little on the upgrading, - though. When you did a sync with time=false, then a sync with - time=true, you get a zillion conflicts... - ==> This is probably a good idea, but I'm a little scared of all the - messages we'd get from upgrading users - -* Maybe we should write debugging and tracing information to stdout - instead of stderr? - -* URI pathname syntax - Why is the following command wrong? - unison -servercmd `which unison` /usr/local ssh://labrador/usr/local - It took me three tries and careful reading of the documentation to - figure it out. I don't have any good suggestions here, other than - that I think the whole issue of relative vs absolute pathnames needs - serious thought. I think the current interfaces do not work very - well. One possibility that I will float is that you invent a special - character string to refer to the root of synchronization. - E.g., interpret ~ as $HOME in roots. - -- - Also: we should add the file:// syntax to URIs... - file://C:/Necula (C:/Necula on the local file system) - file:////share/subdir (//share/subdir as from the point of view of - the local file system) - unison://host///share/subdir - -- - Should local roots in a profile be canonized? - Right now, we can have a relative root in the profile. This - is going to be a problem if unison is started in a different - directory. - -* At the moment, if Unison is interrupted during a non-atomic operation - on the file system, the user has to clean things up manually, following - the instructions in the the recovery log. We should do that for them. - (This is actually a bit tricky, since we need to be careful about what - might happen if unison crashes during recovery, etc. The best way to - accomplish this would be to write a general logging/recovery facility - in OCaml.) - -* Dealing with ACLs: Maybe this is what we should do actually. We could - specify a user (and similarly a group) to unison. It would be - interpreted in a special way: if a file is owned by this user, unison - will rather consider that the owner of the file is undefined. So, when - a file owned by an unkown user is synchronized, the file owner is set - to the default user. Then, on the next synchronizations, unison will - consider that the owner has not been propagated and try again. [Should - be easy once the reconciler is made more modular] - -* The -terse preference should suppress more (in fact, almost all) - messages in the text ui. See Dale Worley's message for a detailed - proposal. - -Make sure that no filesystem check is missing in the transport agent. - ===> What does this mean? - -Would be nice to have the Unison log file relative to my home directory, - like this - logfile = ~/.unision/log - or - logfile = $HOME/.unision/log - (We should do this for *all* files that the user specifies.) - -It would be nice if Unison could have the "power" to copy write-protected - files, maybe as an option. - -Update checking over NFS might be *much* faster if we use only relative - pathnames (absolute paths may require an RPC per level!?) - -On one server (Saul), Unison seems to use HUGE amounts of memory (250Mb - resident), while on my laptop it's much less. WTF? - -[Ben Wong, Aug 2002] Why not make unison fall back to addversionno if it - would otherwise bomb out with an incorrect version number? That way I - wouldn't have to educate people on how to use Unison at my site; it'd - "just work". - -The -sortbysize is nice, but what I would really like is a -limitbysize. - When I'm connected over a modem line, I would like not to transfer the - larger files that need synchronization. That can wait until I am - connected via a faster connection. What I presently do is allow unison - to run in -sortbysize mode, and abort once I have all my little, more - important files. -limitbysize should simply filter the list of transfer - to only those that are below the threshold size. The syntax is - obvious... It should be -limitbysize xxx, where xxx is the size - (preferably in kb, but bytes will do as well). - -Maybe we should use getcwd for canonizing roots under Unix. For some - systems (Linux, for instance), getcwd succeeds even when some parent - directory is not readable. - -[From Yan Seiner] - Can unison modify the (*nix) environment to show the - ip/name/some_other_id of the system making the connection? This would - help tremendously. - For example, vtun does this: - --- - root 6319 0.0 0.6 1984 852 ? S< Aug27 0:37 vtund[s]: - bgsludge tun tun10 - root 6324 0.0 0.6 1984 852 ? S< Aug27 2:00 vtund[s]: - cardinal tun tun0 - root 17001 0.0 0.6 1984 848 ? S< Aug27 0:05 vtund[s]: - wtseller tun tun11 - root 20100 0.0 0.6 1984 852 ? S< Aug28 0:02 vtund[s]: - cardridg tun tun1 - ---- - So I know I have four sessions, to each named machine, and I know - immediately who is connected and who is not. If I have to kill a - session, I don't kill the wrong one. - -add a switch '-logerrors' that makes unison log error messages to a - separate file in addition to the standard logfile - -Dale Worley's suggestion for relocating archives: - > You're right: it's not all that tricky. So would you be happy if you - > could run unison in a special mode like this - > unison -relocate //old-host1//path1 //old-host2//path2 \ - > //new-host1//path1 //new-host2//path2 - > (where all the hosts and paths are normalized) and it would move the - > archives for you on both machines? - Actually, I think that what you want is for the user to specify the - old paths in *normalized* form and the new paths in *non-normalized* - form. That is, unison uses the old paths literally as provided by the - user, but it applies the usual normalization algorithm to the new - paths. - This may sound strange, but I think that it's the Right Thing: - - There is no guarantee that the normalization algorithm, applied to - the old paths as the user used to specify them, normalizes to the - the normalized paths that are recorded in the archive. Indeed, - there may no longer be *any* path which normalizes to the recorded - paths. - - The user can extract the normalized old paths from the second line - of the archive files. This is clumsy, but reliable. And we don't - intend the user to relocate an archive very often. - - But for the new paths, you want to normalize what the user supplies, - because he doesn't know in advance how Unison is going to normalize - the new paths, and may well specify them incorrectly. That would - leave him with a relocated archive that he might not be able to use - at all. - You might want to put quotes around the pathnames in the second line - of the archive, since MS-Windows directory names can contain spaces, - etc. - -For safety... - - Add a preference 'maxdelete' taking an integer parameter, default 100 - (or perhaps even less -- keeping it fairly small will help naive users - avoid shooting themselves in the foot). A negative number means - skip this check (i.e., infinity). - - When the transport subsystem gets control (i.e., just after the user - says 'go' to the user interface, when not running in batch mode) - it first checks the number of files that are going to be deleted - (including all the contents of any directories that are marked for - deletion). If it is more than maxdelete (and maxdelete is - positive), then... - - If we're in batch mode (batch=true), we halt without doing - anything. - - If we're not in batch mode, we display a warning message and - make the user confirm. (If they do *not* confirm, it would be - nice to dump them back into the user interface again, but this - would require a little rewriting of our control flow.) - - Would also be nice to include a display in the UI someplace that says - how many files are to be deleted/changed/created plus how many bytes - to be transferred, and a warning signal (display in red or something) - if these exceed the current setting of maxdelete. - -Might be nice to provide an option that says "if you're propagating a - newly created directory and something goes wrong with something inside - it, just ignore the file that failed and keep going with the rest of - the directory." [We probably don't want to continue in all cases (for - instance, when the disk is full)] - -Would be nice to be able to run unison in a special mode like this - unison -relocate //old-host1//path1 //old-host2//path2 \ - //new-host1//path1 //new-host2//path2 - (where all the hosts and paths are canonized) and have it move the - archives for you on both machines? - -It would be nice if unison had a tool by which it could regenerate all - the MD5 sums and compare them to what it has stored, then produce a list - of files that are different. I obviously cannot count on file size and - date in this case; those may not have changed but the contents may be - corrupt. - -If the connection to the server goes away and then comes back up, it - would be nice if Unison would transparently re-establish it (at least, - when this makes sense!) - -If we synchronize a path whose parent doesn't exist in one replica, we'll - fail. Might be nicer to create the parent path if needed. - -maybe put backup files somewhere other than in the replica (e.g. in - $HOME/tmp, or controlled by preference) - -Better documentation of the -backups flag, and a way to expire old backups - -Add a preference that makes the reconciler ignore prefs-only differences - between files (not updating the archive, though -- just suppressing - the difference -- will this slow things down too much?? Maybe it needs - to happen in the update detector, before things are transmitted across - the network.) - -Perhaps we should interpret both / and the local separator as path - separators, i.e., under Windows / and \, under Mac / and :, and under - Unix just /. For Windows this will be fine, since / is not allowed in - filenames. - -Maybe have an option to tell do not transfer toto.dvi if toto.tex exists (or - toto.ps if toto.dvi): something like - Ignore .dvi If .tex - ===> This is not a good idea -- would give different ignore results on - the two machines. But maybe a variant would work: - - Have an option to execute a command if a given file exist like - Execute rm core If core - Execute make clean If Makefile - -We should put in a preference that forces Unison to do really safe update - detection (with fingerprinting), even on Unix systems. (Maybe just for - some paths?) - -Maybe we should never emit a conflict for modtimes; instead, we just - propagate the largest one. - -[John Langford] Some code for (at least partially) handling large files - can be found in 64bit_ops.c in: - http://www-2.cs.cmu.edu/~jcl/programs/sync_file.tar.gz - Make sure you pay attention to the compile line as it is important. - -[Ivo Welch] I would do a quick test of case sensitivity in the program -itself at the time you do a first prf sync, so that the user does not have -to bother with it. Just write two files on each end which differ in case, -and see if there is overwriting. Then do the smart thing. The long-named -file in the .unison directory should keep this information thereafter. -(BCP: Implementing this is more difficult than it might seem. E.g., -whenever a symlink is followed we might need to go through the same -exercise. And then we'd need to be able to deal with replicas that are not -all one way or the other...) - -[Ivo Welch] I would give some examples in the man page of what an xxx -specification is. - -[Ivo Welch] I would allow '--' switches, in addition to the '-' switch spec. - -[Ivo Welch] On OSX, create a link from ~/Library/Application Support/Unison -to .unison, just for ease of finding it. It took me a long time to find my -.prf files. - -[Ivo Welch] the OSX GUI front end should be clear which side (left or right) -the local host and which side the remote host is. - -* USER INTERFACE -* ============== - -** In menu Actions - - show Diff applies to the current line, while - - revert to unision's recommandation applies to all lines - Should be clearer and/or homogeneous behavior. - I would also like to have "revert to unision's recommandation" for the - current line. - -** in gtk ui, display green checkmark next to finished items even if their - direction indicates a conflict; do not list such items as "skipped" at - the end - -** In both UIs, show how many bytes/files were successfully transferred - at the end - -** Should support auto-termination of the graphical UI (switch-controlled) - * Unison starts in the usual way and checks for changes - * If there are no conflicts, it proceeds without waiting for confirmation - * If there *are* conflicts, it waits for instructions, just like now - * In either case, when it's finished transferring the changes, it quits - -* [Matthew Swift] in the GTK gui at least, - display the total MB or #files or whatever it is that the ticking - %-meter is referring to when it goes from 0 to 100. it is useful to - know how big the xfer is going to be before starting it (might induce me - to choose "sort by size", or abandon and choose a smaller subset, etc.). - Also, esp. since the gui is single-threaded and unresponsive, i would - like to know what size of a synch that I am for example 50% or 22% - through. I know that an ETA and other things we're used to from many - downloading apps would require quite a bit of code, but it would help a - lot just to display whatever constant is represented by 100%. - - -* [BCP] Error reporting for per-file problems during updating leaves - something to be desired. In particular, there's no indication even of - which host the problem occurred on. (I added something that includes - "root 1" or "root 2", but I'm not sure that's better than nothing.) If - there are errors on both hosts, only one will be reported. If there - are lots of errors in a subdir, only the first will be reported. - Recon.propagateUpdates would be a starting point for changes. - -* [Jamey Leifer] - Would be nice if both UIs had a "revert to Unison's proposal" button... - -* [Jamey Leifer] - [graphic ui, wishlist] The documentation topics aren't searchable. As - a result "unison -doc running | less" is still indispensable if one - wants to find anything. I suggest adding a box - - "search in this topic: ---" - - which is always available in the doc viewer. It would be nice to - support keyboard shortcuts in the "less" style, namely "/", "n", and - "N" (i.e. search, next, previous) to avoid too much clicking. - - [graphic ui, wishlist] Ditto as far as searchability for diff reports. - -* Would be nice to have a keystroke in the UI that means 'add the current - directory to the set of ignore patterns.' - -* In the text UI, during the transport phase, print each file being - transferred on *one* line, with an arrow to indicate which way (and - dropping the explicit indication of which host from and to). The - logfile should be more explicit. - -* The unison gui currently displays a percentage completion in the lower right - corner. I would find it comforting if it would also display an effective - bandwidth there, i.e., how many bits per second are flowing through the - transport layer? I make this request because owing to a hardware - catastrophe, I have just started using Unison through the phone lines, and - it seems to do nothing for a long period of time. I don't know whether - to blame the cheap modem, the cheap ISP, or whether Unison simply isn't - telling me that bits are flowing through the wire. (netstat -tn - suggests not much is happening, but I don't know if the results can - be trusted.) - -* Would it be hard to add "tool tips" to the buttons in the UI? - ==> Look for "tooltip" in examples/testgtk.ml. - The easiest way is with a toolbar, but you can also add tooltips to any - widget (cf lines 867 and after). - -* > On a line, I would like to have a description of the action to be taken in - > clear words: (e.g. will erase file on local or will copy from local to - > remote, etc.) - This might be a good use for "tool tips," if I knew how to make them work - using lablGTK. - -* After clicking "Create new profile" in the initial profile window and - giving a name for the new profile, it is confusing to get dumped back - into the profile window again and have to explicitly select the new - profile. Would be better to skip this step and go straight into - filling in its fields. - -* Another usability issue in the text UI: , and < should mean the same to - unison. It would be nice if both had the same representation on-screen - (ie, show a "<" even if I typed a ","). Similarly for . and >. - -* The menu help for left/right arrow both said `transfer local to local'. - Not helpful. The items in question are pathnames, which you might not - have to abbreviate. To save space one might consider replacing any - common prefix, and also short prefixes that look like they might be - automounter goo, with an ellipsis. Then show, e.g., 20 chars. I'd - also be willing to name paths in my profile, e.g., replica flatcoat = - /home/cellar/nr replica cellar = /m/cellar60/nr This would be - especially attractive if my short names were meaningful on the command - line. - -* In the GTK user interface, it would be nice to be able to put up a window - displaying the contents of the log file (and add log messages to it - dynamically as we're working). Be careful, though: the log could get - large and we don't want this to be too slow. - -* Could there be an option between -ui text and -ui graphic that when combine - with -batch and -auto would start in text mode, but pop up an interactive - graphic window when real conflicts happens. - -* [Jamey Leifer] I think "unison -doc" should be mapped to "unison - -doc topics" and the error message for the former eliminated. - -* [Jamey Leifer] Typing "unison" results in the Profiles box - ("Select an existing profile..."). I think the help topics should be - available here. - -* [Jamey Leifer] The file list is confusing since the paths - are sometime relative to the root and sometimes relative to the - previous path: - Mail/drafts/3 - inbox/5538 - 5539 - 5540 - I now understand that the indentation is significant, but it's not - that clear. A further confusion is that there's varying amounts of - indentation depending on the depth of the enclosing path: - foo/1 - 2 - boo/goo/loo/1 - 3 - 4 - This is really hard to parse since the fonts are variable width. - I would prefer to read the former as: - Mail/drafts/3 - inbox/5538 - 5539 - 5540 - (with the indentation actually showing the relationship) though this - may take too much horizontal space. Alternatively, one could choose a - Windows-style display: - |-Mail/drafts/3 - |-inbox/5538 - |- 5539 - |- 5540 - -Unison's gui offers an `Actions' menu with a variety of features - regarding preferences. I would love to see an action with the following - semantics: if the two files differ only in their modification time, - prefer the older modification time. - ===> This would be easy to add, but I am beginning to worry that we are - getting too many funny little switches like this. We should think - about them all together and make sure they make sense. - -I'm watching it sync a very large file that I don't want anyway, and I'm in - a hurry. I'd like a way to say "forget that file, I don't care about it, go - on to the next one you have to sync". Doesn't sound hard...? - [Perdita Stevens, Perdita.Stevens at dcs.ed.ac.uk, Mar 14 2002] - ===> It's not trivial (involves some subtle stuff about our RPC - implementation and the single-thread nature of the GUI), but might - not be impossible either. - -"Quit" during synchronization should abort all current operations (so - that temporary files are deleted) before exiting. - ===> Again, requires some careful thinking about how this would work - with the RPC layer. - -It would be nice to have a command in the GUI that would allow a single - path within the replica to be selected from a file dialog and - synchronized. - -The scroll bar is not usable during transport: every time a line changes - in the list, the display jumps to that line; if many small files are - transfered, it makes browsing in the list quite impossible... - -[From Manuel Serrano] Would be nice to put the arrows in different - directions in different colors, so that, e.g., you could quickly scan the - list of changes and make sure that they are all in the same direction - ===> We tried this, but we couldn't find color combinations that did not - seem confusing. (Two different shades of green? Three? ...) If we - really want this, probably the best is to put in some preferences for the - user to control the colors of all the arrows individually. - -Under Windows, convert filename to Unicode before printing them. - -Text mode user interface should be brought up to date with graphical - interface (it should prompt for profile selection, creation, root - entry, etc.; command characters should be the same; ...) - -Since the manual is pretty big, it would be nice if the on-line version - were accessible through cascading menus, allowing direct access to - individual subsections. It would also be nice if it were formatted a - bit more attractively, using proportional-width fonts, etc. (Does GTK - have something like an RTF widget?) - -If I have a change I look at the detail window. It would be nice to be - able to click on one of the lines there instead of pressing one of <- - or ->. For one thing in the detail window the relative position of the - two files is up and down and translating that to <- or -> is somewhat - unintuitive. - -Also, it would be nice to highlight in the detailed window the - elements that have changed. - -Make it possible to select a bunch of conflicts at the same time and - override them all together - -The UI window should display the current roots somewhere. - -There should be a -geometry command-line interface, following the usual X - conventions. - -put in a command-line option that makes fatal errors exit right away - without displaying anything in the graphical UI (for debugging) - -Use the CTree widget to display the list of files - Add the ability to close and open directories in the UI. - -it would be nice to give a visual indication of which files are - particularly big, so that the user can tell where the transfer - operations may get slowed down. Maybe a "size bar" showing the log - of the size (perhaps also color coded). - ===> less urgent now because we can re-sort the update items by size - -Would it be hard to allow long-running transfers to be aborted? - For instance, the key "/" aborts the transmission of the selected file - OR: - Allow the user to terminate individual operations by clicking a - "cancel" button. (This is not completely straightforward because - the whole program is single-threaded. But it should be possible for - the low-level transport code in remote.ml to realize that the - operation has been aborted, clean up, and raise an exception.) - -It would be nice if the initial 'usage' message were not so long. Maybe - we could split options into 'novice' and 'expert' ones, and only print - the novice ones (with an indication how to obtain the full expert - printout). - -> Show diff should behave as an emacs view-mode buffer and quit on a single -> 'q' in the window, or better quit even without focus be sent to the diff -> window... -The UI for the diff functionality needs some polishing. (Also, it should -be merged with the new "merge" functionality.) - -consider separating switches into 'ordinary' and 'expert' categories, - documented in separate sections - -would be nice to be able to "Proceed" just the selected line - -might be nice if the GUI would beep when finished syncing (needs to be - switch-selectable and off by default, naturally). Is this easy with - LablGTK? - -It would be nice to be able to STOP the GUI in the middle of propagating - changes. - - -* TIDYING -* ======= - -* Go through the sources and make all fatal and transient error messages - as informative as possible - -More documentation (especially in the interface files) is always nice. - In particular, there isn't enough documentation of the big picture. - It isn't clear how to fit together archives, servers, paths, roots, - update detection, reconciliation, conflict resolution, or the user - interface... - -Ocamlexc v1.0, the uncaught exceptions analyzer for Objective Caml is now - available from Pessaux's home page. It would be fun to run it over the - Unison sources and see if it reveals any problems. - - -* LARGER EXTENSIONS -* ================= - -Fast update checking would be cool... Some resources: - FAM (used in Enlightenment) - dnotify (linux 2.4) - BSD kqueue - the "VFS stacking layer" implemented by a guy at Columbia - -[From JMS] - Some update detection speed improvement suggestions: - - Read the FFS (Fast Filesystem) paper for hints - - change the working directory instead of using absolute paths; this - avoids calls to the evil iname(?) facility in the kernel - - work breadth-first instead of depth first, to keep things in the - kernel cache - -Rewrite recon.ml in a more modular way. Probably, have for each property - a function taking the previous file state and the state on each - replicas, and returning in what the synchronization operation should be - (nothing, left, right, conflict); a combinator then merge the results. - -It would be good to have a graphical interface allowing management and - editing of profiles, ignore patterns, etc. Or, less ambitiously, just - have UI options for all command-line options (killServer) - -How about a facility so that you can specify more than one pair of - file systems for a single invocation of Unison? This would be like - calling Unison multiple times, except that it would ask all the - questions at once. Better yet, we could actually deal with the - multi-replica case. (The latter is pretty hard.) - -What about invoking some user-specified operation on each file as it - is transferred? Or in each directory where things have changed? - (This will require some careful design work.) - -Sync with archived directories (in tar / zip / gz format) would be - nice. Seems a bit awkward to implement, though: at the moment there - are a lot of functions all over the place that investigate and - modify the file system, and these would all have to be replaced with - a layer that transparently parses, etc., etc. - -Consider using other authentication services (e.g. Kerberos) instead - of / in addition to ssh. - -What happens when we synchronize, then decide to ignore some existing file - What happens to the entry in the archive? If mirroring, it may be - large, we probably want to delete it from the archive. - -File level synchronization (bookmarks, mailboxes) - -It might be nice to implement an (optional) safety check that detects - aliasing within a replica due to followed links (or hard links) and - complains if it finds any. This should not be *too* expensive, since - we already know all the inode numbers. (Even if it *is* expensive, it - might be useful to allow users to do this occasionally, if they are - paranoid.) - - -* WINDOWS ISSUES -* ============== - -Suggestion from Arnaud: - I have been using XP for a while and despite all the problems I have, there - is a very nice feature: being able to mount remote folders (nothing new), to - work with them offline and synchronize them. Really useful. - -- - A good way to simulate this with Unison would be to package it as a shell - extension. From the desktop by clicking on the right button the user selects - "create new Unison mount point" and answers a few trivial question. And the - rest is done in the background. There are a lot of examples of shell - extensions and there is a really good book for O'Reilly about it. - -- - A good project for a student :-) - -- - PS: see http://www.simplythebest.net/shellenh.html for some examples. - -when typing ctrl-c in windows (dos-window in win98SE) when - unison is asking for conflicting updates there araises following - message (sorry for my bad translation to english): - "This program is closes because of a non-valid action. Contact the - manufactura if the error remains". - -NTFS seems to have two ways of setting a file read-only! -Comments from Karl Moerder: - Tonight I made some files read-only on my desktop at home. I did this by - setting global read and execute permissions (from the security tab of - properties). I ran Unison and it didn't notice the change. I then set - the permissions back to full control and then selected the read-only box - (from the general tab of properties). I ran Unison again and it noticed - and pushed the perms change to the server. - I understand that Windows is a bit squirrely here, but how do you decide - which permissions to look at? It seems like perhaps the ones on the - security tab would be more natural. (?) - -- - I get similar results with both bits (they both cause read-only - behavior). - I believe that the origin of the two modes of setting is that the first - set is the old way of doing Windows protection (probably the interface - provided on FAT file systems) and the new way is the more Unix like way - (added for NTFS file systems). The new way has rwxdpo bits for each - group (and there can be several groups). - -Local Variables: -mode: outline -End: Copied: branches/2.32/src/TODO.txt (from rev 320, trunk/src/TODO.txt) =================================================================== --- branches/2.32/src/TODO.txt (rev 0) +++ branches/2.32/src/TODO.txt 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,1130 @@ +Here we list planned and imagined improvements to Unison. Ones that we +regard as most important are marked with more *s. (Unfortunately, since +Unison is no longer under active development [though it is still heavily +used by its original developers], the presence of a suggestion in this file +is not promise that anybody is going to implement it!) + +See the file BUGS.txt for a list of currently open bugs. + +########################################################################### + +* CURRENT +* ======= + +* Merge issues: + - It would be better to ignore the exit status of the external merge + tool and just look at what files it produced to decide what happened + - The function that runs the external program should not grab stdin / + stdout / stderr if Unison is running with the text UI. + - The confirmation step should offer to display the new merged file. + - (There are some older merge issues documented below) + +* Makefile for fstest + +* Work on the Unison side + - create temp file + - start watcher based on watcherosx switch, passing all paths as args + - on each loop + - parse results into shallow and deep ones + - combine the two lists (marking which is which) + - sort the list + - if there are any adjacent pairs where the first is a prefix of the + second, drop the second and mark the first as deep + - go through the list and drop any item for whioch any PREFIX of + its path matches 'ignore' and doesn't match 'ignorenot' + - bulletproof, handling fatal errors and restarting completely from + scratch if necessary + +* See if there are other hacks that should be propagated to 2.27 (the + directory transfer throttle for sure!), and Jerome's recent suggested fix + +* Rsync debugging + + - R can't run with debugging (even in 2.13) -- Alan cannot reproduce + + - when using socket mode under windows, upon completion of the first + external rsync call, the connection to the server is dropped (the + server gets an EOF and closes the connection; the client sees a + broken connection) + + - only with rsync, not scp + - only with socket mode connection by Unison, not ssh mode + - seems to have nothing to do with ssh tunneling + + - calling Unix.open_process_in instead of + Lwt_unix.open_process_full seems to make no difference + + - one difference we can see is that, at the end of the transfer, + the ssh started by rsync (when run with with -v -v) says + something like "FD1 clearing O_NONBLOCK". The similar call to + ssh from scp does not print this. + + We're running under Cygwin (which is needed to have rsync) + +########################################################################### + +* SOON +* ==== + +**** Document: root, fspath, path (local/not) + +**** Nice code cleanup trick: Add a phantom type param to Pref (and Pred?) + that prevents mutation from outside the module where the preference is + defined (by exposing it with a weak type). + +**** The third assertion in Remote.fill_buffer failed for me (BCP) during a transfer! + +**** Remaining problem with merging code: + - create two directories, each containing a .txt file + - sync so they are equal + - change the file so that one region is in conflict and another + region has changes that can be propagated correctly + - sync + - now we should be able to change the second region in just one file, + sync again, and see the change propagate; instead, it conflicts + - diagnosis: the merge stuff is not correctly updating the archive in + the event of a partial reconciliation + +**** When deleting a directory, we should *not* skip over Unison temp files + in the process of listing children + +*** Un-writeable directories can't be copied. + The 'rename' operation at the end of Files.copy will fail (at least on + OSX) if the path being renamed points to a directory and that directory + (not the one containing it!) is not writeable by the user. To fix this, + we'd need to notice when we are renaming a directory and temporarily + make it writeable just before the rename and then make it what it should + be just after. But I don't feel like writing this bit of code right + now, to handle such a corner case. [BCP, November 2008] + +*** make the ETA bar show which file is actually transferring bytes at the + moment + +*** Fix the pred module to understand negation and delete XXXnot predicates + +*** Web + - Add a "supported platforms" page mentioning system-specific stuff + - Add an installation instructions page, removing it from the manual + +*** See if we can get rid of some Osx.XXX stuff (e.g. ressLength!?) + +*** Add the following to the Problems FAQ: + + --- In unison-hackers at y..., "Matt Swift" wrote: + > I just posted a msg to cygwin at c... detailing some very strange + > behavior of chmod when a file's owner is also the file's group. It + + I was right about the crucial circumstances of owner = group. Moral: + do not let user=group under Cygwin. I know it causes a problem when + you make unison use the full permissions model on Cygwin systems; I + think this may also explain similar problems I had using the default + unison behavior (which treats Cygwin files as read-only or read-write + only) -- though there are several possible causes of like failures to + syncrhonize permissions. + + The answer is obvious, following from the basic handling of permissions + in Cygwin (in NT permissions mode), but I didn't see it. Users and + groups to Windows are the same kind of object (SID), and permissions on + a file or directory are represented as a list of (any number of) SIDs + paired with permissions such as read, write, execute (and quite a few + more). When you try to map this to the Unix model of user and group, + when the user and group happen to be the same, the user-permissions and + the group-permissions are operating on the same underlying Windows + object, and so they cannot be different. I think the user-permissions + prevail. + + For example, if you try to sync a Unix file with permissions rw-r--r-- + with a Cygwin file with permissions rw-rw-r-- whose owner happens to be + the same as the group, unison will report success, but the actual + permissions will not be changed. Moreover, during the next sync, + unison will by default propogate the Cygwin file back to the Unix file, + so that the degenerate permissions under Cygwin will migrate to the + Unix system unless you are careful to prevent unison from doing it. + (When you are trying to sync some 75,000 email and font files, this all + is more than a little exasperating!) + + --- + + Further important advice if you are going to synchronize Cygwin + filesystems with unison's full Unix permissions model (and perhaps it + is also important even with unison's default behavior): + + Background: the flags "ntsec" or "ntea" in the CYGWIN environment + variable signals Cygwin's libraries to use the richer NT permissions + model rather than a simplified Win95-98 model. "ntsec" requires an + NTFS filesystem, "ntea" will work with FAT filesystems. I use + "ntsec". + + If unison does not have CYGWIN set appropriately in its environment, + some chmod calls will not do the expected thing, even though they + return with success. This will result in the file coming up again in + the next synchronization, and unison will then by default propagate the + (wrong) permissions from the Cygwin file back to the Unix system. (The + first chmod apparently succeeded, so unison records the new permissions + in its archive; the second time, when the file does not match the + archive, it seems to unison that the Cygwin file has been changed.) + + If you run unison from the bash command line, you will most likely not + have a problem, since CYGWIN is probably set appropriately and exported + in the .bat script that launches bash. Likewise, when the Cygwin + filesystem is the remote one, Cygwin's sshd is by default set up (by + /usr/bin/ssh-host-config) to establish and export an appropriate value + of CYGWIN to ssh clients. + + If you launch unison directly from a Windows shortcut, however, you + must set CYGWIN in your Windows environment variables. This is + certainly a convenient way to launch unison either with a particular + profile or generically. The instructions for setting up Cygwin and the + discussions of the CYGWIN envariable in the user manual never mention + any need to put CYGWIN in the Windows envariables, however. (I'm + writing them to suggest they do.) + + >From the unison standpoint, the code which chooses to use the full + permissions model on Cygwin hosts (right now I have it hacked simply to + always use full permissions, by commenting out a line) perhaps ought to + confirm that "ntsec" or "ntea" is in the CYGWIN envariable and issue a + big warning that permissions may not be properly synchronized if + neither value is there. + +** add '' + to the head section of all the unison web pages. + +** Peter Selinger has built an SHA256 implementation that should be usable + as a drop-in replacement for MD5, if we ever need to do that + +* BUILDING AND INSTALLING +* ======================= + +** 'make install' could be improved (and documented) + 1. Typing "make install' after a "make" should simply install the + program that was made, not attempt to do a remake with different options. + ===> Doesn't it??? + 2. "make install' should try to install as /usr/local/bin/unison, not + ~/bin/, especially considering that ~/bin is the wrong place to do the + install under OSX (it should be ~/Apps or ~/Apps/bin) + +** document the dynamically linked version, as some user already reported + that it works fine. Also, try to make the statistics window work with + this version. [This is "under windows," I think.] + +should strip symbols from binary files in 'make exportnative' + + +* DOCUMENTATION +* ============= + +** Put a little more order on the flags and preferences -- e.g., + organize them into "basic preferences", "advanced preferences," + "expert preferences," etc. Requires hacking the Uarg module. + +** Add something to docs about how to use 'rootalias'. Include an + explanation of the semantics, a couple of examples, and a suggestion + for how to debug what it's doing by turning on appropriate debugging + flags. (And maybe we should actually make the debug output there a + bit more verbose?) + +** Misc: + - document good trick: use -1 switch to ssh if the paths are set up wrong + on the remote host + - should say whether trailing slashes are ok for paths; should say + that leading slashes are illegal. + ===> check + - not so clear what you have to do with a Regex to match a directory + and all its subfiles: foo or foo/ or foo/.* ? + ===> the first. document it. (Does foo/ match foo? I don't think so. + Document, one way or the other.) + - what happens when files are included whose parent dirs are + excluded? (With Regex? With multiple Path and Name?) + ===> document + - the documentation is very good, but i couldn't find a description of how + to respond to the prompts in the textual ui. is that explained + somewhere? a few typos i noticed: "with t fast", "nison", "off of". + +** what happens when we ssh through loopback and sync the same + directory? + ===> Needs to be thought about. In particular, what is the name of the + archive in this case? Could they ever be exactly the same? + ===> Try it and see. + + +* SMALL FUNCTIONALITY IMPROVEMENTS +* ================================ + +**** When I tell unison to ignore a file whose name has a comma in it, + then unison adds to the preferences file a line like: + ignore = Path{this file, has a comma} + which gets interpreted as "this file" OR " has a comma". + unison should be escaping that comma and write it as \, instead. + +**** Please let me say + root = ~/bla + instead of requiring me to give an absolute path to my home dir. + +**** The archive should indicate whether it is case-dependant or not. + (This is important for correctness -- if the case-insensitive flag is + set differently on different runs, things can get very confused!) + +**** Use LargeFile (submodule of Unix) instead of standard file commands, + to avoid problems with huge files + DONE + +*** [Marcus Sundman, 2008] Unison can't propagate changes in read-only + folders. The correct way to do it is to temporarily add write + permissions for the user to the folder, then do the changes and then + reset the permissions. Now unison tries to just do the changes, which + fails with a "permission denied" error. + +*** [Adrian Stephens, 2007] I would like the scope of rootalias to be + expanded so that any command that expects a root will perform aliasing + on the command. In my application, I need to change the root statement + as I move my machine from desk to the road. I also have a "force" + statement, and I also have to remember to edit this to match. It would + be more convenient to have to edit in a single place and, more + importantly, avoids introducing any inconsistency. + --- [BCP:] I like this idea. However, since I'm struggling at the + moment to find time to finish polishing 2.27 to become the new stable + release, I am not going to undertake to implement it. If you (or + someone else) would like to give it a shot, here is what I think needs + to happen: + - Move the rootalias preference and the rootalias-expanding code from + Update.root2stringOrAlias into the Common module (creating a new + function there for rootalias expansion). + - Find places like Recon.lookupPreferredRoot that deal with names of + roots and add a call to the rootalias-expanding function. + +*** Delete old backups mechanism and, instead, extend new one to cover its + functionality + - put backups in same dir as files by default + - otherwise, put them in a central place if one is given + - Update.incrVersionsOfBackups should not be externally visible + +*** there's an HFS+ aware version of rsync called rsyncx. It should be + relatively easy to import that functionality into unison. + +*** Consider altering the socket method, so the server accepts connections + only on a particular address? This would be very useful, because many people + tunnel unison over an OpenVPN Link, and this software works with virtual + devices and additional IP addresses on it. If unison would accept + connections only on the virtual device, the security would be enhanced, + because the OpenVPN key should be unavailable for the black hats. + +*** unison -help doesn't go to stdout so it's hard to pipe it into less + ===> Probably *all* output should go to stdout, not stderr (but maybe + we need a switch to recover the current behavior) + +*** for the MSVC version of unison, we should deal with the nonstandard + semantics regarding read-only files. + ===> What does that mean?? + +*** If a root resides on a `host' with an ever and unpredictably changing + host name (like a public login cluster with dozens of machines and a + shared file system), listing each possible host name for this root is + not feasible. The ability of specifing patterns in rootaliases would + help a lot in this case. I'm thinking of something like this: + rootalias = //.*//afs/cern.ch/user/n/nagya -> + //cern.ch//afs/cern.ch/user/n/nagya [NAGY Andras , + March 12] + ===> We definitely ought to do something about this problem -- it's + increasingly common. Not sure if this is the right proposal, but + something. + +*** Currently, if a file changes on either side between the initial update + detection and the time when the transport module tries to propagate + changes, the transport is aborted. But if the change occurred on the + replica that is being used as the source for the transfer (which will + be the common case!), then there is no reason to abort -- we should + just propagate the newest version. + +*** When unison notices lock files in the archive directory, it should + offer to delete them *for* the user, rather than forcing the user to + delete them manually. + +*** improve error reporting when Unison is started with different versions of + client and server + +*** A switch to delete files before replication. It's not something I + would have considered doing, and in normal replication, there have + already been pointed out good reasons why Unison works the way it + does, but Roman makes a good reason for why this is useful in CD-RW + backups, and why this could be useful on a general to do list. And + this is certainly *generic*, which my point is not (as it only applies + to the Microsoft Windows NTFS situation). + +*** A switch to include NTFS ACE/ACL file permissions to be copied when + copying from one NTFS location to another NTFS location. As I + mentioned this is less generic, but of fundamental usefullness in + Windows usage, as NTFS permissions are absolutely essential in many + backup/replication situations in Windows systems. Robocopy has the + /SEC switch, but Unison is a far better tool, and I was hoping in that + light that Unison could implement the rights/permissions stuff also. + +*** There is no command-line argument to tell Unison where the .unison + directory is; Unison finds it in the environment or not at all. I was + able to workaround this with a symbolic link to put .unison where it was + expected, but it seems like an easy option to add. + +*** The other is possibly a bit more difficult, but more useful as well. There + is a brief window of vulnerability between when the local server is started + and when the remote client connects to it. (It's no longer than that + because Unison won't take more than one connection at a time.) I can + tolerate it, but the window could be eliminated entirely by allowing socket + connections to require a nonce. + +** Would be nice to transfer directories "incrementally" rather than + atomically (i.e., if Unison is interrupted during the transfer of a + directory, the partially-transferred directory should persist). Is + this allowed by the specification? (If so, then it should just become + the default behavior.) + ===> BCP and William Lovas have discussed how to do this, but it is + not all that straightforward. + +** we should reload the current preference file (if it's changed, at least) + when we restart + +** [A good idea for the ssh prompt issue...] I'm not sure why you would + need a C implementation; you could do the same thing in CAML that expect + does: allocate a PTY, start up ssh on that, and interact with it. On + Windows, you can probably do the same with the Win32 console API, + although I don't see why such an improvement needs to work uniformly + across all platforms to be useful. [Note that allocating PTYs is not + very portable, but we could at least try allocating one and see if + something useful comes back...] + +** An idea for the interface to the external merge functionality: + created a general mechanism for invoking external functionality... + - in profile, declare a command of the form + key M = external "merge ##1 ##2 ###" --> overwriting originals + (concrete syntax open to discussion!). Main parts are + - what key to bind it to in the UI(s) + - the command line to start up + - variables (##1 and ##2) for the local and remote files + (the remote file will automatically be copied to a local temp + file, if this variable is used) + - a variable (###) for a temporary output file + - an indication of what to do with this output file + (or maybe this could be automatic) + - (should also indicate which machine(s) to run the command on?) + +** small additions to merge functionality: + - if the external merge program *deletes* one of the files it is given, + Unison should interpret this as "Copy the other file onto this location + (instead of merging)". This will allow some other interesting + functionality, e.g. external programs that may decide to keep both + versions by moving one of them out of the way (mh-rename). + - the invocation of the external 'diff' program should be selectable + using the same conventions as the 'merge' program + - would be nice to be able to invoke DIFFERENT merge programs + depending on paths + +** We should document other available merge tools, e.g., + idiff [BCP has a copy of the code for idiff that Norman sent.] + +** Allow 'default.prf' in place of 'default' for profile names + +** [dlux at dlux.hu, Feb 2002] For some apps (e.g., some mail readers?), + putting temp files in the same directory as the file we're about to + overwrite is bad/dangerous. Some alternatives that we could + consider... + - Add a configuration option for temporary directory and notice the + user about the volume restrictions in the docs and then if the user + does not consider it, then we use a non-atomic (copy + unlink) + rename. In an ideal environment (where the user consider this + restriction), it makes possible to sync a maildir folder while it is + online! + - An even better solution: One more temporary file step. If the user + sets the temporary directory, then we synchronize the files to that + directory, and if the file is downloaded/uploaded fully, then we move + it to a tempfile into the target directory (with .unison.tmp + extension) and then rename it into the final name. + +** Suggestion for extending merge functionality + - add a new kind of preference -- a conditional stringlist preference + - in the preference file, each value looks like either + prefname = string + or + prefname = string WHEN Path PPPPP + prefname = string WHEN Name XXXXX + prefname = string WHEN Regex XXXXX + - when we look up such a preference, we provide a current path, and it + returns the one that matches the current path, if any + +** Would be good to (optionally) change the semantics of the "backup" + functionality, so that Unison would not insist on making a *full* + backup of the whole replica, but just do so lazily. (I.e., it would + not make backups when files get put into the archive, but only when + they actually get changed.) + +** Would also be nice to allow the backup preference to be set + differently on different hosts -- so that all the backups could be + kept on one side (if there is no space on the other side, e.g.). The + obvious way to do this is to add a switch like '-suppressbackupsonroot + BLAH' but this feels a bit ad hoc. It would be nicer to decide, in + general, which preferences can sensibly have different settings on + different roots (e.g., the location of the archive dir, ...) and + provide a general mechanism for setting them per-host. + +** ~/foo seems to work on the command line but not in root = ~/foo in the + config file. + -- + Similarly: It seems that when one specifies logfile = foobar + in the preferences file, then unison assumes that it is relative to the + current directory. Since neither ~ nor $HOME are understood in the + preference file, this is an inconvenience, because it forces the user to + remember to run unison from the root directory. + ===> Would be nice to support ~ internally + +** giving a -path preference whose parent dir doesn't exist currently causes + Unison to abort with a fatal error. Would be better if it just + signalled an error for that file. + +** no spec for escaping regexp chars; spaces? newlines? tabs? others? + mechanism for getting the list of files from another program (plugin)? + ===> needs to be documented (look at rx.ml) + +** seems not to recognise ignores when they are inside a path that has + just been added. +===> Jamey claims that if we add a new directory, some of whose children + are ignored, then when this new dir is propagated, also the ignored + stuff gets copied (if this is true, then it's probably a bug in + update.ml) + +* When loading archives (not just when dumping them), one should check that + they have the same checksum. + +* [July 2002, S. Garfinkel] Maybe we should turn the 'time' option on by + default. We might need to help people a little on the upgrading, + though. When you did a sync with time=false, then a sync with + time=true, you get a zillion conflicts... + ==> This is probably a good idea, but I'm a little scared of all the + messages we'd get from upgrading users + +* Maybe we should write debugging and tracing information to stdout + instead of stderr? + +* URI pathname syntax + Why is the following command wrong? + unison -servercmd `which unison` /usr/local ssh://labrador/usr/local + It took me three tries and careful reading of the documentation to + figure it out. I don't have any good suggestions here, other than + that I think the whole issue of relative vs absolute pathnames needs + serious thought. I think the current interfaces do not work very + well. One possibility that I will float is that you invent a special + character string to refer to the root of synchronization. + E.g., interpret ~ as $HOME in roots. + -- + Also: we should add the file:// syntax to URIs... + file://C:/Necula (C:/Necula on the local file system) + file:////share/subdir (//share/subdir as from the point of view of + the local file system) + unison://host///share/subdir + -- + Should local roots in a profile be canonized? + Right now, we can have a relative root in the profile. This + is going to be a problem if unison is started in a different + directory. + +* At the moment, if Unison is interrupted during a non-atomic operation + on the file system, the user has to clean things up manually, following + the instructions in the the recovery log. We should do that for them. + (This is actually a bit tricky, since we need to be careful about what + might happen if unison crashes during recovery, etc. The best way to + accomplish this would be to write a general logging/recovery facility + in OCaml.) + +* Dealing with ACLs: Maybe this is what we should do actually. We could + specify a user (and similarly a group) to unison. It would be + interpreted in a special way: if a file is owned by this user, unison + will rather consider that the owner of the file is undefined. So, when + a file owned by an unkown user is synchronized, the file owner is set + to the default user. Then, on the next synchronizations, unison will + consider that the owner has not been propagated and try again. [Should + be easy once the reconciler is made more modular] + +* The -terse preference should suppress more (in fact, almost all) + messages in the text ui. See Dale Worley's message for a detailed + proposal. + +Make sure that no filesystem check is missing in the transport agent. + ===> What does this mean? + +Would be nice to have the Unison log file relative to my home directory, + like this + logfile = ~/.unision/log + or + logfile = $HOME/.unision/log + (We should do this for *all* files that the user specifies.) + +It would be nice if Unison could have the "power" to copy write-protected + files, maybe as an option. + +Update checking over NFS might be *much* faster if we use only relative + pathnames (absolute paths may require an RPC per level!?) + +On one server (Saul), Unison seems to use HUGE amounts of memory (250Mb + resident), while on my laptop it's much less. WTF? + +[Ben Wong, Aug 2002] Why not make unison fall back to addversionno if it + would otherwise bomb out with an incorrect version number? That way I + wouldn't have to educate people on how to use Unison at my site; it'd + "just work". + +The -sortbysize is nice, but what I would really like is a -limitbysize. + When I'm connected over a modem line, I would like not to transfer the + larger files that need synchronization. That can wait until I am + connected via a faster connection. What I presently do is allow unison + to run in -sortbysize mode, and abort once I have all my little, more + important files. -limitbysize should simply filter the list of transfer + to only those that are below the threshold size. The syntax is + obvious... It should be -limitbysize xxx, where xxx is the size + (preferably in kb, but bytes will do as well). + +Maybe we should use getcwd for canonizing roots under Unix. For some + systems (Linux, for instance), getcwd succeeds even when some parent + directory is not readable. + +[From Yan Seiner] + Can unison modify the (*nix) environment to show the + ip/name/some_other_id of the system making the connection? This would + help tremendously. + For example, vtun does this: + --- + root 6319 0.0 0.6 1984 852 ? S< Aug27 0:37 vtund[s]: + bgsludge tun tun10 + root 6324 0.0 0.6 1984 852 ? S< Aug27 2:00 vtund[s]: + cardinal tun tun0 + root 17001 0.0 0.6 1984 848 ? S< Aug27 0:05 vtund[s]: + wtseller tun tun11 + root 20100 0.0 0.6 1984 852 ? S< Aug28 0:02 vtund[s]: + cardridg tun tun1 + ---- + So I know I have four sessions, to each named machine, and I know + immediately who is connected and who is not. If I have to kill a + session, I don't kill the wrong one. + +add a switch '-logerrors' that makes unison log error messages to a + separate file in addition to the standard logfile + +Dale Worley's suggestion for relocating archives: + > You're right: it's not all that tricky. So would you be happy if you + > could run unison in a special mode like this + > unison -relocate //old-host1//path1 //old-host2//path2 \ + > //new-host1//path1 //new-host2//path2 + > (where all the hosts and paths are normalized) and it would move the + > archives for you on both machines? + Actually, I think that what you want is for the user to specify the + old paths in *normalized* form and the new paths in *non-normalized* + form. That is, unison uses the old paths literally as provided by the + user, but it applies the usual normalization algorithm to the new + paths. + This may sound strange, but I think that it's the Right Thing: + - There is no guarantee that the normalization algorithm, applied to + the old paths as the user used to specify them, normalizes to the + the normalized paths that are recorded in the archive. Indeed, + there may no longer be *any* path which normalizes to the recorded + paths. + - The user can extract the normalized old paths from the second line + of the archive files. This is clumsy, but reliable. And we don't + intend the user to relocate an archive very often. + - But for the new paths, you want to normalize what the user supplies, + because he doesn't know in advance how Unison is going to normalize + the new paths, and may well specify them incorrectly. That would + leave him with a relocated archive that he might not be able to use + at all. + You might want to put quotes around the pathnames in the second line + of the archive, since MS-Windows directory names can contain spaces, + etc. + +For safety... + - Add a preference 'maxdelete' taking an integer parameter, default 100 + (or perhaps even less -- keeping it fairly small will help naive users + avoid shooting themselves in the foot). A negative number means + skip this check (i.e., infinity). + - When the transport subsystem gets control (i.e., just after the user + says 'go' to the user interface, when not running in batch mode) + it first checks the number of files that are going to be deleted + (including all the contents of any directories that are marked for + deletion). If it is more than maxdelete (and maxdelete is + positive), then... + - If we're in batch mode (batch=true), we halt without doing + anything. + - If we're not in batch mode, we display a warning message and + make the user confirm. (If they do *not* confirm, it would be + nice to dump them back into the user interface again, but this + would require a little rewriting of our control flow.) + - Would also be nice to include a display in the UI someplace that says + how many files are to be deleted/changed/created plus how many bytes + to be transferred, and a warning signal (display in red or something) + if these exceed the current setting of maxdelete. + +Might be nice to provide an option that says "if you're propagating a + newly created directory and something goes wrong with something inside + it, just ignore the file that failed and keep going with the rest of + the directory." [We probably don't want to continue in all cases (for + instance, when the disk is full)] + +Would be nice to be able to run unison in a special mode like this + unison -relocate //old-host1//path1 //old-host2//path2 \ + //new-host1//path1 //new-host2//path2 + (where all the hosts and paths are canonized) and have it move the + archives for you on both machines? + +It would be nice if unison had a tool by which it could regenerate all + the MD5 sums and compare them to what it has stored, then produce a list + of files that are different. I obviously cannot count on file size and + date in this case; those may not have changed but the contents may be + corrupt. + +If the connection to the server goes away and then comes back up, it + would be nice if Unison would transparently re-establish it (at least, + when this makes sense!) + +If we synchronize a path whose parent doesn't exist in one replica, we'll + fail. Might be nicer to create the parent path if needed. + +maybe put backup files somewhere other than in the replica (e.g. in + $HOME/tmp, or controlled by preference) + +Better documentation of the -backups flag, and a way to expire old backups + +Add a preference that makes the reconciler ignore prefs-only differences + between files (not updating the archive, though -- just suppressing + the difference -- will this slow things down too much?? Maybe it needs + to happen in the update detector, before things are transmitted across + the network.) + +Perhaps we should interpret both / and the local separator as path + separators, i.e., under Windows / and \, under Mac / and :, and under + Unix just /. For Windows this will be fine, since / is not allowed in + filenames. + +Maybe have an option to tell do not transfer toto.dvi if toto.tex exists (or + toto.ps if toto.dvi): something like + Ignore .dvi If .tex + ===> This is not a good idea -- would give different ignore results on + the two machines. But maybe a variant would work: + - Have an option to execute a command if a given file exist like + Execute rm core If core + Execute make clean If Makefile + +We should put in a preference that forces Unison to do really safe update + detection (with fingerprinting), even on Unix systems. (Maybe just for + some paths?) + +Maybe we should never emit a conflict for modtimes; instead, we just + propagate the largest one. + +[John Langford] Some code for (at least partially) handling large files + can be found in 64bit_ops.c in: + http://www-2.cs.cmu.edu/~jcl/programs/sync_file.tar.gz + Make sure you pay attention to the compile line as it is important. + +[Ivo Welch] I would do a quick test of case sensitivity in the program +itself at the time you do a first prf sync, so that the user does not have +to bother with it. Just write two files on each end which differ in case, +and see if there is overwriting. Then do the smart thing. The long-named +file in the .unison directory should keep this information thereafter. +(BCP: Implementing this is more difficult than it might seem. E.g., +whenever a symlink is followed we might need to go through the same +exercise. And then we'd need to be able to deal with replicas that are not +all one way or the other...) + +[Ivo Welch] I would give some examples in the man page of what an xxx +specification is. + +[Ivo Welch] I would allow '--' switches, in addition to the '-' switch spec. + +[Ivo Welch] On OSX, create a link from ~/Library/Application Support/Unison +to .unison, just for ease of finding it. It took me a long time to find my +.prf files. + +[Ivo Welch] the OSX GUI front end should be clear which side (left or right) +the local host and which side the remote host is. + +* USER INTERFACE +* ============== + +** In menu Actions + - show Diff applies to the current line, while + - revert to unision's recommandation applies to all lines + Should be clearer and/or homogeneous behavior. + I would also like to have "revert to unision's recommandation" for the + current line. + +** in gtk ui, display green checkmark next to finished items even if their + direction indicates a conflict; do not list such items as "skipped" at + the end + +** In both UIs, show how many bytes/files were successfully transferred + at the end + +** Should support auto-termination of the graphical UI (switch-controlled) + * Unison starts in the usual way and checks for changes + * If there are no conflicts, it proceeds without waiting for confirmation + * If there *are* conflicts, it waits for instructions, just like now + * In either case, when it's finished transferring the changes, it quits + +* [Matthew Swift] in the GTK gui at least, + display the total MB or #files or whatever it is that the ticking + %-meter is referring to when it goes from 0 to 100. it is useful to + know how big the xfer is going to be before starting it (might induce me + to choose "sort by size", or abandon and choose a smaller subset, etc.). + Also, esp. since the gui is single-threaded and unresponsive, i would + like to know what size of a synch that I am for example 50% or 22% + through. I know that an ETA and other things we're used to from many + downloading apps would require quite a bit of code, but it would help a + lot just to display whatever constant is represented by 100%. + + +* [BCP] Error reporting for per-file problems during updating leaves + something to be desired. In particular, there's no indication even of + which host the problem occurred on. (I added something that includes + "root 1" or "root 2", but I'm not sure that's better than nothing.) If + there are errors on both hosts, only one will be reported. If there + are lots of errors in a subdir, only the first will be reported. + Recon.propagateUpdates would be a starting point for changes. + +* [Jamey Leifer] + Would be nice if both UIs had a "revert to Unison's proposal" button... + +* [Jamey Leifer] + [graphic ui, wishlist] The documentation topics aren't searchable. As + a result "unison -doc running | less" is still indispensable if one + wants to find anything. I suggest adding a box + + "search in this topic: ---" + + which is always available in the doc viewer. It would be nice to + support keyboard shortcuts in the "less" style, namely "/", "n", and + "N" (i.e. search, next, previous) to avoid too much clicking. + + [graphic ui, wishlist] Ditto as far as searchability for diff reports. + +* Would be nice to have a keystroke in the UI that means 'add the current + directory to the set of ignore patterns.' + +* In the text UI, during the transport phase, print each file being + transferred on *one* line, with an arrow to indicate which way (and + dropping the explicit indication of which host from and to). The + logfile should be more explicit. + +* The unison gui currently displays a percentage completion in the lower right + corner. I would find it comforting if it would also display an effective + bandwidth there, i.e., how many bits per second are flowing through the + transport layer? I make this request because owing to a hardware + catastrophe, I have just started using Unison through the phone lines, and + it seems to do nothing for a long period of time. I don't know whether + to blame the cheap modem, the cheap ISP, or whether Unison simply isn't + telling me that bits are flowing through the wire. (netstat -tn + suggests not much is happening, but I don't know if the results can + be trusted.) + +* Would it be hard to add "tool tips" to the buttons in the UI? + ==> Look for "tooltip" in examples/testgtk.ml. + The easiest way is with a toolbar, but you can also add tooltips to any + widget (cf lines 867 and after). + +* > On a line, I would like to have a description of the action to be taken in + > clear words: (e.g. will erase file on local or will copy from local to + > remote, etc.) + This might be a good use for "tool tips," if I knew how to make them work + using lablGTK. + +* After clicking "Create new profile" in the initial profile window and + giving a name for the new profile, it is confusing to get dumped back + into the profile window again and have to explicitly select the new + profile. Would be better to skip this step and go straight into + filling in its fields. + +* Another usability issue in the text UI: , and < should mean the same to + unison. It would be nice if both had the same representation on-screen + (ie, show a "<" even if I typed a ","). Similarly for . and >. + +* The menu help for left/right arrow both said `transfer local to local'. + Not helpful. The items in question are pathnames, which you might not + have to abbreviate. To save space one might consider replacing any + common prefix, and also short prefixes that look like they might be + automounter goo, with an ellipsis. Then show, e.g., 20 chars. I'd + also be willing to name paths in my profile, e.g., replica flatcoat = + /home/cellar/nr replica cellar = /m/cellar60/nr This would be + especially attractive if my short names were meaningful on the command + line. + +* In the GTK user interface, it would be nice to be able to put up a window + displaying the contents of the log file (and add log messages to it + dynamically as we're working). Be careful, though: the log could get + large and we don't want this to be too slow. + +* Could there be an option between -ui text and -ui graphic that when combine + with -batch and -auto would start in text mode, but pop up an interactive + graphic window when real conflicts happens. + +* [Jamey Leifer] I think "unison -doc" should be mapped to "unison + -doc topics" and the error message for the former eliminated. + +* [Jamey Leifer] Typing "unison" results in the Profiles box + ("Select an existing profile..."). I think the help topics should be + available here. + +* [Jamey Leifer] The file list is confusing since the paths + are sometime relative to the root and sometimes relative to the + previous path: + Mail/drafts/3 + inbox/5538 + 5539 + 5540 + I now understand that the indentation is significant, but it's not + that clear. A further confusion is that there's varying amounts of + indentation depending on the depth of the enclosing path: + foo/1 + 2 + boo/goo/loo/1 + 3 + 4 + This is really hard to parse since the fonts are variable width. + I would prefer to read the former as: + Mail/drafts/3 + inbox/5538 + 5539 + 5540 + (with the indentation actually showing the relationship) though this + may take too much horizontal space. Alternatively, one could choose a + Windows-style display: + |-Mail/drafts/3 + |-inbox/5538 + |- 5539 + |- 5540 + +Unison's gui offers an `Actions' menu with a variety of features + regarding preferences. I would love to see an action with the following + semantics: if the two files differ only in their modification time, + prefer the older modification time. + ===> This would be easy to add, but I am beginning to worry that we are + getting too many funny little switches like this. We should think + about them all together and make sure they make sense. + +I'm watching it sync a very large file that I don't want anyway, and I'm in + a hurry. I'd like a way to say "forget that file, I don't care about it, go + on to the next one you have to sync". Doesn't sound hard...? + [Perdita Stevens, Perdita.Stevens at dcs.ed.ac.uk, Mar 14 2002] + ===> It's not trivial (involves some subtle stuff about our RPC + implementation and the single-thread nature of the GUI), but might + not be impossible either. + +"Quit" during synchronization should abort all current operations (so + that temporary files are deleted) before exiting. + ===> Again, requires some careful thinking about how this would work + with the RPC layer. + +It would be nice to have a command in the GUI that would allow a single + path within the replica to be selected from a file dialog and + synchronized. + +The scroll bar is not usable during transport: every time a line changes + in the list, the display jumps to that line; if many small files are + transfered, it makes browsing in the list quite impossible... + +[From Manuel Serrano] Would be nice to put the arrows in different + directions in different colors, so that, e.g., you could quickly scan the + list of changes and make sure that they are all in the same direction + ===> We tried this, but we couldn't find color combinations that did not + seem confusing. (Two different shades of green? Three? ...) If we + really want this, probably the best is to put in some preferences for the + user to control the colors of all the arrows individually. + +Under Windows, convert filename to Unicode before printing them. + +Text mode user interface should be brought up to date with graphical + interface (it should prompt for profile selection, creation, root + entry, etc.; command characters should be the same; ...) + +Since the manual is pretty big, it would be nice if the on-line version + were accessible through cascading menus, allowing direct access to + individual subsections. It would also be nice if it were formatted a + bit more attractively, using proportional-width fonts, etc. (Does GTK + have something like an RTF widget?) + +If I have a change I look at the detail window. It would be nice to be + able to click on one of the lines there instead of pressing one of <- + or ->. For one thing in the detail window the relative position of the + two files is up and down and translating that to <- or -> is somewhat + unintuitive. + +Also, it would be nice to highlight in the detailed window the + elements that have changed. + +Make it possible to select a bunch of conflicts at the same time and + override them all together + +The UI window should display the current roots somewhere. + +There should be a -geometry command-line interface, following the usual X + conventions. + +put in a command-line option that makes fatal errors exit right away + without displaying anything in the graphical UI (for debugging) + +Use the CTree widget to display the list of files + Add the ability to close and open directories in the UI. + +it would be nice to give a visual indication of which files are + particularly big, so that the user can tell where the transfer + operations may get slowed down. Maybe a "size bar" showing the log + of the size (perhaps also color coded). + ===> less urgent now because we can re-sort the update items by size + +Would it be hard to allow long-running transfers to be aborted? + For instance, the key "/" aborts the transmission of the selected file + OR: + Allow the user to terminate individual operations by clicking a + "cancel" button. (This is not completely straightforward because + the whole program is single-threaded. But it should be possible for + the low-level transport code in remote.ml to realize that the + operation has been aborted, clean up, and raise an exception.) + +It would be nice if the initial 'usage' message were not so long. Maybe + we could split options into 'novice' and 'expert' ones, and only print + the novice ones (with an indication how to obtain the full expert + printout). + +> Show diff should behave as an emacs view-mode buffer and quit on a single +> 'q' in the window, or better quit even without focus be sent to the diff +> window... +The UI for the diff functionality needs some polishing. (Also, it should +be merged with the new "merge" functionality.) + +consider separating switches into 'ordinary' and 'expert' categories, + documented in separate sections + +would be nice to be able to "Proceed" just the selected line + +might be nice if the GUI would beep when finished syncing (needs to be + switch-selectable and off by default, naturally). Is this easy with + LablGTK? + +It would be nice to be able to STOP the GUI in the middle of propagating + changes. + + +* TIDYING +* ======= + +* Go through the sources and make all fatal and transient error messages + as informative as possible + +More documentation (especially in the interface files) is always nice. + In particular, there isn't enough documentation of the big picture. + It isn't clear how to fit together archives, servers, paths, roots, + update detection, reconciliation, conflict resolution, or the user + interface... + +Ocamlexc v1.0, the uncaught exceptions analyzer for Objective Caml is now + available from Pessaux's home page. It would be fun to run it over the + Unison sources and see if it reveals any problems. + + +* LARGER EXTENSIONS +* ================= + +Fast update checking would be cool... Some resources: + FAM (used in Enlightenment) + dnotify (linux 2.4) + BSD kqueue + the "VFS stacking layer" implemented by a guy at Columbia + +[From JMS] + Some update detection speed improvement suggestions: + - Read the FFS (Fast Filesystem) paper for hints + - change the working directory instead of using absolute paths; this + avoids calls to the evil iname(?) facility in the kernel + - work breadth-first instead of depth first, to keep things in the + kernel cache + +Rewrite recon.ml in a more modular way. Probably, have for each property + a function taking the previous file state and the state on each + replicas, and returning in what the synchronization operation should be + (nothing, left, right, conflict); a combinator then merge the results. + +It would be good to have a graphical interface allowing management and + editing of profiles, ignore patterns, etc. Or, less ambitiously, just + have UI options for all command-line options (killServer) + +How about a facility so that you can specify more than one pair of + file systems for a single invocation of Unison? This would be like + calling Unison multiple times, except that it would ask all the + questions at once. Better yet, we could actually deal with the + multi-replica case. (The latter is pretty hard.) + +What about invoking some user-specified operation on each file as it + is transferred? Or in each directory where things have changed? + (This will require some careful design work.) + +Sync with archived directories (in tar / zip / gz format) would be + nice. Seems a bit awkward to implement, though: at the moment there + are a lot of functions all over the place that investigate and + modify the file system, and these would all have to be replaced with + a layer that transparently parses, etc., etc. + +Consider using other authentication services (e.g. Kerberos) instead + of / in addition to ssh. + +What happens when we synchronize, then decide to ignore some existing file + What happens to the entry in the archive? If mirroring, it may be + large, we probably want to delete it from the archive. + +File level synchronization (bookmarks, mailboxes) + +It might be nice to implement an (optional) safety check that detects + aliasing within a replica due to followed links (or hard links) and + complains if it finds any. This should not be *too* expensive, since + we already know all the inode numbers. (Even if it *is* expensive, it + might be useful to allow users to do this occasionally, if they are + paranoid.) + + +* WINDOWS ISSUES +* ============== + +Suggestion from Arnaud: + I have been using XP for a while and despite all the problems I have, there + is a very nice feature: being able to mount remote folders (nothing new), to + work with them offline and synchronize them. Really useful. + -- + A good way to simulate this with Unison would be to package it as a shell + extension. From the desktop by clicking on the right button the user selects + "create new Unison mount point" and answers a few trivial question. And the + rest is done in the background. There are a lot of examples of shell + extensions and there is a really good book for O'Reilly about it. + -- + A good project for a student :-) + -- + PS: see http://www.simplythebest.net/shellenh.html for some examples. + +when typing ctrl-c in windows (dos-window in win98SE) when + unison is asking for conflicting updates there araises following + message (sorry for my bad translation to english): + "This program is closes because of a non-valid action. Contact the + manufactura if the error remains". + +NTFS seems to have two ways of setting a file read-only! +Comments from Karl Moerder: + Tonight I made some files read-only on my desktop at home. I did this by + setting global read and execute permissions (from the security tab of + properties). I ran Unison and it didn't notice the change. I then set + the permissions back to full control and then selected the read-only box + (from the general tab of properties). I ran Unison again and it noticed + and pushed the perms change to the server. + I understand that Windows is a bit squirrely here, but how do you decide + which permissions to look at? It seems like perhaps the ones on the + security tab would be more natural. (?) + -- + I get similar results with both bits (they both cause read-only + behavior). + I believe that the origin of the two modes of setting is that the first + set is the old way of doing Windows protection (probably the interface + provided on FAT file systems) and the new way is the more Unix like way + (added for NTFS file systems). The new way has rwxdpo bits for each + group (and there can be several groups). + +Local Variables: +mode: outline +End: Deleted: branches/2.32/src/abort.ml =================================================================== --- trunk/src/abort.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/abort.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,31 +0,0 @@ -(* Unison file synchronizer: src/abort.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -let debug = Trace.debug "abort" - -let files = ref ([] : Uutil.File.t list) -let abortAll = ref false - -(****) - -let reset () = files := []; abortAll := false - -(****) - -let file id = - debug (fun() -> Util.msg "Aborting line %s\n" (Uutil.File.toString id)); - files := id :: !files - -let all () = abortAll := true - -(****) - -let check id = - debug (fun() -> Util.msg "Checking line %s\n" (Uutil.File.toString id)); - if !abortAll || Safelist.mem id !files then begin - debug (fun() -> - Util.msg "Abort failure for line %s\n" (Uutil.File.toString id)); - raise (Util.Transient "Aborted") - end - -let testException e = e = Util.Transient "Aborted" Copied: branches/2.32/src/abort.ml (from rev 320, trunk/src/abort.ml) =================================================================== --- branches/2.32/src/abort.ml (rev 0) +++ branches/2.32/src/abort.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,46 @@ +(* Unison file synchronizer: src/abort.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +let debug = Trace.debug "abort" + +let files = ref ([] : Uutil.File.t list) +let abortAll = ref false + +(****) + +let reset () = files := []; abortAll := false + +(****) + +let file id = + debug (fun() -> Util.msg "Aborting line %s\n" (Uutil.File.toString id)); + files := id :: !files + +let all () = abortAll := true + +(****) + +let check id = + debug (fun() -> Util.msg "Checking line %s\n" (Uutil.File.toString id)); + if !abortAll || Safelist.mem id !files then begin + debug (fun() -> + Util.msg "Abort failure for line %s\n" (Uutil.File.toString id)); + raise (Util.Transient "Aborted") + end + +let testException e = e = Util.Transient "Aborted" Deleted: branches/2.32/src/case.ml =================================================================== --- trunk/src/case.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/case.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,82 +0,0 @@ -(* Unison file synchronizer: src/case.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* The update detector, reconciler, and transporter behave differently *) -(* depending on whether the local and/or remote file system is case *) -(* insensitive. This pref is set during the initial handshake if any one of *) -(* the hosts is case insensitive. *) -let caseInsensitiveMode = - Prefs.createString "ignorecase" "default" - "!identify upper/lowercase filenames (true/false/default)" - ("When set to {\\tt true}, this flag causes Unison to treat " - ^ "filenames as case insensitive---i.e., files in the two " - ^ "replicas whose names differ in (upper- and lower-case) `spelling' " - ^ "are treated as the same file. When the flag is set to {\\tt false}, Unison " - ^ "will treat all filenames as case sensitive. Ordinarily, when the flag is " - ^ "set to {\\tt default}, " - ^ "filenames are automatically taken to be case-insensitive if " - ^ "either host is running Windows or OSX. In rare circumstances it is " - ^ "useful to set the flag manually (e.g. when running Unison on a " - ^ "Unix system with a FAT [Windows] volume mounted).") - -(* Defining this variable as a preference ensures that it will be propagated - to the other host during initialization *) -let someHostIsInsensitive = - Prefs.createBool "someHostIsInsensitive" false - "*Pseudo-preference for internal use only" "" - -(* Note: this function must be fast *) -let insensitive () = Prefs.read someHostIsInsensitive - -let needNormalization s = - let rec iter s pos len wasDot = - if pos = len then wasDot else - let c = s.[pos] in - (wasDot && c = '/') || iter s (pos + 1) len (c = '.') - in - iter s 0 (String.length s) false - -let removeTrailingDots s = - let len = String.length s in - let s' = String.create len in - let pos = ref (len - 1) in - let pos' = ref (len - 1) in - while !pos >= 0 do - while !pos >= 0 && s.[!pos] = '.' do decr pos done; - while !pos >= 0 && s.[!pos] <> '/' do - s'.[!pos'] <- s.[!pos]; decr pos; decr pos' - done; - while !pos >= 0 && s.[!pos] = '/' do - s'.[!pos'] <- s.[!pos]; decr pos; decr pos' - done - done; - String.sub s' (!pos' + 1) (len - !pos' - 1) - -(* Dots are ignored at the end of filenames under Windows. *) -let normalize s = - s -(*FIX: disabled for know -- requires an archive version change - if - insensitive () && -(*FIX: should only be done when one host is running under Windows... -(should be OK for now as it seems unlikely to have a file ending with - a dot and the same file with the same name but no dot at the end) - Prefs.read someHostIsRunningWindows && - not (Prefs.read allHostsAreRunningWindows) && -*) - needNormalization s - then - removeTrailingDots s - else - s -*) - -(* 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 *) -(* by storing the information in a pref so that it is propagated to the *) -(* server with the rest of the prefs. *) -let init b = - Prefs.set someHostIsInsensitive - (Prefs.read caseInsensitiveMode = "yes" || - Prefs.read caseInsensitiveMode = "true" || - (Prefs.read caseInsensitiveMode = "default" && b)) Copied: branches/2.32/src/case.ml (from rev 320, trunk/src/case.ml) =================================================================== --- branches/2.32/src/case.ml (rev 0) +++ branches/2.32/src/case.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,97 @@ +(* Unison file synchronizer: src/case.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +(* The update detector, reconciler, and transporter behave differently *) +(* depending on whether the local and/or remote file system is case *) +(* insensitive. This pref is set during the initial handshake if any one of *) +(* the hosts is case insensitive. *) +let caseInsensitiveMode = + Prefs.createString "ignorecase" "default" + "!identify upper/lowercase filenames (true/false/default)" + ("When set to {\\tt true}, this flag causes Unison to treat " + ^ "filenames as case insensitive---i.e., files in the two " + ^ "replicas whose names differ in (upper- and lower-case) `spelling' " + ^ "are treated as the same file. When the flag is set to {\\tt false}, Unison " + ^ "will treat all filenames as case sensitive. Ordinarily, when the flag is " + ^ "set to {\\tt default}, " + ^ "filenames are automatically taken to be case-insensitive if " + ^ "either host is running Windows or OSX. In rare circumstances it is " + ^ "useful to set the flag manually (e.g. when running Unison on a " + ^ "Unix system with a FAT [Windows] volume mounted).") + +(* Defining this variable as a preference ensures that it will be propagated + to the other host during initialization *) +let someHostIsInsensitive = + Prefs.createBool "someHostIsInsensitive" false + "*Pseudo-preference for internal use only" "" + +(* Note: this function must be fast *) +let insensitive () = Prefs.read someHostIsInsensitive + +let needNormalization s = + let rec iter s pos len wasDot = + if pos = len then wasDot else + let c = s.[pos] in + (wasDot && c = '/') || iter s (pos + 1) len (c = '.') + in + iter s 0 (String.length s) false + +let removeTrailingDots s = + let len = String.length s in + let s' = String.create len in + let pos = ref (len - 1) in + let pos' = ref (len - 1) in + while !pos >= 0 do + while !pos >= 0 && s.[!pos] = '.' do decr pos done; + while !pos >= 0 && s.[!pos] <> '/' do + s'.[!pos'] <- s.[!pos]; decr pos; decr pos' + done; + while !pos >= 0 && s.[!pos] = '/' do + s'.[!pos'] <- s.[!pos]; decr pos; decr pos' + done + done; + String.sub s' (!pos' + 1) (len - !pos' - 1) + +(* Dots are ignored at the end of filenames under Windows. *) +let normalize s = + s +(*FIX: disabled for know -- requires an archive version change + if + insensitive () && +(*FIX: should only be done when one host is running under Windows... +(should be OK for now as it seems unlikely to have a file ending with + a dot and the same file with the same name but no dot at the end) + Prefs.read someHostIsRunningWindows && + not (Prefs.read allHostsAreRunningWindows) && +*) + needNormalization s + then + removeTrailingDots s + else + s +*) + +(* 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 *) +(* by storing the information in a pref so that it is propagated to the *) +(* server with the rest of the prefs. *) +let init b = + Prefs.set someHostIsInsensitive + (Prefs.read caseInsensitiveMode = "yes" || + Prefs.read caseInsensitiveMode = "true" || + (Prefs.read caseInsensitiveMode = "default" && b)) Deleted: branches/2.32/src/case.mli =================================================================== --- trunk/src/case.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/case.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,8 +0,0 @@ -(* Unison file synchronizer: src/case.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -val insensitive : unit -> bool - -val normalize : string -> string - -val init : bool -> unit Copied: branches/2.32/src/case.mli (from rev 320, trunk/src/case.mli) =================================================================== --- branches/2.32/src/case.mli (rev 0) +++ branches/2.32/src/case.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,8 @@ +(* Unison file synchronizer: src/case.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +val insensitive : unit -> bool + +val normalize : string -> string + +val init : bool -> unit Deleted: branches/2.32/src/checksum.ml =================================================================== --- trunk/src/checksum.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/checksum.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,50 +0,0 @@ -(* Unison file synchronizer: src/checksum.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* The checksum (or fast fingerprinting) algorithm must be fast and has to *) -(* be called in a rolling fashion (i.e. we must be able to calculate a new *) -(* checksum when provided the current checksum, the outgoing character and *) -(* the incoming one). *) - -(* Definition: cksum([c_n, c_{n-1}, ..., c_0]) = Sum c_i * 16381 ^ i *) - -type t = int - -type u = int array - -(* [power v n] computes [v ^ n] *) -let rec power v n = - if n = 0 then 1 else - let v' = power v (n / 2) in - let v'' = v' * v' in - if n land 1 <> 0 then v * v'' else v'' - -(* Takes the block length and returns a pre-computed table for the function *) -(* roll: If [init l] => I, then I_n = n * 16381 ^ (l + 1), for 0 <= n < 256 *) -(* NB: 256 is the upper-bound of ASCII code returned by Char.code *) - -let init l = - let p = power 16381 (l + 1) in - Array.init 256 (fun i -> (i * p) land 0x7fffffff) - -(* Function [roll] computes fixed-length checksum from previous checksum *) -(* Roughly: given the pre-computed table, compute the new checksum from the *) -(* old one along with the outgoing and incoming characters, i.e., *) -(* - *) -(* [roll cksum([c_n, ..., c_0]) c_n c'] => cksum([c_{n-1}, ..., c_0, c']) *) -(* - *) -let roll init cksum cout cin = - let v = cksum + Char.code cin in - (v lsl 14 - (v + v + v) (* v * 16381 *) - - Array.unsafe_get init (Char.code cout)) land 0x7fffffff - -(* Function [substring] computes checksum for a given substring in one batch *) -(* process: [substring s p l] => cksum([s_p, ..., s_{p + l - 1}]) *) - -let substring s p l = - let cksum = ref 0 in - for i = p to p + l - 1 do - let v = !cksum + Char.code (String.unsafe_get s i) in - cksum := (v lsl 14 - (v + v + v)) (* v * 16381 *) - done; - !cksum land 0x7fffffff Copied: branches/2.32/src/checksum.ml (from rev 320, trunk/src/checksum.ml) =================================================================== --- branches/2.32/src/checksum.ml (rev 0) +++ branches/2.32/src/checksum.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,65 @@ +(* Unison file synchronizer: src/checksum.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +(* The checksum (or fast fingerprinting) algorithm must be fast and has to *) +(* be called in a rolling fashion (i.e. we must be able to calculate a new *) +(* checksum when provided the current checksum, the outgoing character and *) +(* the incoming one). *) + +(* Definition: cksum([c_n, c_{n-1}, ..., c_0]) = Sum c_i * 16381 ^ i *) + +type t = int + +type u = int array + +(* [power v n] computes [v ^ n] *) +let rec power v n = + if n = 0 then 1 else + let v' = power v (n / 2) in + let v'' = v' * v' in + if n land 1 <> 0 then v * v'' else v'' + +(* Takes the block length and returns a pre-computed table for the function *) +(* roll: If [init l] => I, then I_n = n * 16381 ^ (l + 1), for 0 <= n < 256 *) +(* NB: 256 is the upper-bound of ASCII code returned by Char.code *) + +let init l = + let p = power 16381 (l + 1) in + Array.init 256 (fun i -> (i * p) land 0x7fffffff) + +(* Function [roll] computes fixed-length checksum from previous checksum *) +(* Roughly: given the pre-computed table, compute the new checksum from the *) +(* old one along with the outgoing and incoming characters, i.e., *) +(* - *) +(* [roll cksum([c_n, ..., c_0]) c_n c'] => cksum([c_{n-1}, ..., c_0, c']) *) +(* - *) +let roll init cksum cout cin = + let v = cksum + Char.code cin in + (v lsl 14 - (v + v + v) (* v * 16381 *) + - Array.unsafe_get init (Char.code cout)) land 0x7fffffff + +(* Function [substring] computes checksum for a given substring in one batch *) +(* process: [substring s p l] => cksum([s_p, ..., s_{p + l - 1}]) *) + +let substring s p l = + let cksum = ref 0 in + for i = p to p + l - 1 do + let v = !cksum + Char.code (String.unsafe_get s i) in + cksum := (v lsl 14 - (v + v + v)) (* v * 16381 *) + done; + !cksum land 0x7fffffff Deleted: branches/2.32/src/checksum.mli =================================================================== --- trunk/src/checksum.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/checksum.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,19 +0,0 @@ -(* Unison file synchronizer: src/checksum.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -type t = int -type u = int array - -val init : int (* blockSize *) - -> u (* pre-computed table *) - -val substring : string - -> int (* offset in string *) - -> int (* substring length *) - -> t - -val roll : u (* string length *) - -> t (* previous checksum *) - -> char (* outgoing char *) - -> char (* incoming char *) - -> t Copied: branches/2.32/src/checksum.mli (from rev 320, trunk/src/checksum.mli) =================================================================== --- branches/2.32/src/checksum.mli (rev 0) +++ branches/2.32/src/checksum.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,19 @@ +(* Unison file synchronizer: src/checksum.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +type t = int +type u = int array + +val init : int (* blockSize *) + -> u (* pre-computed table *) + +val substring : string + -> int (* offset in string *) + -> int (* substring length *) + -> t + +val roll : u (* string length *) + -> t (* previous checksum *) + -> char (* outgoing char *) + -> char (* incoming char *) + -> t Deleted: branches/2.32/src/clroot.ml =================================================================== --- trunk/src/clroot.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/clroot.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,231 +0,0 @@ -(* Unison file synchronizer: src/clroot.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* - This file parses the unison command-line arguments that - specify replicas. The syntax for replicas is based on that of - URI's, described in RFC 2396. They have the following grammar: - - replica ::= [protocol:]//[user@][host][:port][/path] - | path - - protocol ::= file - | socket - | ssh - | rsh - - user ::= [-_a-zA-Z0-9]+ - - host ::= [-_a-zA-Z0-9.]+ - - port ::= [0-9]+ - - path is any string that does not begin with protocol: or //. - -*) - -(* Command-line roots *) -type clroot = - ConnectLocal of - string option (* root *) - | ConnectByShell of - string (* shell = "rsh" or "ssh" *) - * string (* name of host *) - * string option (* user name to log in as *) - * string option (* port *) - * string option (* root of replica in host fs *) - | ConnectBySocket of - string (* name of host *) - * string (* port where server should be listening *) - * string option (* root of replica in host fs *) - -(* Internal datatypes used in parsing command-line roots *) -type protocol = File | Rsh | Socket | Ssh -type uri = protocol (* - a protocol *) - * string option (* - an optional user *) - * string option (* - an optional host *) - * int option (* - an optional port *) - * string option (* - an optional path *) - -(* Regular expressions, used in parsing *) -let protocolColonSlashSlashRegexp = Str.regexp "[a-zA-Z]+://" -let protocolColonRegexp = Str.regexp "[a-zA-Z]+:" -let slashSlashRegexp = Str.regexp "//" - -let getProtocolSlashSlash s = - if Str.string_match protocolColonSlashSlashRegexp s 0 - then - let matched = Str.matched_string s in - let len = String.length matched in - let remainder = Str.string_after s len in - let protocolName = String.sub matched 0 (len-3) in - let protocol = - match protocolName with - "file" -> File - | "rsh" -> Rsh - | "socket" -> Socket - | "ssh" -> Ssh - | "unison" -> - raise(Invalid_argument - (Printf.sprintf "protocol unison has been deprecated, use file, ssh, rsh, or socket instead" )) - | _ -> - raise(Invalid_argument - (Printf.sprintf "unrecognized protocol %s" protocolName)) in - Some(protocol,remainder) - else if Str.string_match slashSlashRegexp s 0 - then Some(File,String.sub s 2 (String.length s - 2)) - else if Str.string_match protocolColonRegexp s 0 - then - let matched = Str.matched_string s in - match matched with - "file:" | "ssh:" | "rsh:" | "socket:" -> - raise(Util.Fatal - (Printf.sprintf - "ill-formed root specification %s (%s must be followed by //)" - s matched)) - | _ -> None - else None - -let userAtRegexp = Str.regexp "[-_a-zA-Z0-9.]+@" -let getUser s = - if Str.string_match userAtRegexp s 0 - then - let userAt = Str.matched_string s in - let len = String.length userAt in - let afterAt = Str.string_after s len in - let beforeAt = String.sub userAt 0 (len-1) in - (Some beforeAt,afterAt) - else (None,s) - -let hostRegexp = Str.regexp "[-_a-zA-Z0-9.]+" -let getHost s = - if Str.string_match hostRegexp s 0 - then - let host = Str.matched_string s in - let s' = Str.string_after s (String.length host) in - (Some host,s') - else (None,s) - -let colonPortRegexp = Str.regexp ":[^/]+" -let getPort s = - if Str.string_match colonPortRegexp s 0 - then - let colonPort = Str.matched_string s in - let len = String.length colonPort in - let port = String.sub colonPort 1 (len-1) in - let s' = Str.string_after s len in - (Some port,s') - else (None,s) - -(* parseUri : string - -> protocol - * user option - * host option - * port option - * path option - - where user, host, port, and path are strings, - and path is guaranteed to be non-empty -*) -let parseUri s = - match getProtocolSlashSlash s with - None -> - (File,None,None,None,Some s) - | Some(protocol,s0) -> - let (userOpt,s1) = getUser s0 in - let (hostOpt,s2) = getHost s1 in - let (portOpt,s3) = getPort s2 in - let pathOpt = - let len = String.length s3 in - if len <= 0 then None - else if String.get s3 0 = '/' then - if len=1 then None - else Some(String.sub s3 1 (len-1)) - else - raise(Util.Fatal - (Printf.sprintf "ill-formed root specification %s" s)) in - (protocol,userOpt,hostOpt,portOpt,pathOpt) - -(* These should succeed *) -let t1 = "socket://tjim at saul.cis.upenn.edu:4040/hello/world" -let t2 = "ssh://tjim at saul/hello/world" -let t3 = "rsh://saul:4040/hello/world" -let t4 = "rsh://saul/hello/world" -let t5 = "rsh://saul" -let t6 = "rsh:///hello/world" -let t7 = "///hello/world" -let t8 = "//raptor/usr/local/bin" -let t9 = "file://raptor/usr/local/bin" -let t9 = "//turtle/c:/winnt/" -let t9 = "file://turtle/c:/winnt/" - -(* These should fail *) -let b1 = "//saul:40a4/hello" -let b2 = "RSH://saul/hello" -let b3 = "rsh:/saul/hello" -let b4 = "//s%aul/hello" - -let cannotAbbrevFileRx = Rx.rx "(file:|ssh:|rsh:|socket:).*" -let networkNameRx = Rx.rx "//.*" -(* Main external printing function *) -let clroot2string = function - ConnectLocal None -> "." -| ConnectLocal(Some s) -> - if Rx.match_string cannotAbbrevFileRx s - then if Rx.match_string networkNameRx s - then Printf.sprintf "file:%s" s - else Printf.sprintf "file:///%s" s - else s -| ConnectBySocket(h,p,s) -> - Printf.sprintf "socket://%s:%s/%s" h p - (match s with None -> "" | Some x -> x) -| ConnectByShell(sh,h,u,p,s) -> - let user = match u with None -> "" | Some x -> x^"@" in - let port = match p with None -> "" | Some x -> ":"^x in - let path = match s with None -> "" | Some x -> x in - Printf.sprintf "%s://%s%s%s/%s" sh user h port path - -let sshversion = Prefs.createString "sshversion" "" - "*optional version suffix for ssh command [1 or 2]" - ("This preference can be used to control which version " - ^ "of ssh should be used to connect to the server. Legal values are " - ^ "1 and 2, which will cause unison to try to use \\verb|ssh1| or" - ^ "\\verb|ssh2| instead of just \\verb|ssh| to invoke ssh. " - ^ "The default value is empty, which will make unison use whatever " - ^ "version of ssh is installed as the default `ssh' command.") - -(* Main external function *) -let parseRoot string = - let illegal2 s = raise(Prefs.IllegalValue - (Printf.sprintf - "%s: %s" string s)) in - let (protocol,user,host,port,path) = parseUri string in - let clroot = - match protocol,user,host,port with - | _,_,None,Some _ - | _,Some _,None,None - | Rsh,_,None,_ - | Ssh,_,None,_ -> - illegal2 "missing host" - | Rsh,_,_,Some _ -> - illegal2 "ill-formed (cannot use a port number with rsh)" - | File,_,_,Some _ -> - illegal2 "ill-formed (cannot use a port number with file)" - | File,_,Some h,None -> - let prefix = "//"^h^"/" in - (match path with - None -> ConnectLocal(Some prefix) - | Some p -> ConnectLocal(Some(prefix^p))) - | File,None,None,None -> - ConnectLocal(path) - | Socket,None,Some h,Some p -> - ConnectBySocket(h,p,path) - | Socket,Some _,_,_ -> - illegal2 "ill-formed (cannot use a user with socket)" - | Socket,_,_,None -> - illegal2 "ill-formed (must give a port number with socket)" - | Rsh,_,Some h,_ -> - ConnectByShell("rsh",h,user,port,path) - | Ssh,_,Some h,_ -> - ConnectByShell("ssh"^(Prefs.read sshversion),h,user,port,path) in - clroot Copied: branches/2.32/src/clroot.ml (from rev 320, trunk/src/clroot.ml) =================================================================== --- branches/2.32/src/clroot.ml (rev 0) +++ branches/2.32/src/clroot.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,246 @@ +(* Unison file synchronizer: src/clroot.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +(* + This file parses the unison command-line arguments that + specify replicas. The syntax for replicas is based on that of + URI's, described in RFC 2396. They have the following grammar: + + replica ::= [protocol:]//[user@][host][:port][/path] + | path + + protocol ::= file + | socket + | ssh + | rsh + + user ::= [-_a-zA-Z0-9]+ + + host ::= [-_a-zA-Z0-9.]+ + + port ::= [0-9]+ + + path is any string that does not begin with protocol: or //. + +*) + +(* Command-line roots *) +type clroot = + ConnectLocal of + string option (* root *) + | ConnectByShell of + string (* shell = "rsh" or "ssh" *) + * string (* name of host *) + * string option (* user name to log in as *) + * string option (* port *) + * string option (* root of replica in host fs *) + | ConnectBySocket of + string (* name of host *) + * string (* port where server should be listening *) + * string option (* root of replica in host fs *) + +(* Internal datatypes used in parsing command-line roots *) +type protocol = File | Rsh | Socket | Ssh +type uri = protocol (* - a protocol *) + * string option (* - an optional user *) + * string option (* - an optional host *) + * int option (* - an optional port *) + * string option (* - an optional path *) + +(* Regular expressions, used in parsing *) +let protocolColonSlashSlashRegexp = Str.regexp "[a-zA-Z]+://" +let protocolColonRegexp = Str.regexp "[a-zA-Z]+:" +let slashSlashRegexp = Str.regexp "//" + +let getProtocolSlashSlash s = + if Str.string_match protocolColonSlashSlashRegexp s 0 + then + let matched = Str.matched_string s in + let len = String.length matched in + let remainder = Str.string_after s len in + let protocolName = String.sub matched 0 (len-3) in + let protocol = + match protocolName with + "file" -> File + | "rsh" -> Rsh + | "socket" -> Socket + | "ssh" -> Ssh + | "unison" -> + raise(Invalid_argument + (Printf.sprintf "protocol unison has been deprecated, use file, ssh, rsh, or socket instead" )) + | _ -> + raise(Invalid_argument + (Printf.sprintf "unrecognized protocol %s" protocolName)) in + Some(protocol,remainder) + else if Str.string_match slashSlashRegexp s 0 + then Some(File,String.sub s 2 (String.length s - 2)) + else if Str.string_match protocolColonRegexp s 0 + then + let matched = Str.matched_string s in + match matched with + "file:" | "ssh:" | "rsh:" | "socket:" -> + raise(Util.Fatal + (Printf.sprintf + "ill-formed root specification %s (%s must be followed by //)" + s matched)) + | _ -> None + else None + +let userAtRegexp = Str.regexp "[-_a-zA-Z0-9.]+@" +let getUser s = + if Str.string_match userAtRegexp s 0 + then + let userAt = Str.matched_string s in + let len = String.length userAt in + let afterAt = Str.string_after s len in + let beforeAt = String.sub userAt 0 (len-1) in + (Some beforeAt,afterAt) + else (None,s) + +let hostRegexp = Str.regexp "[-_a-zA-Z0-9.]+" +let getHost s = + if Str.string_match hostRegexp s 0 + then + let host = Str.matched_string s in + let s' = Str.string_after s (String.length host) in + (Some host,s') + else (None,s) + +let colonPortRegexp = Str.regexp ":[^/]+" +let getPort s = + if Str.string_match colonPortRegexp s 0 + then + let colonPort = Str.matched_string s in + let len = String.length colonPort in + let port = String.sub colonPort 1 (len-1) in + let s' = Str.string_after s len in + (Some port,s') + else (None,s) + +(* parseUri : string + -> protocol + * user option + * host option + * port option + * path option + + where user, host, port, and path are strings, + and path is guaranteed to be non-empty +*) +let parseUri s = + match getProtocolSlashSlash s with + None -> + (File,None,None,None,Some s) + | Some(protocol,s0) -> + let (userOpt,s1) = getUser s0 in + let (hostOpt,s2) = getHost s1 in + let (portOpt,s3) = getPort s2 in + let pathOpt = + let len = String.length s3 in + if len <= 0 then None + else if String.get s3 0 = '/' then + if len=1 then None + else Some(String.sub s3 1 (len-1)) + else + raise(Util.Fatal + (Printf.sprintf "ill-formed root specification %s" s)) in + (protocol,userOpt,hostOpt,portOpt,pathOpt) + +(* These should succeed *) +let t1 = "socket://tjim at saul.cis.upenn.edu:4040/hello/world" +let t2 = "ssh://tjim at saul/hello/world" +let t3 = "rsh://saul:4040/hello/world" +let t4 = "rsh://saul/hello/world" +let t5 = "rsh://saul" +let t6 = "rsh:///hello/world" +let t7 = "///hello/world" +let t8 = "//raptor/usr/local/bin" +let t9 = "file://raptor/usr/local/bin" +let t9 = "//turtle/c:/winnt/" +let t9 = "file://turtle/c:/winnt/" + +(* These should fail *) +let b1 = "//saul:40a4/hello" +let b2 = "RSH://saul/hello" +let b3 = "rsh:/saul/hello" +let b4 = "//s%aul/hello" + +let cannotAbbrevFileRx = Rx.rx "(file:|ssh:|rsh:|socket:).*" +let networkNameRx = Rx.rx "//.*" +(* Main external printing function *) +let clroot2string = function + ConnectLocal None -> "." +| ConnectLocal(Some s) -> + if Rx.match_string cannotAbbrevFileRx s + then if Rx.match_string networkNameRx s + then Printf.sprintf "file:%s" s + else Printf.sprintf "file:///%s" s + else s +| ConnectBySocket(h,p,s) -> + Printf.sprintf "socket://%s:%s/%s" h p + (match s with None -> "" | Some x -> x) +| ConnectByShell(sh,h,u,p,s) -> + let user = match u with None -> "" | Some x -> x^"@" in + let port = match p with None -> "" | Some x -> ":"^x in + let path = match s with None -> "" | Some x -> x in + Printf.sprintf "%s://%s%s%s/%s" sh user h port path + +let sshversion = Prefs.createString "sshversion" "" + "*optional version suffix for ssh command [1 or 2]" + ("This preference can be used to control which version " + ^ "of ssh should be used to connect to the server. Legal values are " + ^ "1 and 2, which will cause unison to try to use \\verb|ssh1| or" + ^ "\\verb|ssh2| instead of just \\verb|ssh| to invoke ssh. " + ^ "The default value is empty, which will make unison use whatever " + ^ "version of ssh is installed as the default `ssh' command.") + +(* Main external function *) +let parseRoot string = + let illegal2 s = raise(Prefs.IllegalValue + (Printf.sprintf + "%s: %s" string s)) in + let (protocol,user,host,port,path) = parseUri string in + let clroot = + match protocol,user,host,port with + | _,_,None,Some _ + | _,Some _,None,None + | Rsh,_,None,_ + | Ssh,_,None,_ -> + illegal2 "missing host" + | Rsh,_,_,Some _ -> + illegal2 "ill-formed (cannot use a port number with rsh)" + | File,_,_,Some _ -> + illegal2 "ill-formed (cannot use a port number with file)" + | File,_,Some h,None -> + let prefix = "//"^h^"/" in + (match path with + None -> ConnectLocal(Some prefix) + | Some p -> ConnectLocal(Some(prefix^p))) + | File,None,None,None -> + ConnectLocal(path) + | Socket,None,Some h,Some p -> + ConnectBySocket(h,p,path) + | Socket,Some _,_,_ -> + illegal2 "ill-formed (cannot use a user with socket)" + | Socket,_,_,None -> + illegal2 "ill-formed (must give a port number with socket)" + | Rsh,_,Some h,_ -> + ConnectByShell("rsh",h,user,port,path) + | Ssh,_,Some h,_ -> + ConnectByShell("ssh"^(Prefs.read sshversion),h,user,port,path) in + clroot Deleted: branches/2.32/src/clroot.mli =================================================================== --- trunk/src/clroot.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/clroot.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,21 +0,0 @@ -(* Unison file synchronizer: src/clroot.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* Command-line roots *) -type clroot = - ConnectLocal of - string option (* root *) - | ConnectByShell of - string (* shell = "rsh" or "ssh" *) - * string (* name of host *) - * string option (* user name to log in as *) - * string option (* port *) - * string option (* root of replica in host fs *) - | ConnectBySocket of - string (* name of host *) - * string (* port where server should be listening *) - * string option (* root of replica in host fs *) - -val clroot2string : clroot -> string - -val parseRoot : string -> clroot Copied: branches/2.32/src/clroot.mli (from rev 320, trunk/src/clroot.mli) =================================================================== --- branches/2.32/src/clroot.mli (rev 0) +++ branches/2.32/src/clroot.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,21 @@ +(* Unison file synchronizer: src/clroot.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +(* Command-line roots *) +type clroot = + ConnectLocal of + string option (* root *) + | ConnectByShell of + string (* shell = "rsh" or "ssh" *) + * string (* name of host *) + * string option (* user name to log in as *) + * string option (* port *) + * string option (* root of replica in host fs *) + | ConnectBySocket of + string (* name of host *) + * string (* port where server should be listening *) + * string option (* root of replica in host fs *) + +val clroot2string : clroot -> string + +val parseRoot : string -> clroot Deleted: branches/2.32/src/common.ml =================================================================== --- trunk/src/common.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/common.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,203 +0,0 @@ -(* Unison file synchronizer: src/common.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -type hostname = string - -(* Canonized roots *) -type host = - Local - | Remote of hostname - -type root = host * Fspath.t - -type 'a oneperpath = ONEPERPATH of 'a list - -(* ------------------------------------------------------------------------- *) -(* Printing *) -(* ------------------------------------------------------------------------- *) - -let root2hostname root = - match root with - (Local, _) -> "local" - | (Remote host, _) -> host - -let root2string root = - match root with - (Local, fspath) -> Fspath.toString fspath - | (Remote host, fspath) -> "//"^host^"/"^(Fspath.toString fspath) - -(* ------------------------------------------------------------------------- *) -(* Root comparison *) -(* ------------------------------------------------------------------------- *) - -let compareRoots x y = - match x,y with - (Local,fspath1), (Local,fspath2) -> - (* FIX: This is a path comparison, should it take case - sensitivity into account ? *) - compare (Fspath.toString fspath1) (Fspath.toString fspath2) - | (Local,_), (Remote _,_) -> -1 - | (Remote _,_), (Local,_) -> 1 - | (Remote host1, fspath1), (Remote host2, fspath2) -> - let result = - (* FIX: Should this ALWAYS be a case insensitive compare? *) - compare host1 host2 in - if result = 0 then - (* FIX: This is a path comparison, should it take case - sensitivity into account ? *) - compare (Fspath.toString fspath1) (Fspath.toString fspath2) - else - result - -let sortRoots rootList = Safelist.sort compareRoots rootList - -(* ---------------------------------------------------------------------- *) - -type prevState = - Previous of Fileinfo.typ * Props.t * Os.fullfingerprint * Osx.ressStamp - | New - -type contentschange = - ContentsSame - | ContentsUpdated of Os.fullfingerprint * Fileinfo.stamp * Osx.ressStamp - -type permchange = PropsSame | PropsUpdated - -type updateItem = - NoUpdates (* Path not changed *) - | Updates (* Path changed in this replica *) - of updateContent (* - new state *) - * prevState (* - summary of old state *) - | Error (* Error while detecting updates *) - of string (* - description of error *) - -and updateContent = - Absent (* Path refers to nothing *) - | File (* Path refers to an ordinary file *) - of Props.t (* - summary of current state *) - * contentschange (* - hint to transport agent *) - | Dir (* Path refers to a directory *) - of Props.t (* - summary of current state *) - * (Name.t * updateItem) list (* - children; - MUST KEEP SORTED for recon *) - * permchange (* - did permissions change? *) - * bool (* - is the directory now empty? *) - | Symlink (* Path refers to a symbolic link *) - of string (* - link text *) - -(* ------------------------------------------------------------------------- *) - -type status = - [ `Deleted - | `Modified - | `PropsChanged - | `Created - | `Unchanged ] - -type replicaContent = Fileinfo.typ * status * Props.t * updateItem - -type direction = - Conflict - | Merge - | Replica1ToReplica2 - | Replica2ToReplica1 - -let direction2string = function - Conflict -> "conflict" - | Merge -> "merge" - | Replica1ToReplica2 -> "replica1 to replica2" - | Replica2ToReplica1 -> "replica2 to replica1" - -type replicas = - Problem of string (* There was a problem during update detection *) - | Different (* Replicas differ *) - of replicaContent (* - content of first replica *) - * replicaContent (* - content of second replica *) - * direction ref (* - action to take *) - * direction (* - default action to take *) - -type reconItem = - {path : Path.t; - replicas : replicas} - -let ucLength = function - File(desc,_) -> Props.length desc - | Dir(desc,_,_,_) -> Props.length desc - | _ -> Uutil.Filesize.zero - -let uiLength = function - Updates(uc,_) -> ucLength uc - | _ -> Uutil.Filesize.zero - -let riAction (_, s, _, _) (_, s', _, _) = - match s, s' with - `Deleted, _ -> - `Delete - | (`Unchanged | `PropsChanged), (`Unchanged | `PropsChanged) -> - `SetProps - | _ -> - `Copy - -let rcLength ((_, _, p, _) as rc) rc' = - if riAction rc rc' = `SetProps then - Uutil.Filesize.zero - else - Props.length p - -let riLength ri = - match ri.replicas with - Different(rc1, rc2, dir, _) -> - begin match !dir with - Replica1ToReplica2 -> rcLength rc1 rc2 - | Replica2ToReplica1 -> rcLength rc2 rc1 - | Conflict -> Uutil.Filesize.zero - | Merge -> Uutil.Filesize.zero (* underestimate :-*) - end - | _ -> - Uutil.Filesize.zero - -let fileInfos ui1 ui2 = - match ui1, ui2 with - (Updates (File (desc1, ContentsUpdated (fp1, _, ress1)), - Previous (`FILE, desc2, fp2, ress2)), - NoUpdates) - | (Updates (File (desc1, ContentsUpdated (fp1, _, ress1)), - Previous (`FILE, desc2, fp2, ress2)), - Updates (File (_, ContentsSame), _)) - | (NoUpdates, - Updates (File (desc2, ContentsUpdated (fp2, _, ress2)), - Previous (`FILE, desc1, fp1, ress1))) - | (Updates (File (_, ContentsSame), _), - Updates (File (desc2, ContentsUpdated (fp2, _, ress2)), - Previous (`FILE, desc1, fp1, ress1))) - | (Updates (File (desc1, ContentsUpdated (fp1, _, ress1)), _), - Updates (File (desc2, ContentsUpdated (fp2, _, ress2)), _)) -> - (desc1, fp1, ress1, desc2, fp2, ress2) - | _ -> - raise (Util.Transient "Can't diff") - -let problematic ri = - match ri.replicas with - Problem _ -> true - | Different (_,_,d,_) -> (!d = Conflict) - -let isDeletion ri = - match ri.replicas with - Different(rc1, rc2, rDir, _) -> - (match (!rDir, rc1, rc2) with - (Replica1ToReplica2, (`ABSENT, _, _, _), _) -> true - | (Replica2ToReplica1, _, (`ABSENT, _, _, _)) -> true - | _ -> false) - | _ -> false - -let rcType (fi, _, _, _) = - Fileinfo.type2string fi - -let riFileType ri = - match ri.replicas with - Different(rc1, rc2, dir, _) -> - begin match !dir with - Replica2ToReplica1 -> rcType rc2 - | _ -> rcType rc1 - end - | _ -> "nonexistent" Copied: branches/2.32/src/common.ml (from rev 320, trunk/src/common.ml) =================================================================== --- branches/2.32/src/common.ml (rev 0) +++ branches/2.32/src/common.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,218 @@ +(* Unison file synchronizer: src/common.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +type hostname = string + +(* Canonized roots *) +type host = + Local + | Remote of hostname + +type root = host * Fspath.t + +type 'a oneperpath = ONEPERPATH of 'a list + +(* ------------------------------------------------------------------------- *) +(* Printing *) +(* ------------------------------------------------------------------------- *) + +let root2hostname root = + match root with + (Local, _) -> "local" + | (Remote host, _) -> host + +let root2string root = + match root with + (Local, fspath) -> Fspath.toString fspath + | (Remote host, fspath) -> "//"^host^"/"^(Fspath.toString fspath) + +(* ------------------------------------------------------------------------- *) +(* Root comparison *) +(* ------------------------------------------------------------------------- *) + +let compareRoots x y = + match x,y with + (Local,fspath1), (Local,fspath2) -> + (* FIX: This is a path comparison, should it take case + sensitivity into account ? *) + compare (Fspath.toString fspath1) (Fspath.toString fspath2) + | (Local,_), (Remote _,_) -> -1 + | (Remote _,_), (Local,_) -> 1 + | (Remote host1, fspath1), (Remote host2, fspath2) -> + let result = + (* FIX: Should this ALWAYS be a case insensitive compare? *) + compare host1 host2 in + if result = 0 then + (* FIX: This is a path comparison, should it take case + sensitivity into account ? *) + compare (Fspath.toString fspath1) (Fspath.toString fspath2) + else + result + +let sortRoots rootList = Safelist.sort compareRoots rootList + +(* ---------------------------------------------------------------------- *) + +type prevState = + Previous of Fileinfo.typ * Props.t * Os.fullfingerprint * Osx.ressStamp + | New + +type contentschange = + ContentsSame + | ContentsUpdated of Os.fullfingerprint * Fileinfo.stamp * Osx.ressStamp + +type permchange = PropsSame | PropsUpdated + +type updateItem = + NoUpdates (* Path not changed *) + | Updates (* Path changed in this replica *) + of updateContent (* - new state *) + * prevState (* - summary of old state *) + | Error (* Error while detecting updates *) + of string (* - description of error *) + +and updateContent = + Absent (* Path refers to nothing *) + | File (* Path refers to an ordinary file *) + of Props.t (* - summary of current state *) + * contentschange (* - hint to transport agent *) + | Dir (* Path refers to a directory *) + of Props.t (* - summary of current state *) + * (Name.t * updateItem) list (* - children; + MUST KEEP SORTED for recon *) + * permchange (* - did permissions change? *) + * bool (* - is the directory now empty? *) + | Symlink (* Path refers to a symbolic link *) + of string (* - link text *) + +(* ------------------------------------------------------------------------- *) + +type status = + [ `Deleted + | `Modified + | `PropsChanged + | `Created + | `Unchanged ] + +type replicaContent = Fileinfo.typ * status * Props.t * updateItem + +type direction = + Conflict + | Merge + | Replica1ToReplica2 + | Replica2ToReplica1 + +let direction2string = function + Conflict -> "conflict" + | Merge -> "merge" + | Replica1ToReplica2 -> "replica1 to replica2" + | Replica2ToReplica1 -> "replica2 to replica1" + +type replicas = + Problem of string (* There was a problem during update detection *) + | Different (* Replicas differ *) + of replicaContent (* - content of first replica *) + * replicaContent (* - content of second replica *) + * direction ref (* - action to take *) + * direction (* - default action to take *) + +type reconItem = + {path : Path.t; + replicas : replicas} + +let ucLength = function + File(desc,_) -> Props.length desc + | Dir(desc,_,_,_) -> Props.length desc + | _ -> Uutil.Filesize.zero + +let uiLength = function + Updates(uc,_) -> ucLength uc + | _ -> Uutil.Filesize.zero + +let riAction (_, s, _, _) (_, s', _, _) = + match s, s' with + `Deleted, _ -> + `Delete + | (`Unchanged | `PropsChanged), (`Unchanged | `PropsChanged) -> + `SetProps + | _ -> + `Copy + +let rcLength ((_, _, p, _) as rc) rc' = + if riAction rc rc' = `SetProps then + Uutil.Filesize.zero + else + Props.length p + +let riLength ri = + match ri.replicas with + Different(rc1, rc2, dir, _) -> + begin match !dir with + Replica1ToReplica2 -> rcLength rc1 rc2 + | Replica2ToReplica1 -> rcLength rc2 rc1 + | Conflict -> Uutil.Filesize.zero + | Merge -> Uutil.Filesize.zero (* underestimate :-*) + end + | _ -> + Uutil.Filesize.zero + +let fileInfos ui1 ui2 = + match ui1, ui2 with + (Updates (File (desc1, ContentsUpdated (fp1, _, ress1)), + Previous (`FILE, desc2, fp2, ress2)), + NoUpdates) + | (Updates (File (desc1, ContentsUpdated (fp1, _, ress1)), + Previous (`FILE, desc2, fp2, ress2)), + Updates (File (_, ContentsSame), _)) + | (NoUpdates, + Updates (File (desc2, ContentsUpdated (fp2, _, ress2)), + Previous (`FILE, desc1, fp1, ress1))) + | (Updates (File (_, ContentsSame), _), + Updates (File (desc2, ContentsUpdated (fp2, _, ress2)), + Previous (`FILE, desc1, fp1, ress1))) + | (Updates (File (desc1, ContentsUpdated (fp1, _, ress1)), _), + Updates (File (desc2, ContentsUpdated (fp2, _, ress2)), _)) -> + (desc1, fp1, ress1, desc2, fp2, ress2) + | _ -> + raise (Util.Transient "Can't diff") + +let problematic ri = + match ri.replicas with + Problem _ -> true + | Different (_,_,d,_) -> (!d = Conflict) + +let isDeletion ri = + match ri.replicas with + Different(rc1, rc2, rDir, _) -> + (match (!rDir, rc1, rc2) with + (Replica1ToReplica2, (`ABSENT, _, _, _), _) -> true + | (Replica2ToReplica1, _, (`ABSENT, _, _, _)) -> true + | _ -> false) + | _ -> false + +let rcType (fi, _, _, _) = + Fileinfo.type2string fi + +let riFileType ri = + match ri.replicas with + Different(rc1, rc2, dir, _) -> + begin match !dir with + Replica2ToReplica1 -> rcType rc2 + | _ -> rcType rc1 + end + | _ -> "nonexistent" Deleted: branches/2.32/src/common.mli =================================================================== --- trunk/src/common.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/common.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,127 +0,0 @@ -(* Unison file synchronizer: src/common.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(***************************************************************************) -(* COMMON TYPES USED BY ALL MODULES *) -(***************************************************************************) - -type hostname = string - -(* "Canonized" names of hosts *) -type host = - Local - | Remote of string - -(* Roots for replicas (this is the type that is used by most of the code) *) -type root = host * Fspath.t - -val root2string : root -> string - -(* Give a printable hostname from a root (local prints as "local") *) -val root2hostname : root -> hostname - -val compareRoots : root -> root -> int -val sortRoots : root list -> root list -(* Note, local roots come before remote roots *) - -(* There are a number of functions in several modules that accept or return - lists containing one element for each path-to-be-synchronized specified - by the user using the -path option. This type constructor is used - instead of list, to help document their behavior -- in particular, - allowing us to write 'blah list list' as 'blah list oneperpath' in a few - places. *) -type 'a oneperpath = ONEPERPATH of 'a list - - -(*****************************************************************************) -(* COMMON TYPES USED BY UPDATE MODULE AND RECONCILER *) -(*****************************************************************************) - -(* An updateItem describes the difference between the current state of the - filesystem below a given path and the state recorded in the archive below - that path. The other types are helpers. *) - -type prevState = - Previous of Fileinfo.typ * Props.t * Os.fullfingerprint * Osx.ressStamp - | New - -type contentschange = - ContentsSame - | ContentsUpdated of Os.fullfingerprint * Fileinfo.stamp * Osx.ressStamp -type permchange = PropsSame | PropsUpdated - -(* Variable name prefix: "ui" *) -type updateItem = - NoUpdates (* Path not changed *) - | Updates (* Path changed in this replica *) - of updateContent (* - new state *) - * prevState (* - summary of old state *) - | Error (* Error while detecting updates *) - of string (* - description of error *) - -(* Variable name prefix: "uc" *) -and updateContent = - Absent (* Path refers to nothing *) - | File (* Path refers to an ordinary file *) - of Props.t (* - summary of current state *) - * contentschange (* - hint to transport agent *) - | Dir (* Path refers to a directory *) - of Props.t (* - summary of current state *) - * (Name.t * updateItem) list (* - children - MUST KEEP SORTED for recon *) - * permchange (* - did permissions change? *) - * bool (* - is the directory now empty? *) - | Symlink (* Path refers to a symbolic link *) - of string (* - link text *) - - -(*****************************************************************************) -(* COMMON TYPES SHARED BY RECONCILER AND TRANSPORT AGENT *) -(*****************************************************************************) - -type status = - [ `Deleted - | `Modified - | `PropsChanged - | `Created - | `Unchanged ] - -(* Variable name prefix: "rc" *) -type replicaContent = Fileinfo.typ * status * Props.t * updateItem - -type direction = - Conflict - | Merge - | Replica1ToReplica2 - | Replica2ToReplica1 - -val direction2string : direction -> string - -(* Variable name prefix: "rplc" *) -type replicas = - Problem of string (* There was a problem during update detection *) - | Different (* Replicas differ *) - of replicaContent (* - content of first replica *) - * replicaContent (* - content of second replica *) - * direction ref (* - action to take (it's a ref so that the - user interface can change it) *) - * direction (* - default action to take *) - -(* Variable name prefix: "ri" *) -type reconItem = - {path : Path.t; - replicas : replicas} - -val ucLength : updateContent -> Uutil.Filesize.t -val uiLength : updateItem -> Uutil.Filesize.t -val riLength : reconItem -> Uutil.Filesize.t -val riFileType : reconItem -> string -val fileInfos : - updateItem -> updateItem -> - Props.t * Os.fullfingerprint * Osx.ressStamp * - Props.t * Os.fullfingerprint * Osx.ressStamp - -(* True if the ri's type is Problem or if it is Different and the direction - is Conflict *) -val problematic : reconItem -> bool -val isDeletion : reconItem -> bool Copied: branches/2.32/src/common.mli (from rev 320, trunk/src/common.mli) =================================================================== --- branches/2.32/src/common.mli (rev 0) +++ branches/2.32/src/common.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,127 @@ +(* Unison file synchronizer: src/common.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +(***************************************************************************) +(* COMMON TYPES USED BY ALL MODULES *) +(***************************************************************************) + +type hostname = string + +(* "Canonized" names of hosts *) +type host = + Local + | Remote of string + +(* Roots for replicas (this is the type that is used by most of the code) *) +type root = host * Fspath.t + +val root2string : root -> string + +(* Give a printable hostname from a root (local prints as "local") *) +val root2hostname : root -> hostname + +val compareRoots : root -> root -> int +val sortRoots : root list -> root list +(* Note, local roots come before remote roots *) + +(* There are a number of functions in several modules that accept or return + lists containing one element for each path-to-be-synchronized specified + by the user using the -path option. This type constructor is used + instead of list, to help document their behavior -- in particular, + allowing us to write 'blah list list' as 'blah list oneperpath' in a few + places. *) +type 'a oneperpath = ONEPERPATH of 'a list + + +(*****************************************************************************) +(* COMMON TYPES USED BY UPDATE MODULE AND RECONCILER *) +(*****************************************************************************) + +(* An updateItem describes the difference between the current state of the + filesystem below a given path and the state recorded in the archive below + that path. The other types are helpers. *) + +type prevState = + Previous of Fileinfo.typ * Props.t * Os.fullfingerprint * Osx.ressStamp + | New + +type contentschange = + ContentsSame + | ContentsUpdated of Os.fullfingerprint * Fileinfo.stamp * Osx.ressStamp +type permchange = PropsSame | PropsUpdated + +(* Variable name prefix: "ui" *) +type updateItem = + NoUpdates (* Path not changed *) + | Updates (* Path changed in this replica *) + of updateContent (* - new state *) + * prevState (* - summary of old state *) + | Error (* Error while detecting updates *) + of string (* - description of error *) + +(* Variable name prefix: "uc" *) +and updateContent = + Absent (* Path refers to nothing *) + | File (* Path refers to an ordinary file *) + of Props.t (* - summary of current state *) + * contentschange (* - hint to transport agent *) + | Dir (* Path refers to a directory *) + of Props.t (* - summary of current state *) + * (Name.t * updateItem) list (* - children + MUST KEEP SORTED for recon *) + * permchange (* - did permissions change? *) + * bool (* - is the directory now empty? *) + | Symlink (* Path refers to a symbolic link *) + of string (* - link text *) + + +(*****************************************************************************) +(* COMMON TYPES SHARED BY RECONCILER AND TRANSPORT AGENT *) +(*****************************************************************************) + +type status = + [ `Deleted + | `Modified + | `PropsChanged + | `Created + | `Unchanged ] + +(* Variable name prefix: "rc" *) +type replicaContent = Fileinfo.typ * status * Props.t * updateItem + +type direction = + Conflict + | Merge + | Replica1ToReplica2 + | Replica2ToReplica1 + +val direction2string : direction -> string + +(* Variable name prefix: "rplc" *) +type replicas = + Problem of string (* There was a problem during update detection *) + | Different (* Replicas differ *) + of replicaContent (* - content of first replica *) + * replicaContent (* - content of second replica *) + * direction ref (* - action to take (it's a ref so that the + user interface can change it) *) + * direction (* - default action to take *) + +(* Variable name prefix: "ri" *) +type reconItem = + {path : Path.t; + replicas : replicas} + +val ucLength : updateContent -> Uutil.Filesize.t +val uiLength : updateItem -> Uutil.Filesize.t +val riLength : reconItem -> Uutil.Filesize.t +val riFileType : reconItem -> string +val fileInfos : + updateItem -> updateItem -> + Props.t * Os.fullfingerprint * Osx.ressStamp * + Props.t * Os.fullfingerprint * Osx.ressStamp + +(* True if the ri's type is Problem or if it is Different and the direction + is Conflict *) +val problematic : reconItem -> bool +val isDeletion : reconItem -> bool Deleted: branches/2.32/src/copy.ml =================================================================== --- trunk/src/copy.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/copy.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,703 +0,0 @@ -(* Unison file synchronizer: src/copy.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -let (>>=) = Lwt.bind - -let debug = Trace.debug "copy" - -(****) - -let openFileIn fspath path kind = - match kind with - `DATA -> open_in_gen [Open_rdonly; Open_binary] 0o444 - (Fspath.concatToString fspath path) - | `RESS _ -> Osx.openRessIn fspath path - -let openFileOut fspath path kind = - match kind with - `DATA -> - let fullpath = Fspath.concatToString fspath path in - let flags = [Unix.O_WRONLY;Unix.O_CREAT] in - let perm = 0o600 in - begin match Util.osType with - `Win32 -> - open_out_gen - [Open_wronly; Open_creat; Open_excl; Open_binary] perm fullpath - | `Unix -> - let fd = - try - Unix.openfile fullpath (Unix.O_EXCL :: flags) perm - with - Unix.Unix_error - ((Unix.EOPNOTSUPP | Unix.EUNKNOWNERR 524), _, _) -> - (* O_EXCL not supported under a Netware NFS-mounted filesystem. - Solaris and Linux report different errors. *) - Unix.openfile fullpath (Unix.O_TRUNC :: flags) perm - in - Unix.out_channel_of_descr fd - end - | `RESS len -> - Osx.openRessOut fspath path len - -let protect f g = - try - f () - with Sys_error _ | Unix.Unix_error _ | Util.Transient _ as e -> - begin try g () with Sys_error _ | Unix.Unix_error _ -> () end; - raise e - -let lwt_protect f g = - Lwt.catch f - (fun e -> - begin match e with - Sys_error _ | Unix.Unix_error _ | Util.Transient _ -> - begin try g () with Sys_error _ | Unix.Unix_error _ -> () end - | _ -> - () - end; - Lwt.fail e) - -(****) - -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.toString fspathFrom) (Path.toString pathFrom) - (Fspath.toString fspathTo) (Path.toString pathTo)); - let inFd = openFileIn fspathFrom pathFrom `DATA in - protect (fun () -> - Os.delete fspathTo pathTo; - let outFd = openFileOut fspathTo pathTo `DATA in - protect (fun () -> - Uutil.readWrite inFd outFd - (fun l -> - use_id ( fun id -> - Abort.check id; - Uutil.showProgress id (Uutil.Filesize.ofInt l) "l")); - close_in inFd; - close_out outFd) - (fun () -> close_out_noerr outFd)) - (fun () -> close_in_noerr inFd); - if ressLength > Uutil.Filesize.zero then begin - let inFd = openFileIn fspathFrom pathFrom (`RESS ressLength) in - protect (fun () -> - let outFd = openFileOut fspathTo pathTo (`RESS ressLength) in - protect (fun () -> - Uutil.readWriteBounded inFd outFd ressLength - (fun l -> - use_id (fun id -> - Abort.check id; - Uutil.showProgress id (Uutil.Filesize.ofInt l) "l")); - close_in inFd; - close_out outFd) - (fun () -> close_out_noerr outFd)) - (fun () -> close_in_noerr inFd); - end; - match update with - `Update _ -> - Fileinfo.set fspathTo pathTo (`Copy realPathTo) desc - | `Copy -> - Fileinfo.set fspathTo pathTo (`Set Props.fileDefault) desc) - -(****) - -(* The file transfer functions here depend on an external module - 'transfer' that implements a generic transmission and the rsync - algorithm for optimizing the file transfer in the case where a - similar file already exists on the target. *) - -let rsyncActivated = - Prefs.createBool "rsync" true - "!activate the rsync transfer mode" - ("Unison uses the 'rsync algorithm' for 'diffs-only' transfer " - ^ "of updates to large files. Setting this flag to false makes Unison " - ^ "use whole-file transfers instead. Under normal circumstances, " - ^ "there is no reason to do this, but if you are having trouble with " - ^ "repeated 'rsync failure' errors, setting it to " - ^ "false should permit you to synchronize the offending files.") - -(* Lazy creation of the destination file *) -let destinationFd fspath path kind outfd = - match !outfd with - None -> - let fd = openFileOut fspath path kind in - outfd := Some fd; - fd - | Some fd -> - fd - -let decompressor = ref Remote.MsgIdMap.empty - -let startReceivingFile - fspath path realPath fileKind update srcFileSize id file_id = - (* We delay the opening of the file so that there are not too many - temporary files remaining after a crash *) - let outfd = ref None in - let showProgress count = - Abort.check id; - Uutil.showProgress id (Uutil.Filesize.ofInt count) "r" in - (* Install a simple generic decompressor *) - decompressor := - Remote.MsgIdMap.add file_id - (fun ti -> - let fd = destinationFd fspath path fileKind outfd in - Transfer.receive fd showProgress ti) - !decompressor; - if Prefs.read rsyncActivated then begin - match update with - `Update (destFileDataSize, destFileRessSize) - when let destFileSize = - match fileKind with - `DATA -> destFileDataSize - | `RESS _ -> destFileRessSize - in - Transfer.Rsync.aboveRsyncThreshold destFileSize - && Transfer.Rsync.aboveRsyncThreshold srcFileSize -> - Util.convertUnixErrorsToTransient - "preprocessing file" - (fun () -> - let infd = openFileIn fspath realPath fileKind in - (* Now that we've successfully opened the original version - of the file, install a more interesting decompressor *) - decompressor := - Remote.MsgIdMap.add file_id - (fun ti -> - let fd = destinationFd fspath path fileKind outfd in - Transfer.Rsync.rsyncDecompress infd fd showProgress ti) - !decompressor; - let bi = - protect (fun () -> Transfer.Rsync.rsyncPreprocess infd) - (fun () -> close_in_noerr infd) - in - let (firstBi, remBi) = - match bi with - [] -> assert false - | firstBi :: remBi -> (firstBi, remBi) - in - Lwt.return (outfd, ref (Some infd), Some firstBi, remBi)) - | _ -> - Lwt.return (outfd, ref None, None, []) - end else - Lwt.return (outfd, ref None, None, []) - -let processTransferInstruction conn (file_id, ti) = - Util.convertUnixErrorsToTransient - "processing a transfer instruction" - (fun () -> - ignore (Remote.MsgIdMap.find file_id !decompressor ti)); - Lwt.return () - -let marshalTransferInstruction = - (fun (file_id, (data, pos, len)) rem -> - ((Remote.encodeInt file_id, 0, 4) :: (data, pos, len) :: rem, len + 4)), - (fun buf pos -> - let len = String.length buf - pos - 4 in - (Remote.decodeInt (String.sub buf pos 4), (buf, pos + 4, len))) - -let processTransferInstructionRemotely = - Remote.registerSpecialServerCmd - "processTransferInstruction" marshalTransferInstruction - Remote.defaultMarshalingFunctions processTransferInstruction - -let blockInfos = ref Remote.MsgIdMap.empty - -let compress conn - (biOpt, fspathFrom, pathFrom, fileKind, sizeFrom, id, file_id) = - Lwt.catch - (fun () -> - let infd = openFileIn fspathFrom pathFrom fileKind in - lwt_protect (fun () -> - let showProgress count = - Abort.check id; - Uutil.showProgress id (Uutil.Filesize.ofInt count) "r" in - let compr = - match biOpt with - None -> Transfer.send infd sizeFrom showProgress - | Some bi -> let remBi = - try - Remote.MsgIdMap.find file_id !blockInfos - with Not_found -> - [] - in - let bi = bi :: remBi in - blockInfos := - Remote.MsgIdMap.remove file_id !blockInfos; - Transfer.Rsync.rsyncCompress - bi infd sizeFrom showProgress - in - compr - (fun ti -> processTransferInstructionRemotely conn (file_id, ti)) - >>= (fun () -> - close_in infd; - Lwt.return ())) - (fun () -> - close_in_noerr infd)) - (fun e -> - Util.convertUnixErrorsToTransient - "rsync sender" (fun () -> raise e)) - -let compressRemotely = Remote.registerServerCmd "compress" compress - -let receiveRemBiLocally _ (file_id, bi) = - let bil = - try - Remote.MsgIdMap.find file_id !blockInfos - with Not_found -> - [] - in - blockInfos := Remote.MsgIdMap.add file_id (bi :: bil) !blockInfos; - Lwt.return () - -let receiveRemBi = Remote.registerServerCmd "receiveRemBi" receiveRemBiLocally -let rec sendRemBi conn file_id remBi = - match remBi with - [] -> Lwt.return () - | x :: r -> sendRemBi conn file_id r >>= (fun () -> - receiveRemBi conn (file_id, x)) - -(****) - -let fileSize (fspath, path) = - Util.convertUnixErrorsToTransient - "getting file size" - (fun () -> - Lwt.return - (Props.length (Fileinfo.get false fspath path).Fileinfo.desc)) - -let fileSizeOnHost = - Remote.registerServerCmd "fileSize" (fun _ -> fileSize) - -(****) - -(* We limit the size of the output buffers to about 512 KB - (we cannot go above the limit below plus 64) *) -let transferFileReg = Lwt_util.make_region 440 - -let bufferSize sz = - min 64 ((truncate (Uutil.Filesize.toFloat sz) + 1023) / 1024) - (* Token queue *) - + - 8 (* Read buffer *) - -(****) - -let close_all infd outfd = - Util.convertUnixErrorsToTransient - "closing files" - (fun () -> - begin match !infd with - Some fd -> close_in fd; infd := None - | None -> () - end; - begin match !outfd with - Some fd -> close_out fd; outfd := None - | None -> () - end) - -let close_all_no_error infd outfd = - begin match !infd with - Some fd -> close_in_noerr fd - | None -> () - end; - begin match !outfd with - Some fd -> close_out_noerr fd - | None -> () - end - -(* The ressOnly flag tells reallyTransferFile to skip transferring - the data fork (which has already been taken care of by some external - utility) and just transfer the resource fork (which external utilities - are not necessarily good at). *) -let reallyTransferFile - connFrom fspathFrom pathFrom fspathTo pathTo realPathTo - update desc ressLength ressOnly id = - debug (fun() -> Util.msg "reallyTransferFile(%s,%s) -> (%s,%s,%s,%s)%s\n" - (Fspath.toString fspathFrom) (Path.toString pathFrom) - (Fspath.toString fspathTo) (Path.toString pathTo) - (Path.toString realPathTo) (Props.toString desc) - (if ressOnly then " (ONLY RESOURCE FORK)" else "")); - let srcFileSize = Props.length desc in - let file_id = Remote.newMsgId () in - - (if ressOnly then - (* Skip data fork *) - Lwt.return () - else begin - (* Data fork *) - if Os.exists fspathTo pathTo then begin - debug (fun() -> Util.msg "Removing old temp file %s / %s\n" - (Fspath.toString fspathTo) (Path.toString pathTo)); - Os.delete fspathTo pathTo - end; - startReceivingFile - fspathTo pathTo realPathTo `DATA update srcFileSize id file_id - >>= (fun (outfd, infd, firstBi, remBi) -> - Lwt.catch (fun () -> - Uutil.showProgress id Uutil.Filesize.zero "f"; - sendRemBi connFrom file_id remBi >>= (fun () -> - compressRemotely connFrom - (firstBi, - fspathFrom, pathFrom, `DATA, srcFileSize, id, file_id) - >>= (fun () -> - decompressor := - Remote.MsgIdMap.remove file_id !decompressor; (* For GC *) - close_all infd outfd; - Lwt.return ()))) - (* catch handler *) - (fun e -> - decompressor := - Remote.MsgIdMap.remove file_id !decompressor; (* For GC *) - close_all_no_error infd outfd; - Lwt.fail e) - )end) >>= (fun () -> - - (* Resource fork *) - (if ressLength > Uutil.Filesize.zero then begin - startReceivingFile - fspathTo pathTo realPathTo - (`RESS ressLength) update ressLength id file_id - >>= (fun (outfd, infd, firstBi, remBi) -> - Lwt.catch (fun () -> - Uutil.showProgress id Uutil.Filesize.zero "f"; - sendRemBi connFrom file_id remBi >>= (fun () -> - compressRemotely connFrom - (firstBi, fspathFrom, pathFrom, - `RESS ressLength, ressLength, id, file_id) - >>= (fun () -> - decompressor := - Remote.MsgIdMap.remove file_id !decompressor; (* For GC *) - close_all infd outfd; - Lwt.return ()))) - (fun e -> - decompressor := - Remote.MsgIdMap.remove file_id !decompressor; (* For GC *) - close_all_no_error infd outfd; - Lwt.fail e)) - end else - Lwt.return ()) >>= (fun () -> - begin match update with - `Update _ -> Fileinfo.set fspathTo pathTo (`Copy realPathTo) desc - | `Copy -> Fileinfo.set fspathTo pathTo (`Set Props.fileDefault) desc - end; - Lwt.return ())) - -(****) - -(* BCP '06: This is a hack to work around a bug on the Windows platform - that causes lightweight threads on the server to hang. I conjecture that - the problem has to do with the RPC mechanism, which was used here to - make a call *back* from the server to the client inside Trace.log so that - the log message would be appended to the log file on the client. *) -(* BCP '08: Jerome thinks that printing these messages using Util.msg - may be causing the dreaded "assertion failure in remote.ml," which - happens only on windows and seems correlated with the xferbycopying - switch. The conjecture is that some windows ssh servers may combine - the stdout and stderr streams, which would result in these messages - getting interleaved with Unison's RPC protocol stream. *) -let loggit s = - if Prefs.read Globals.someHostIsRunningWindows - then () (* Util.msg "%s" *) - else Trace.log s - -let tryCopyMovedFile fspathTo pathTo realPathTo update desc fp ress id = - Prefs.read Xferhint.xferbycopying - && - begin - Util.convertUnixErrorsToTransient "tryCopyMovedFile" (fun() -> - debug (fun () -> Util.msg "tryCopyMovedFile: -> %s /%s/\n" - (Path.toString pathTo) (Os.fullfingerprint_to_string fp)); - match Xferhint.lookup fp with - None -> - false - | Some (candidateFspath, candidatePath) -> - loggit (Printf.sprintf - "Shortcut: copying %s from local file %s\n" - (Path.toString realPathTo) - (Path.toString candidatePath)); - debug (fun () -> - Util.msg - "tryCopyMovedFile: found match at %s,%s. Try local copying\n" - (Fspath.toString candidateFspath) - (Path.toString candidatePath)); - try - if Os.exists candidateFspath candidatePath then begin - localFile - candidateFspath candidatePath fspathTo pathTo realPathTo - update desc (Osx.ressLength ress) (Some id); - let info = Fileinfo.get false fspathTo pathTo in - let fp' = Os.fingerprint fspathTo pathTo info in - if fp' = fp then begin - debug (fun () -> Util.msg "tryCopyMoveFile: success.\n"); - Xferhint.insertEntry (fspathTo, pathTo) fp; - true - end else begin - debug (fun () -> - Util.msg "tryCopyMoveFile: candidate file modified!"); - Xferhint.deleteEntry (candidateFspath, candidatePath); - Os.delete fspathTo pathTo; - loggit (Printf.sprintf - "Shortcut didn't work because %s was modified\n" - (Path.toString candidatePath)); - false - end - end else begin - loggit (Printf.sprintf - "Shortcut didn't work because %s disappeared!\n" - (Path.toString candidatePath)); - Xferhint.deleteEntry (candidateFspath, candidatePath); - false - end - with - Util.Transient s -> - debug (fun () -> - Util.msg "tryCopyMovedFile: local copy didn't work [%s]" s); - Xferhint.deleteEntry (candidateFspath, candidatePath); - Os.delete fspathTo pathTo; - loggit (Printf.sprintf - "Local copy of %s failed\n" - (Path.toString candidatePath)); - false) - end - -let transferFileLocal connFrom - (fspathFrom, pathFrom, fspathTo, pathTo, realPathTo, - update, desc, fp, ress, ressOnly, id) = - if (not ressOnly) - && tryCopyMovedFile fspathTo pathTo realPathTo update desc fp ress id - then Lwt.return () - else reallyTransferFile - connFrom fspathFrom pathFrom fspathTo pathTo realPathTo - update desc (Osx.ressLength ress) ressOnly id - -let transferFileOnRoot = - Remote.registerRootCmdWithConnection "transferFile" transferFileLocal - -let transferFile - rootFrom pathFrom rootTo fspathTo pathTo realPathTo - update desc fp ress ressOnly id = - let bufSz = bufferSize (max (Props.length desc) (Osx.ressLength ress)) in - (* This must be on the client: any lock on the server side may result - in a deadlock under windows *) - Lwt_util.run_in_region transferFileReg bufSz (fun () -> - Abort.check id; - transferFileOnRoot rootTo rootFrom - (snd rootFrom, pathFrom, fspathTo, pathTo, realPathTo, - update, desc, fp, ress, ressOnly, id)) - -(****) - -let copyprog = - Prefs.createString "copyprog" "rsync --inplace --compress" - "!external program for copying large files" - ("A string giving the name of an " - ^ "external program that can be used to copy large files efficiently " - ^ "(plus command-line switches telling it to copy files in-place). " - ^ "The default setting invokes {\\tt rsync} with appropriate " - ^ "options---most users should not need to change it.") - -let copyprogrest = - Prefs.createString "copyprogrest" "rsync --partial --inplace --compress" - "!variant of copyprog for resuming partial transfers" - ("A variant of {\\tt copyprog} that names an external program " - ^ "that should be used to continue the transfer of a large file " - ^ "that has already been partially transferred. Typically, " - ^ "{\\tt copyprogrest} will just be {\\tt copyprog} " - ^ "with one extra option (e.g., {\\tt --partial}, for rsync). " - ^ "The default setting invokes {\\tt rsync} with appropriate " - ^ "options---most users should not need to change it.") - -let copythreshold = - Prefs.createInt "copythreshold" (-1) - "!use copyprog on files bigger than this (if >=0, in Kb)" - ("A number indicating above what filesize (in kilobytes) Unison should " - ^ "use the external " - ^ "copying utility specified by {\\tt copyprog}. Specifying 0 will cause " - ^ "{\\em all} copies to use the external program; " - ^ "a negative number will prevent any files from using it. " - ^ "The default is -1. " - ^ "See \\sectionref{speeding}{Making Unison Faster on Large Files} " - ^ "for more information.") - -let copyquoterem = - Prefs.createString "copyquoterem" "default" - "!add quotes to remote file name for copyprog (true/false/default)" - ("When set to {\\tt true}, this flag causes Unison to add an extra layer " - ^ "of quotes to the remote path passed to the external copy program. " - ^ "This is needed by rsync, for example, which internally uses an ssh " - ^ "connection requiring an extra level of quoting for paths containing " - ^ "spaces. When this flag is set to {\\tt default}, extra quotes are " - ^ "added if the value of {\\tt copyprog} contains the string " - ^ "{\\tt rsync}.") - -let tryCopyMovedFileLocal connFrom - (fspathTo, pathTo, realPathTo, update, desc, fp, ress, id) = - Lwt.return (tryCopyMovedFile fspathTo pathTo realPathTo update desc fp ress id) -let tryCopyMovedFileOnRoot = - Remote.registerRootCmdWithConnection "tryCopyMovedFile" tryCopyMovedFileLocal - -let setFileinfoLocal connFrom (fspathTo, pathTo, desc) = - Lwt.return (Fileinfo.set fspathTo pathTo (`Set Props.fileDefault) desc) -let setFileinfoOnRoot = - Remote.registerRootCmdWithConnection "setFileinfo" setFileinfoLocal - -let targetExists checkSize fspathTo pathTo = - Os.exists fspathTo pathTo - && (match checkSize with - `MakeWriteableAndCheckNonempty -> - let n = Fspath.concatToString fspathTo pathTo in - let perms = (Unix.stat n).Unix.st_perm in - let perms' = perms lor 0o600 in - Unix.chmod n perms'; - let r = - Props.length (Fileinfo.get false fspathTo pathTo).Fileinfo.desc - > Uutil.Filesize.zero in - r - | `CheckDataSize desc -> - Props.length (Fileinfo.get false fspathTo pathTo).Fileinfo.desc - = Props.length desc - | `CheckSize (desc,ress) -> - Props.length (Fileinfo.get false fspathTo pathTo).Fileinfo.desc - = Props.length desc - && Osx.ressLength (Osx.getFileInfos fspathTo pathTo `FILE).Osx.ressInfo - = Osx.ressLength ress) - -let targetExistsLocal connFrom (checkSize, fspathTo, pathTo) = - Lwt.return (targetExists checkSize fspathTo pathTo) -let targetExistsOnRoot = - Remote.registerRootCmdWithConnection - "targetExists" targetExistsLocal - -let formatConnectionInfo root = - match root with - Common.Local, _ -> "" - | Common.Remote h, _ -> - (* Find the (unique) nonlocal root *) - match - Safelist.find (function Clroot.ConnectLocal _ -> false | _ -> true) - (Safelist.map Clroot.parseRoot (Globals.rawRoots())) - with - Clroot.ConnectByShell (_,rawhost,uo,_,_) -> - (match uo with None -> "" | Some u -> u ^ "@") - ^ rawhost ^ ":" - (* Note that we don't do anything with the port -- hopefully - this will not affect many people. If we did want to include it, - we'd have to fiddle with the rsync parameters in a slightly - deeper way. *) - | Clroot.ConnectBySocket (h',_,_) -> - h ^ ":" - | Clroot.ConnectLocal _ -> assert false - -let transferFileUsingExternalCopyprog - rootFrom pathFrom rootTo fspathTo pathTo realPathTo - update desc fp ress id = - tryCopyMovedFileOnRoot rootTo rootFrom - (fspathTo, pathTo, realPathTo, update, desc, fp, ress, id) - >>= (fun b -> - if b then Lwt.return () - else begin - Uutil.showProgress id Uutil.Filesize.zero "ext"; - targetExistsOnRoot - rootTo rootFrom (`MakeWriteableAndCheckNonempty, fspathTo, pathTo) >>= (fun b -> - let prog = - if b - then Prefs.read copyprogrest - else Prefs.read copyprog in - let extraquotes = Prefs.read copyquoterem = "true" - || ( Prefs.read copyquoterem = "default" - && Util.findsubstring "rsync" prog <> None) in - let addquotes root s = - match root with - | Common.Local, _ -> s - | Common.Remote _, _ -> if extraquotes then Os.quotes s else s in - let fromSpec = - (formatConnectionInfo rootFrom) - ^ (addquotes rootFrom (Fspath.concatToString (snd rootFrom) pathFrom)) in - let toSpec = - (formatConnectionInfo rootTo) - ^ (addquotes rootTo (Fspath.concatToString fspathTo pathTo)) in - let cmd = prog ^ " " - ^ (Os.quotes fromSpec) ^ " " - ^ (Os.quotes toSpec) in - Trace.log (Printf.sprintf "%s\n" cmd); - let _,log = External.runExternalProgram cmd in - debug (fun() -> - let l = Util.trimWhitespace log in - Util.msg "transferFileUsingExternalCopyprog %s: returned...\n%s%s" - (Path.toString pathFrom) - l (if l="" then "" else "\n")); - targetExistsOnRoot - rootTo rootFrom (`CheckDataSize desc, fspathTo, pathTo) - >>= (fun b -> - if not b then - raise (Util.Transient (Printf.sprintf - "External copy program did not create target file (or bad length): %s" - (Path.toString pathTo))); - Uutil.showProgress id (Props.length desc) "ext"; - Lwt.return ())) - end) - -let file rootFrom pathFrom rootTo fspathTo pathTo realPathTo - update desc fp ress id = - debug (fun() -> Util.msg "copyRegFile(%s,%s) -> (%s,%s,%s,%s,%s)\n" - (Common.root2string rootFrom) (Path.toString pathFrom) - (Common.root2string rootTo) (Path.toString realPathTo) - (Fspath.toString fspathTo) (Path.toString pathTo) - (Props.toString desc)); - let timer = Trace.startTimer "Transmitting file" in - begin match rootFrom, rootTo with - (Common.Local, fspathFrom), (Common.Local, realFspathTo) -> - localFile - fspathFrom pathFrom fspathTo pathTo realPathTo - update desc (Osx.ressLength ress) (Some id); - Lwt.return () - | _ -> - (* Check whether we actually need to copy the file (or whether it - already exists from some interrupted previous transfer) *) - targetExistsOnRoot - rootTo rootFrom (`CheckSize (desc,ress), fspathTo, pathTo) >>= (fun b -> - if b then begin - Trace.log (Printf.sprintf - "%s/%s has already been transferred\n" - (Fspath.toString fspathTo) (Path.toString pathTo)); - Lwt.return () - (* Check whether we should use an external program to copy the - file *) - end else if - Prefs.read copyprog <> "" - && Prefs.read copythreshold >= 0 - && Props.length desc >= Uutil.Filesize.ofInt64 (Int64.of_int 1) - && Props.length desc >= - Uutil.Filesize.ofInt64 - (Int64.mul (Int64.of_int 1000) - (Int64.of_int (Prefs.read copythreshold))) - && update = `Copy - then begin - (* First use the external program to copy the data fork *) - transferFileUsingExternalCopyprog - rootFrom pathFrom rootTo fspathTo pathTo realPathTo - update desc fp ress id >>= (fun () -> - (* Now use the regular transport mechanism to copy the resource - fork *) - begin if (Osx.ressLength ress) > Uutil.Filesize.zero then begin - transferFile - rootFrom pathFrom rootTo fspathTo pathTo realPathTo - update desc fp ress true id - end else Lwt.return () - end >>= (fun() -> - (* Finally, set the file info *) - setFileinfoOnRoot rootTo rootFrom (fspathTo, pathTo, desc))) - end else - (* Just transfer the file in the usual way with Unison's - built-in facilities *) - transferFile - rootFrom pathFrom rootTo fspathTo pathTo realPathTo - update desc fp ress false id - ) end >>= (fun () -> - Trace.showTimer timer; - Lwt.return ()) Copied: branches/2.32/src/copy.ml (from rev 320, trunk/src/copy.ml) =================================================================== --- branches/2.32/src/copy.ml (rev 0) +++ branches/2.32/src/copy.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,718 @@ +(* Unison file synchronizer: src/copy.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +let (>>=) = Lwt.bind + +let debug = Trace.debug "copy" + +(****) + +let openFileIn fspath path kind = + match kind with + `DATA -> open_in_gen [Open_rdonly; Open_binary] 0o444 + (Fspath.concatToString fspath path) + | `RESS _ -> Osx.openRessIn fspath path + +let openFileOut fspath path kind = + match kind with + `DATA -> + let fullpath = Fspath.concatToString fspath path in + let flags = [Unix.O_WRONLY;Unix.O_CREAT] in + let perm = 0o600 in + begin match Util.osType with + `Win32 -> + open_out_gen + [Open_wronly; Open_creat; Open_excl; Open_binary] perm fullpath + | `Unix -> + let fd = + try + Unix.openfile fullpath (Unix.O_EXCL :: flags) perm + with + Unix.Unix_error + ((Unix.EOPNOTSUPP | Unix.EUNKNOWNERR 524), _, _) -> + (* O_EXCL not supported under a Netware NFS-mounted filesystem. + Solaris and Linux report different errors. *) + Unix.openfile fullpath (Unix.O_TRUNC :: flags) perm + in + Unix.out_channel_of_descr fd + end + | `RESS len -> + Osx.openRessOut fspath path len + +let protect f g = + try + f () + with Sys_error _ | Unix.Unix_error _ | Util.Transient _ as e -> + begin try g () with Sys_error _ | Unix.Unix_error _ -> () end; + raise e + +let lwt_protect f g = + Lwt.catch f + (fun e -> + begin match e with + Sys_error _ | Unix.Unix_error _ | Util.Transient _ -> + begin try g () with Sys_error _ | Unix.Unix_error _ -> () end + | _ -> + () + end; + Lwt.fail e) + +(****) + +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.toString fspathFrom) (Path.toString pathFrom) + (Fspath.toString fspathTo) (Path.toString pathTo)); + let inFd = openFileIn fspathFrom pathFrom `DATA in + protect (fun () -> + Os.delete fspathTo pathTo; + let outFd = openFileOut fspathTo pathTo `DATA in + protect (fun () -> + Uutil.readWrite inFd outFd + (fun l -> + use_id ( fun id -> + Abort.check id; + Uutil.showProgress id (Uutil.Filesize.ofInt l) "l")); + close_in inFd; + close_out outFd) + (fun () -> close_out_noerr outFd)) + (fun () -> close_in_noerr inFd); + if ressLength > Uutil.Filesize.zero then begin + let inFd = openFileIn fspathFrom pathFrom (`RESS ressLength) in + protect (fun () -> + let outFd = openFileOut fspathTo pathTo (`RESS ressLength) in + protect (fun () -> + Uutil.readWriteBounded inFd outFd ressLength + (fun l -> + use_id (fun id -> + Abort.check id; + Uutil.showProgress id (Uutil.Filesize.ofInt l) "l")); + close_in inFd; + close_out outFd) + (fun () -> close_out_noerr outFd)) + (fun () -> close_in_noerr inFd); + end; + match update with + `Update _ -> + Fileinfo.set fspathTo pathTo (`Copy realPathTo) desc + | `Copy -> + Fileinfo.set fspathTo pathTo (`Set Props.fileDefault) desc) + +(****) + +(* The file transfer functions here depend on an external module + 'transfer' that implements a generic transmission and the rsync + algorithm for optimizing the file transfer in the case where a + similar file already exists on the target. *) + +let rsyncActivated = + Prefs.createBool "rsync" true + "!activate the rsync transfer mode" + ("Unison uses the 'rsync algorithm' for 'diffs-only' transfer " + ^ "of updates to large files. Setting this flag to false makes Unison " + ^ "use whole-file transfers instead. Under normal circumstances, " + ^ "there is no reason to do this, but if you are having trouble with " + ^ "repeated 'rsync failure' errors, setting it to " + ^ "false should permit you to synchronize the offending files.") + +(* Lazy creation of the destination file *) +let destinationFd fspath path kind outfd = + match !outfd with + None -> + let fd = openFileOut fspath path kind in + outfd := Some fd; + fd + | Some fd -> + fd + +let decompressor = ref Remote.MsgIdMap.empty + +let startReceivingFile + fspath path realPath fileKind update srcFileSize id file_id = + (* We delay the opening of the file so that there are not too many + temporary files remaining after a crash *) + let outfd = ref None in + let showProgress count = + Abort.check id; + Uutil.showProgress id (Uutil.Filesize.ofInt count) "r" in + (* Install a simple generic decompressor *) + decompressor := + Remote.MsgIdMap.add file_id + (fun ti -> + let fd = destinationFd fspath path fileKind outfd in + Transfer.receive fd showProgress ti) + !decompressor; + if Prefs.read rsyncActivated then begin + match update with + `Update (destFileDataSize, destFileRessSize) + when let destFileSize = + match fileKind with + `DATA -> destFileDataSize + | `RESS _ -> destFileRessSize + in + Transfer.Rsync.aboveRsyncThreshold destFileSize + && Transfer.Rsync.aboveRsyncThreshold srcFileSize -> + Util.convertUnixErrorsToTransient + "preprocessing file" + (fun () -> + let infd = openFileIn fspath realPath fileKind in + (* Now that we've successfully opened the original version + of the file, install a more interesting decompressor *) + decompressor := + Remote.MsgIdMap.add file_id + (fun ti -> + let fd = destinationFd fspath path fileKind outfd in + Transfer.Rsync.rsyncDecompress infd fd showProgress ti) + !decompressor; + let bi = + protect (fun () -> Transfer.Rsync.rsyncPreprocess infd) + (fun () -> close_in_noerr infd) + in + let (firstBi, remBi) = + match bi with + [] -> assert false + | firstBi :: remBi -> (firstBi, remBi) + in + Lwt.return (outfd, ref (Some infd), Some firstBi, remBi)) + | _ -> + Lwt.return (outfd, ref None, None, []) + end else + Lwt.return (outfd, ref None, None, []) + +let processTransferInstruction conn (file_id, ti) = + Util.convertUnixErrorsToTransient + "processing a transfer instruction" + (fun () -> + ignore (Remote.MsgIdMap.find file_id !decompressor ti)); + Lwt.return () + +let marshalTransferInstruction = + (fun (file_id, (data, pos, len)) rem -> + ((Remote.encodeInt file_id, 0, 4) :: (data, pos, len) :: rem, len + 4)), + (fun buf pos -> + let len = String.length buf - pos - 4 in + (Remote.decodeInt (String.sub buf pos 4), (buf, pos + 4, len))) + +let processTransferInstructionRemotely = + Remote.registerSpecialServerCmd + "processTransferInstruction" marshalTransferInstruction + Remote.defaultMarshalingFunctions processTransferInstruction + +let blockInfos = ref Remote.MsgIdMap.empty + +let compress conn + (biOpt, fspathFrom, pathFrom, fileKind, sizeFrom, id, file_id) = + Lwt.catch + (fun () -> + let infd = openFileIn fspathFrom pathFrom fileKind in + lwt_protect (fun () -> + let showProgress count = + Abort.check id; + Uutil.showProgress id (Uutil.Filesize.ofInt count) "r" in + let compr = + match biOpt with + None -> Transfer.send infd sizeFrom showProgress + | Some bi -> let remBi = + try + Remote.MsgIdMap.find file_id !blockInfos + with Not_found -> + [] + in + let bi = bi :: remBi in + blockInfos := + Remote.MsgIdMap.remove file_id !blockInfos; + Transfer.Rsync.rsyncCompress + bi infd sizeFrom showProgress + in + compr + (fun ti -> processTransferInstructionRemotely conn (file_id, ti)) + >>= (fun () -> + close_in infd; + Lwt.return ())) + (fun () -> + close_in_noerr infd)) + (fun e -> + Util.convertUnixErrorsToTransient + "rsync sender" (fun () -> raise e)) + +let compressRemotely = Remote.registerServerCmd "compress" compress + +let receiveRemBiLocally _ (file_id, bi) = + let bil = + try + Remote.MsgIdMap.find file_id !blockInfos + with Not_found -> + [] + in + blockInfos := Remote.MsgIdMap.add file_id (bi :: bil) !blockInfos; + Lwt.return () + +let receiveRemBi = Remote.registerServerCmd "receiveRemBi" receiveRemBiLocally +let rec sendRemBi conn file_id remBi = + match remBi with + [] -> Lwt.return () + | x :: r -> sendRemBi conn file_id r >>= (fun () -> + receiveRemBi conn (file_id, x)) + +(****) + +let fileSize (fspath, path) = + Util.convertUnixErrorsToTransient + "getting file size" + (fun () -> + Lwt.return + (Props.length (Fileinfo.get false fspath path).Fileinfo.desc)) + +let fileSizeOnHost = + Remote.registerServerCmd "fileSize" (fun _ -> fileSize) + +(****) + +(* We limit the size of the output buffers to about 512 KB + (we cannot go above the limit below plus 64) *) +let transferFileReg = Lwt_util.make_region 440 + +let bufferSize sz = + min 64 ((truncate (Uutil.Filesize.toFloat sz) + 1023) / 1024) + (* Token queue *) + + + 8 (* Read buffer *) + +(****) + +let close_all infd outfd = + Util.convertUnixErrorsToTransient + "closing files" + (fun () -> + begin match !infd with + Some fd -> close_in fd; infd := None + | None -> () + end; + begin match !outfd with + Some fd -> close_out fd; outfd := None + | None -> () + end) + +let close_all_no_error infd outfd = + begin match !infd with + Some fd -> close_in_noerr fd + | None -> () + end; + begin match !outfd with + Some fd -> close_out_noerr fd + | None -> () + end + +(* The ressOnly flag tells reallyTransferFile to skip transferring + the data fork (which has already been taken care of by some external + utility) and just transfer the resource fork (which external utilities + are not necessarily good at). *) +let reallyTransferFile + connFrom fspathFrom pathFrom fspathTo pathTo realPathTo + update desc ressLength ressOnly id = + debug (fun() -> Util.msg "reallyTransferFile(%s,%s) -> (%s,%s,%s,%s)%s\n" + (Fspath.toString fspathFrom) (Path.toString pathFrom) + (Fspath.toString fspathTo) (Path.toString pathTo) + (Path.toString realPathTo) (Props.toString desc) + (if ressOnly then " (ONLY RESOURCE FORK)" else "")); + let srcFileSize = Props.length desc in + let file_id = Remote.newMsgId () in + + (if ressOnly then + (* Skip data fork *) + Lwt.return () + else begin + (* Data fork *) + if Os.exists fspathTo pathTo then begin + debug (fun() -> Util.msg "Removing old temp file %s / %s\n" + (Fspath.toString fspathTo) (Path.toString pathTo)); + Os.delete fspathTo pathTo + end; + startReceivingFile + fspathTo pathTo realPathTo `DATA update srcFileSize id file_id + >>= (fun (outfd, infd, firstBi, remBi) -> + Lwt.catch (fun () -> + Uutil.showProgress id Uutil.Filesize.zero "f"; + sendRemBi connFrom file_id remBi >>= (fun () -> + compressRemotely connFrom + (firstBi, + fspathFrom, pathFrom, `DATA, srcFileSize, id, file_id) + >>= (fun () -> + decompressor := + Remote.MsgIdMap.remove file_id !decompressor; (* For GC *) + close_all infd outfd; + Lwt.return ()))) + (* catch handler *) + (fun e -> + decompressor := + Remote.MsgIdMap.remove file_id !decompressor; (* For GC *) + close_all_no_error infd outfd; + Lwt.fail e) + )end) >>= (fun () -> + + (* Resource fork *) + (if ressLength > Uutil.Filesize.zero then begin + startReceivingFile + fspathTo pathTo realPathTo + (`RESS ressLength) update ressLength id file_id + >>= (fun (outfd, infd, firstBi, remBi) -> + Lwt.catch (fun () -> + Uutil.showProgress id Uutil.Filesize.zero "f"; + sendRemBi connFrom file_id remBi >>= (fun () -> + compressRemotely connFrom + (firstBi, fspathFrom, pathFrom, + `RESS ressLength, ressLength, id, file_id) + >>= (fun () -> + decompressor := + Remote.MsgIdMap.remove file_id !decompressor; (* For GC *) + close_all infd outfd; + Lwt.return ()))) + (fun e -> + decompressor := + Remote.MsgIdMap.remove file_id !decompressor; (* For GC *) + close_all_no_error infd outfd; + Lwt.fail e)) + end else + Lwt.return ()) >>= (fun () -> + begin match update with + `Update _ -> Fileinfo.set fspathTo pathTo (`Copy realPathTo) desc + | `Copy -> Fileinfo.set fspathTo pathTo (`Set Props.fileDefault) desc + end; + Lwt.return ())) + +(****) + +(* BCP '06: This is a hack to work around a bug on the Windows platform + that causes lightweight threads on the server to hang. I conjecture that + the problem has to do with the RPC mechanism, which was used here to + make a call *back* from the server to the client inside Trace.log so that + the log message would be appended to the log file on the client. *) +(* BCP '08: Jerome thinks that printing these messages using Util.msg + may be causing the dreaded "assertion failure in remote.ml," which + happens only on windows and seems correlated with the xferbycopying + switch. The conjecture is that some windows ssh servers may combine + the stdout and stderr streams, which would result in these messages + getting interleaved with Unison's RPC protocol stream. *) +let loggit s = + if Prefs.read Globals.someHostIsRunningWindows + then () (* Util.msg "%s" *) + else Trace.log s + +let tryCopyMovedFile fspathTo pathTo realPathTo update desc fp ress id = + Prefs.read Xferhint.xferbycopying + && + begin + Util.convertUnixErrorsToTransient "tryCopyMovedFile" (fun() -> + debug (fun () -> Util.msg "tryCopyMovedFile: -> %s /%s/\n" + (Path.toString pathTo) (Os.fullfingerprint_to_string fp)); + match Xferhint.lookup fp with + None -> + false + | Some (candidateFspath, candidatePath) -> + loggit (Printf.sprintf + "Shortcut: copying %s from local file %s\n" + (Path.toString realPathTo) + (Path.toString candidatePath)); + debug (fun () -> + Util.msg + "tryCopyMovedFile: found match at %s,%s. Try local copying\n" + (Fspath.toString candidateFspath) + (Path.toString candidatePath)); + try + if Os.exists candidateFspath candidatePath then begin + localFile + candidateFspath candidatePath fspathTo pathTo realPathTo + update desc (Osx.ressLength ress) (Some id); + let info = Fileinfo.get false fspathTo pathTo in + let fp' = Os.fingerprint fspathTo pathTo info in + if fp' = fp then begin + debug (fun () -> Util.msg "tryCopyMoveFile: success.\n"); + Xferhint.insertEntry (fspathTo, pathTo) fp; + true + end else begin + debug (fun () -> + Util.msg "tryCopyMoveFile: candidate file modified!"); + Xferhint.deleteEntry (candidateFspath, candidatePath); + Os.delete fspathTo pathTo; + loggit (Printf.sprintf + "Shortcut didn't work because %s was modified\n" + (Path.toString candidatePath)); + false + end + end else begin + loggit (Printf.sprintf + "Shortcut didn't work because %s disappeared!\n" + (Path.toString candidatePath)); + Xferhint.deleteEntry (candidateFspath, candidatePath); + false + end + with + Util.Transient s -> + debug (fun () -> + Util.msg "tryCopyMovedFile: local copy didn't work [%s]" s); + Xferhint.deleteEntry (candidateFspath, candidatePath); + Os.delete fspathTo pathTo; + loggit (Printf.sprintf + "Local copy of %s failed\n" + (Path.toString candidatePath)); + false) + end + +let transferFileLocal connFrom + (fspathFrom, pathFrom, fspathTo, pathTo, realPathTo, + update, desc, fp, ress, ressOnly, id) = + if (not ressOnly) + && tryCopyMovedFile fspathTo pathTo realPathTo update desc fp ress id + then Lwt.return () + else reallyTransferFile + connFrom fspathFrom pathFrom fspathTo pathTo realPathTo + update desc (Osx.ressLength ress) ressOnly id + +let transferFileOnRoot = + Remote.registerRootCmdWithConnection "transferFile" transferFileLocal + +let transferFile + rootFrom pathFrom rootTo fspathTo pathTo realPathTo + update desc fp ress ressOnly id = + let bufSz = bufferSize (max (Props.length desc) (Osx.ressLength ress)) in + (* This must be on the client: any lock on the server side may result + in a deadlock under windows *) + Lwt_util.run_in_region transferFileReg bufSz (fun () -> + Abort.check id; + transferFileOnRoot rootTo rootFrom + (snd rootFrom, pathFrom, fspathTo, pathTo, realPathTo, + update, desc, fp, ress, ressOnly, id)) + +(****) + +let copyprog = + Prefs.createString "copyprog" "rsync --inplace --compress" + "!external program for copying large files" + ("A string giving the name of an " + ^ "external program that can be used to copy large files efficiently " + ^ "(plus command-line switches telling it to copy files in-place). " + ^ "The default setting invokes {\\tt rsync} with appropriate " + ^ "options---most users should not need to change it.") + +let copyprogrest = + Prefs.createString "copyprogrest" "rsync --partial --inplace --compress" + "!variant of copyprog for resuming partial transfers" + ("A variant of {\\tt copyprog} that names an external program " + ^ "that should be used to continue the transfer of a large file " + ^ "that has already been partially transferred. Typically, " + ^ "{\\tt copyprogrest} will just be {\\tt copyprog} " + ^ "with one extra option (e.g., {\\tt --partial}, for rsync). " + ^ "The default setting invokes {\\tt rsync} with appropriate " + ^ "options---most users should not need to change it.") + +let copythreshold = + Prefs.createInt "copythreshold" (-1) + "!use copyprog on files bigger than this (if >=0, in Kb)" + ("A number indicating above what filesize (in kilobytes) Unison should " + ^ "use the external " + ^ "copying utility specified by {\\tt copyprog}. Specifying 0 will cause " + ^ "{\\em all} copies to use the external program; " + ^ "a negative number will prevent any files from using it. " + ^ "The default is -1. " + ^ "See \\sectionref{speeding}{Making Unison Faster on Large Files} " + ^ "for more information.") + +let copyquoterem = + Prefs.createString "copyquoterem" "default" + "!add quotes to remote file name for copyprog (true/false/default)" + ("When set to {\\tt true}, this flag causes Unison to add an extra layer " + ^ "of quotes to the remote path passed to the external copy program. " + ^ "This is needed by rsync, for example, which internally uses an ssh " + ^ "connection requiring an extra level of quoting for paths containing " + ^ "spaces. When this flag is set to {\\tt default}, extra quotes are " + ^ "added if the value of {\\tt copyprog} contains the string " + ^ "{\\tt rsync}.") + +let tryCopyMovedFileLocal connFrom + (fspathTo, pathTo, realPathTo, update, desc, fp, ress, id) = + Lwt.return (tryCopyMovedFile fspathTo pathTo realPathTo update desc fp ress id) +let tryCopyMovedFileOnRoot = + Remote.registerRootCmdWithConnection "tryCopyMovedFile" tryCopyMovedFileLocal + +let setFileinfoLocal connFrom (fspathTo, pathTo, desc) = + Lwt.return (Fileinfo.set fspathTo pathTo (`Set Props.fileDefault) desc) +let setFileinfoOnRoot = + Remote.registerRootCmdWithConnection "setFileinfo" setFileinfoLocal + +let targetExists checkSize fspathTo pathTo = + Os.exists fspathTo pathTo + && (match checkSize with + `MakeWriteableAndCheckNonempty -> + let n = Fspath.concatToString fspathTo pathTo in + let perms = (Unix.stat n).Unix.st_perm in + let perms' = perms lor 0o600 in + Unix.chmod n perms'; + let r = + Props.length (Fileinfo.get false fspathTo pathTo).Fileinfo.desc + > Uutil.Filesize.zero in + r + | `CheckDataSize desc -> + Props.length (Fileinfo.get false fspathTo pathTo).Fileinfo.desc + = Props.length desc + | `CheckSize (desc,ress) -> + Props.length (Fileinfo.get false fspathTo pathTo).Fileinfo.desc + = Props.length desc + && Osx.ressLength (Osx.getFileInfos fspathTo pathTo `FILE).Osx.ressInfo + = Osx.ressLength ress) + +let targetExistsLocal connFrom (checkSize, fspathTo, pathTo) = + Lwt.return (targetExists checkSize fspathTo pathTo) +let targetExistsOnRoot = + Remote.registerRootCmdWithConnection + "targetExists" targetExistsLocal + +let formatConnectionInfo root = + match root with + Common.Local, _ -> "" + | Common.Remote h, _ -> + (* Find the (unique) nonlocal root *) + match + Safelist.find (function Clroot.ConnectLocal _ -> false | _ -> true) + (Safelist.map Clroot.parseRoot (Globals.rawRoots())) + with + Clroot.ConnectByShell (_,rawhost,uo,_,_) -> + (match uo with None -> "" | Some u -> u ^ "@") + ^ rawhost ^ ":" + (* Note that we don't do anything with the port -- hopefully + this will not affect many people. If we did want to include it, + we'd have to fiddle with the rsync parameters in a slightly + deeper way. *) + | Clroot.ConnectBySocket (h',_,_) -> + h ^ ":" + | Clroot.ConnectLocal _ -> assert false + +let transferFileUsingExternalCopyprog + rootFrom pathFrom rootTo fspathTo pathTo realPathTo + update desc fp ress id = + tryCopyMovedFileOnRoot rootTo rootFrom + (fspathTo, pathTo, realPathTo, update, desc, fp, ress, id) + >>= (fun b -> + if b then Lwt.return () + else begin + Uutil.showProgress id Uutil.Filesize.zero "ext"; + targetExistsOnRoot + rootTo rootFrom (`MakeWriteableAndCheckNonempty, fspathTo, pathTo) >>= (fun b -> + let prog = + if b + then Prefs.read copyprogrest + else Prefs.read copyprog in + let extraquotes = Prefs.read copyquoterem = "true" + || ( Prefs.read copyquoterem = "default" + && Util.findsubstring "rsync" prog <> None) in + let addquotes root s = + match root with + | Common.Local, _ -> s + | Common.Remote _, _ -> if extraquotes then Os.quotes s else s in + let fromSpec = + (formatConnectionInfo rootFrom) + ^ (addquotes rootFrom (Fspath.concatToString (snd rootFrom) pathFrom)) in + let toSpec = + (formatConnectionInfo rootTo) + ^ (addquotes rootTo (Fspath.concatToString fspathTo pathTo)) in + let cmd = prog ^ " " + ^ (Os.quotes fromSpec) ^ " " + ^ (Os.quotes toSpec) in + Trace.log (Printf.sprintf "%s\n" cmd); + let _,log = External.runExternalProgram cmd in + debug (fun() -> + let l = Util.trimWhitespace log in + Util.msg "transferFileUsingExternalCopyprog %s: returned...\n%s%s" + (Path.toString pathFrom) + l (if l="" then "" else "\n")); + targetExistsOnRoot + rootTo rootFrom (`CheckDataSize desc, fspathTo, pathTo) + >>= (fun b -> + if not b then + raise (Util.Transient (Printf.sprintf + "External copy program did not create target file (or bad length): %s" + (Path.toString pathTo))); + Uutil.showProgress id (Props.length desc) "ext"; + Lwt.return ())) + end) + +let file rootFrom pathFrom rootTo fspathTo pathTo realPathTo + update desc fp ress id = + debug (fun() -> Util.msg "copyRegFile(%s,%s) -> (%s,%s,%s,%s,%s)\n" + (Common.root2string rootFrom) (Path.toString pathFrom) + (Common.root2string rootTo) (Path.toString realPathTo) + (Fspath.toString fspathTo) (Path.toString pathTo) + (Props.toString desc)); + let timer = Trace.startTimer "Transmitting file" in + begin match rootFrom, rootTo with + (Common.Local, fspathFrom), (Common.Local, realFspathTo) -> + localFile + fspathFrom pathFrom fspathTo pathTo realPathTo + update desc (Osx.ressLength ress) (Some id); + Lwt.return () + | _ -> + (* Check whether we actually need to copy the file (or whether it + already exists from some interrupted previous transfer) *) + targetExistsOnRoot + rootTo rootFrom (`CheckSize (desc,ress), fspathTo, pathTo) >>= (fun b -> + if b then begin + Trace.log (Printf.sprintf + "%s/%s has already been transferred\n" + (Fspath.toString fspathTo) (Path.toString pathTo)); + Lwt.return () + (* Check whether we should use an external program to copy the + file *) + end else if + Prefs.read copyprog <> "" + && Prefs.read copythreshold >= 0 + && Props.length desc >= Uutil.Filesize.ofInt64 (Int64.of_int 1) + && Props.length desc >= + Uutil.Filesize.ofInt64 + (Int64.mul (Int64.of_int 1000) + (Int64.of_int (Prefs.read copythreshold))) + && update = `Copy + then begin + (* First use the external program to copy the data fork *) + transferFileUsingExternalCopyprog + rootFrom pathFrom rootTo fspathTo pathTo realPathTo + update desc fp ress id >>= (fun () -> + (* Now use the regular transport mechanism to copy the resource + fork *) + begin if (Osx.ressLength ress) > Uutil.Filesize.zero then begin + transferFile + rootFrom pathFrom rootTo fspathTo pathTo realPathTo + update desc fp ress true id + end else Lwt.return () + end >>= (fun() -> + (* Finally, set the file info *) + setFileinfoOnRoot rootTo rootFrom (fspathTo, pathTo, desc))) + end else + (* Just transfer the file in the usual way with Unison's + built-in facilities *) + transferFile + rootFrom pathFrom rootTo fspathTo pathTo realPathTo + update desc fp ress false id + ) end >>= (fun () -> + Trace.showTimer timer; + Lwt.return ()) Deleted: branches/2.32/src/external.ml =================================================================== --- trunk/src/external.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/external.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,82 +0,0 @@ -(* Unison file synchronizer: src/external.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(*****************************************************************************) -(* RUNNING EXTERNAL PROGRAMS *) -(*****************************************************************************) - -let debug = Util.debug "external" - -let (>>=) = Lwt.bind -open Lwt - -let readChannelTillEof c = - let rec loop lines = - try let l = input_line c in - (* Util.msg "%s\n" l; *) - loop (l::lines) - with End_of_file -> lines in - String.concat "\n" (Safelist.rev (loop [])) - -let readChannelTillEof_lwt c = - let rec loop lines = - let lo = - try - Some(Lwt_unix.run (Lwt_unix.input_line c)) - with End_of_file -> None - in - match lo with - Some l -> loop (l :: lines) - | None -> lines - in - String.concat "\n" (Safelist.rev (loop [])) - -let readChannelsTillEof l = - let rec suckitdry lines c = - Lwt.catch - (fun() -> Lwt_unix.input_line c >>= (fun l -> return (Some l))) - (fun e -> match e with End_of_file -> return None | _ -> raise e) - >>= (fun lo -> - match lo with - None -> return lines - | Some l -> suckitdry (l :: lines) c) in - Lwt_util.map - (fun c -> - suckitdry [] c - >>= (fun res -> return (String.concat "\n" (Safelist.rev res)))) - l - -let runExternalProgram cmd = - if Util.osType = `Win32 && not Util.isCygwin then begin - debug (fun()-> Util.msg "Executing external program windows-style\n"); - let c = Unix.open_process_in ("\"" ^ cmd ^ "\"") in - let log = readChannelTillEof c in - let returnValue = Unix.close_process_in c in - let mergeResultLog = - cmd ^ - (if log <> "" then "\n\n" ^ log else "") ^ - (if returnValue <> Unix.WEXITED 0 then - "\n\n" ^ Util.process_status_to_string returnValue - else - "") in - (returnValue,mergeResultLog) - end else Lwt_unix.run ( - Lwt_unix.open_process_full cmd (Unix.environment ()) - >>= (fun (out, ipt, err) -> - readChannelsTillEof [out;err] - >>= (function [logOut;logErr] -> - Lwt_unix.close_process_full (out, ipt, err) - >>= (fun returnValue -> - let logOut = Util.trimWhitespace logOut in - let logErr = Util.trimWhitespace logErr in - return (returnValue, ( - (* cmd - ^ "\n\n" ^ *) - (if logOut = "" || logErr = "" - then logOut ^ logErr - else logOut ^ "\n\n" ^ ("Error Output:" ^ logErr)) - ^ (if returnValue = Unix.WEXITED 0 - then "" - else "\n\n" ^ Util.process_status_to_string returnValue)))) - (* Stop typechechecker from complaining about non-exhaustive pattern above *) - | _ -> assert false))) Copied: branches/2.32/src/external.ml (from rev 320, trunk/src/external.ml) =================================================================== --- branches/2.32/src/external.ml (rev 0) +++ branches/2.32/src/external.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,97 @@ +(* Unison file synchronizer: src/external.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +(*****************************************************************************) +(* RUNNING EXTERNAL PROGRAMS *) +(*****************************************************************************) + +let debug = Util.debug "external" + +let (>>=) = Lwt.bind +open Lwt + +let readChannelTillEof c = + let rec loop lines = + try let l = input_line c in + (* Util.msg "%s\n" l; *) + loop (l::lines) + with End_of_file -> lines in + String.concat "\n" (Safelist.rev (loop [])) + +let readChannelTillEof_lwt c = + let rec loop lines = + let lo = + try + Some(Lwt_unix.run (Lwt_unix.input_line c)) + with End_of_file -> None + in + match lo with + Some l -> loop (l :: lines) + | None -> lines + in + String.concat "\n" (Safelist.rev (loop [])) + +let readChannelsTillEof l = + let rec suckitdry lines c = + Lwt.catch + (fun() -> Lwt_unix.input_line c >>= (fun l -> return (Some l))) + (fun e -> match e with End_of_file -> return None | _ -> raise e) + >>= (fun lo -> + match lo with + None -> return lines + | Some l -> suckitdry (l :: lines) c) in + Lwt_util.map + (fun c -> + suckitdry [] c + >>= (fun res -> return (String.concat "\n" (Safelist.rev res)))) + l + +let runExternalProgram cmd = + if Util.osType = `Win32 && not Util.isCygwin then begin + debug (fun()-> Util.msg "Executing external program windows-style\n"); + let c = Unix.open_process_in ("\"" ^ cmd ^ "\"") in + let log = readChannelTillEof c in + let returnValue = Unix.close_process_in c in + let mergeResultLog = + cmd ^ + (if log <> "" then "\n\n" ^ log else "") ^ + (if returnValue <> Unix.WEXITED 0 then + "\n\n" ^ Util.process_status_to_string returnValue + else + "") in + (returnValue,mergeResultLog) + end else Lwt_unix.run ( + Lwt_unix.open_process_full cmd (Unix.environment ()) + >>= (fun (out, ipt, err) -> + readChannelsTillEof [out;err] + >>= (function [logOut;logErr] -> + Lwt_unix.close_process_full (out, ipt, err) + >>= (fun returnValue -> + let logOut = Util.trimWhitespace logOut in + let logErr = Util.trimWhitespace logErr in + return (returnValue, ( + (* cmd + ^ "\n\n" ^ *) + (if logOut = "" || logErr = "" + then logOut ^ logErr + else logOut ^ "\n\n" ^ ("Error Output:" ^ logErr)) + ^ (if returnValue = Unix.WEXITED 0 + then "" + else "\n\n" ^ Util.process_status_to_string returnValue)))) + (* Stop typechechecker from complaining about non-exhaustive pattern above *) + | _ -> assert false))) Deleted: branches/2.32/src/external.mli =================================================================== --- trunk/src/external.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/external.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,5 +0,0 @@ -(* Unison file synchronizer: src/external.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -val runExternalProgram : string -> Unix.process_status * string -val readChannelTillEof : in_channel -> string Copied: branches/2.32/src/external.mli (from rev 320, trunk/src/external.mli) =================================================================== --- branches/2.32/src/external.mli (rev 0) +++ branches/2.32/src/external.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,5 @@ +(* Unison file synchronizer: src/external.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +val runExternalProgram : string -> Unix.process_status * string +val readChannelTillEof : in_channel -> string Deleted: branches/2.32/src/fileinfo.ml =================================================================== --- trunk/src/fileinfo.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/fileinfo.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,146 +0,0 @@ -(* Unison file synchronizer: src/fileinfo.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -let debugV = Util.debug "fileinfo+" - -type typ = [ `ABSENT | `FILE | `DIRECTORY | `SYMLINK ] - -let type2string = function - `ABSENT -> "nonexistent" - | `FILE -> "file" - | `DIRECTORY -> "dir" - | `SYMLINK -> "symlink" - -type t = { typ : typ; inode : int; ctime : float; - desc : Props.t; osX : Osx.info} - -(* Stat function that pays attention to pref for following links *) -let statFn fromRoot fspath path = - let fullpath = Fspath.concat fspath path in - let stats = Fspath.lstat fullpath in - if stats.Unix.LargeFile.st_kind = Unix.S_LNK - && fromRoot - && Path.followLink path - then - try Fspath.stat fullpath - with Unix.Unix_error((Unix.ENOENT | Unix.ENOTDIR),_,_) -> - raise (Util.Transient (Printf.sprintf - "Path %s is marked 'follow' but its target is missing" - (Fspath.toString fullpath))) - else - stats - -let get fromRoot fspath path = - Util.convertUnixErrorsToTransient - "querying file information" - (fun () -> - try - let stats = statFn fromRoot fspath path in - debugV (fun () -> - Util.msg "%s: %b %f %f\n" (Fspath.concatToString fspath path) - fromRoot stats.Unix.LargeFile.st_ctime stats.Unix.LargeFile.st_mtime); - let typ = - match stats.Unix.LargeFile.st_kind with - Unix.S_REG -> `FILE - | Unix.S_DIR -> `DIRECTORY - | Unix.S_LNK -> `SYMLINK - | _ -> - raise (Util.Transient - ("path " ^ - (Fspath.concatToString fspath path) ^ - " has unknown file type")) - in - let osxInfos = Osx.getFileInfos fspath path typ in - { typ = typ; - inode = (* The inode number is truncated so that - it fits in a 31 bit ocaml integer *) - stats.Unix.LargeFile.st_ino land 0x3FFFFFFF; - ctime = stats.Unix.LargeFile.st_ctime; - desc = Props.get stats osxInfos; - osX = osxInfos } - with - Unix.Unix_error((Unix.ENOENT | Unix.ENOTDIR),_,_) -> - { typ = `ABSENT; - inode = 0; - ctime = 0.0; - desc = Props.dummy; - osX = Osx.getFileInfos fspath path `ABSENT }) - -let check fspath path props = - Props.check fspath path (statFn false fspath path) props - -let set fspath path action newDesc = - let (kind, p) = - match action with - `Set defDesc -> - (* Set the permissions and maybe the other properties *) - (* BCP [Nov 2008]: Jerome, in a message to unison-hackers on - Oct 5, 2005, suggested that this would be better as - `Set, Props.override (get false fspath path).desc newDesc - but this does not seem right to me (bcp): if the file was just - created, then its permissions are something like 0x600, whereas - the default permissions will set the world read bit, etc. *) - `Set, Props.override defDesc newDesc - | `Copy oldPath -> - (* Set the permissions (using the permissions of the file at *) - (* [oldPath] as a default) and maybe the other properties *) - `Set, Props.override (get false fspath oldPath).desc newDesc - | `Update oldDesc -> - (* Update the different properties (only if necessary) *) - `Update, - Props.override - (get false fspath path).desc (Props.diff oldDesc newDesc) - in - Props.set fspath path kind p; - check fspath path p - -type stamp = - InodeStamp of int (* inode number, for Unix systems *) - | CtimeStamp of float (* creation time, for windows systems *) - (* FIX [BCP, 3/07]: The Ctimestamp variant is actually bogus. - For file transfers, it appears that using the ctime to detect a - file change is completely ineffective as, when a file is deleted (or - renamed) and then replaced by another file, the new file inherits the - ctime of the old file. It is slightly harmful performancewise, as - fastcheck expects ctime to be preserved by renaming. Thus, we should - probably not use any stamp under Windows. *) - -let pretendLocalOSIsWin32 = - Prefs.createBool "pretendwin" false - "!Use creation times for detecting updates" - ("When set to true, this preference makes Unison use Windows-style " - ^ "fast update detection (using file creation times as " - ^ "``pseudo-inode-numbers''), even when running on a Unix system. This " - ^ "switch should be used with care, as it is less safe than the standard " - ^ "update detection method, but it can be useful for synchronizing VFAT " - ^ "filesystems (which do not support inode numbers) mounted on Unix " - ^ "systems. The {\\tt fastcheck} option should also be set to true.") - -let stamp info = - (* Was "CtimeStamp info.ctime", but this is bogus: Windows - ctimes are not reliable. *) - if Prefs.read pretendLocalOSIsWin32 then CtimeStamp 0.0 else - match Util.osType with - `Unix -> InodeStamp info.inode - | `Win32 -> CtimeStamp 0.0 - -let ressStamp info = Osx.stamp info.osX - -let unchanged fspath path info = - (* The call to [Util.time] must be before the call to [get] *) - let t0 = Util.time () in - let info' = get true fspath path in - let dataUnchanged = - Props.same_time info.desc info'.desc - && - stamp info = stamp info' - && - if Props.time info'.desc = t0 then begin - Unix.sleep 1; - false - end else - true - in - (info', dataUnchanged, - Osx.ressUnchanged info.osX.Osx.ressInfo info'.osX.Osx.ressInfo - (Some t0) dataUnchanged) Copied: branches/2.32/src/fileinfo.ml (from rev 320, trunk/src/fileinfo.ml) =================================================================== --- branches/2.32/src/fileinfo.ml (rev 0) +++ branches/2.32/src/fileinfo.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,161 @@ +(* Unison file synchronizer: src/fileinfo.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +let debugV = Util.debug "fileinfo+" + +type typ = [ `ABSENT | `FILE | `DIRECTORY | `SYMLINK ] + +let type2string = function + `ABSENT -> "nonexistent" + | `FILE -> "file" + | `DIRECTORY -> "dir" + | `SYMLINK -> "symlink" + +type t = { typ : typ; inode : int; ctime : float; + desc : Props.t; osX : Osx.info} + +(* Stat function that pays attention to pref for following links *) +let statFn fromRoot fspath path = + let fullpath = Fspath.concat fspath path in + let stats = Fspath.lstat fullpath in + if stats.Unix.LargeFile.st_kind = Unix.S_LNK + && fromRoot + && Path.followLink path + then + try Fspath.stat fullpath + with Unix.Unix_error((Unix.ENOENT | Unix.ENOTDIR),_,_) -> + raise (Util.Transient (Printf.sprintf + "Path %s is marked 'follow' but its target is missing" + (Fspath.toString fullpath))) + else + stats + +let get fromRoot fspath path = + Util.convertUnixErrorsToTransient + "querying file information" + (fun () -> + try + let stats = statFn fromRoot fspath path in + debugV (fun () -> + Util.msg "%s: %b %f %f\n" (Fspath.concatToString fspath path) + fromRoot stats.Unix.LargeFile.st_ctime stats.Unix.LargeFile.st_mtime); + let typ = + match stats.Unix.LargeFile.st_kind with + Unix.S_REG -> `FILE + | Unix.S_DIR -> `DIRECTORY + | Unix.S_LNK -> `SYMLINK + | _ -> + raise (Util.Transient + ("path " ^ + (Fspath.concatToString fspath path) ^ + " has unknown file type")) + in + let osxInfos = Osx.getFileInfos fspath path typ in + { typ = typ; + inode = (* The inode number is truncated so that + it fits in a 31 bit ocaml integer *) + stats.Unix.LargeFile.st_ino land 0x3FFFFFFF; + ctime = stats.Unix.LargeFile.st_ctime; + desc = Props.get stats osxInfos; + osX = osxInfos } + with + Unix.Unix_error((Unix.ENOENT | Unix.ENOTDIR),_,_) -> + { typ = `ABSENT; + inode = 0; + ctime = 0.0; + desc = Props.dummy; + osX = Osx.getFileInfos fspath path `ABSENT }) + +let check fspath path props = + Props.check fspath path (statFn false fspath path) props + +let set fspath path action newDesc = + let (kind, p) = + match action with + `Set defDesc -> + (* Set the permissions and maybe the other properties *) + (* BCP [Nov 2008]: Jerome, in a message to unison-hackers on + Oct 5, 2005, suggested that this would be better as + `Set, Props.override (get false fspath path).desc newDesc + but this does not seem right to me (bcp): if the file was just + created, then its permissions are something like 0x600, whereas + the default permissions will set the world read bit, etc. *) + `Set, Props.override defDesc newDesc + | `Copy oldPath -> + (* Set the permissions (using the permissions of the file at *) + (* [oldPath] as a default) and maybe the other properties *) + `Set, Props.override (get false fspath oldPath).desc newDesc + | `Update oldDesc -> + (* Update the different properties (only if necessary) *) + `Update, + Props.override + (get false fspath path).desc (Props.diff oldDesc newDesc) + in + Props.set fspath path kind p; + check fspath path p + +type stamp = + InodeStamp of int (* inode number, for Unix systems *) + | CtimeStamp of float (* creation time, for windows systems *) + (* FIX [BCP, 3/07]: The Ctimestamp variant is actually bogus. + For file transfers, it appears that using the ctime to detect a + file change is completely ineffective as, when a file is deleted (or + renamed) and then replaced by another file, the new file inherits the + ctime of the old file. It is slightly harmful performancewise, as + fastcheck expects ctime to be preserved by renaming. Thus, we should + probably not use any stamp under Windows. *) + +let pretendLocalOSIsWin32 = + Prefs.createBool "pretendwin" false + "!Use creation times for detecting updates" + ("When set to true, this preference makes Unison use Windows-style " + ^ "fast update detection (using file creation times as " + ^ "``pseudo-inode-numbers''), even when running on a Unix system. This " + ^ "switch should be used with care, as it is less safe than the standard " + ^ "update detection method, but it can be useful for synchronizing VFAT " + ^ "filesystems (which do not support inode numbers) mounted on Unix " + ^ "systems. The {\\tt fastcheck} option should also be set to true.") + +let stamp info = + (* Was "CtimeStamp info.ctime", but this is bogus: Windows + ctimes are not reliable. *) + if Prefs.read pretendLocalOSIsWin32 then CtimeStamp 0.0 else + match Util.osType with + `Unix -> InodeStamp info.inode + | `Win32 -> CtimeStamp 0.0 + +let ressStamp info = Osx.stamp info.osX + +let unchanged fspath path info = + (* The call to [Util.time] must be before the call to [get] *) + let t0 = Util.time () in + let info' = get true fspath path in + let dataUnchanged = + Props.same_time info.desc info'.desc + && + stamp info = stamp info' + && + if Props.time info'.desc = t0 then begin + Unix.sleep 1; + false + end else + true + in + (info', dataUnchanged, + Osx.ressUnchanged info.osX.Osx.ressInfo info'.osX.Osx.ressInfo + (Some t0) dataUnchanged) Deleted: branches/2.32/src/fileinfo.mli =================================================================== --- trunk/src/fileinfo.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/fileinfo.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,25 +0,0 @@ -(* Unison file synchronizer: src/fileinfo.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -type typ = [`ABSENT | `FILE | `DIRECTORY | `SYMLINK] -val type2string : typ -> string - -type t = { typ : typ; inode : int; ctime : float; - desc : Props.t; osX : Osx.info} - -val get : bool -> Fspath.t -> Path.local -> t -val set : Fspath.t -> Path.local -> - [`Set of Props.t | `Copy of Path.local | `Update of Props.t] -> - Props.t -> unit - -(* IF THIS CHANGES, MAKE SURE TO INCREMENT THE ARCHIVE VERSION NUMBER! *) -type stamp = - InodeStamp of int (* inode number, for Unix systems *) - | CtimeStamp of float (* creation time, for windows systems *) - -val stamp : t -> stamp - -val ressStamp : t -> Osx.ressStamp - -(* Check whether a file is unchanged *) -val unchanged : Fspath.t -> Path.local -> t -> (t * bool * bool) Copied: branches/2.32/src/fileinfo.mli (from rev 320, trunk/src/fileinfo.mli) =================================================================== --- branches/2.32/src/fileinfo.mli (rev 0) +++ branches/2.32/src/fileinfo.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,25 @@ +(* Unison file synchronizer: src/fileinfo.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +type typ = [`ABSENT | `FILE | `DIRECTORY | `SYMLINK] +val type2string : typ -> string + +type t = { typ : typ; inode : int; ctime : float; + desc : Props.t; osX : Osx.info} + +val get : bool -> Fspath.t -> Path.local -> t +val set : Fspath.t -> Path.local -> + [`Set of Props.t | `Copy of Path.local | `Update of Props.t] -> + Props.t -> unit + +(* IF THIS CHANGES, MAKE SURE TO INCREMENT THE ARCHIVE VERSION NUMBER! *) +type stamp = + InodeStamp of int (* inode number, for Unix systems *) + | CtimeStamp of float (* creation time, for windows systems *) + +val stamp : t -> stamp + +val ressStamp : t -> Osx.ressStamp + +(* Check whether a file is unchanged *) +val unchanged : Fspath.t -> Path.local -> t -> (t * bool * bool) Deleted: branches/2.32/src/files.ml =================================================================== --- trunk/src/files.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/files.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,916 +0,0 @@ -(* Unison file synchronizer: src/files.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -open Common -open Lwt -open Fileinfo - -let debug = Trace.debug "files" -let debugverbose = Trace.debug "files+" - -(* ------------------------------------------------------------ *) - -let commitLogName = Util.fileInHomeDir "DANGER.README" - -let writeCommitLog source target tempname = - let sourcename = Fspath.toString source in - let targetname = Fspath.toString target in - debug (fun() -> Util.msg "Writing commit log: renaming %s to %s via %s\n" - sourcename targetname tempname); - Util.convertUnixErrorsToFatal - "writing commit log" - (fun () -> - let c = - open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_excl] - 0o600 commitLogName in - Printf.fprintf c "Warning: the last run of %s terminated abnormally " - Uutil.myName; - Printf.fprintf c "while moving\n %s\nto\n %s\nvia\n %s\n\n" - sourcename targetname tempname; - Printf.fprintf c "Please check the state of these files immediately\n"; - Printf.fprintf c "(and delete this notice when you've done so).\n"; - close_out c) - -let clearCommitLog () = - debug (fun() -> (Util.msg "Deleting commit log\n")); - Util.convertUnixErrorsToFatal - "clearing commit log" - (fun () -> Unix.unlink commitLogName) - -let processCommitLog () = - if Sys.file_exists commitLogName then begin - raise(Util.Fatal( - Printf.sprintf - "Warning: the previous run of %s terminated in a dangerous state. - Please consult the file %s, delete it, and try again." - Uutil.myName - commitLogName)) - end else - Lwt.return () - -let processCommitLogOnHost = - Remote.registerHostCmd "processCommitLog" processCommitLog - -let processCommitLogs() = - Lwt_unix.run - (Globals.allHostsIter (fun h -> processCommitLogOnHost h ())) - -(* ------------------------------------------------------------ *) - -let deleteLocal (fspath, (workingDirOpt, path)) = - (* when the workingDirectory is set, we are dealing with a temporary file *) - (* so we don't call the stasher in this case. *) - begin match workingDirOpt with - Some p -> - debug (fun () -> Util.msg "deleteLocal [%s] (%s, %s)\n" (Fspath.toString fspath) (Fspath.toString p) (Path.toString path)); - Os.delete p path - | None -> - debug (fun () -> Util.msg "deleteLocal [%s] (None, %s)\n" (Fspath.toString fspath) (Path.toString path)); - Stasher.backup fspath path `AndRemove - end; - Lwt.return () - -let performDelete = Remote.registerRootCmd "delete" deleteLocal - -(* FIX: maybe we should rename the destination before making any check ? *) -let delete rootFrom pathFrom rootTo pathTo ui = - Update.transaction (fun id -> - Update.replaceArchive rootFrom pathFrom None Update.NoArchive id true false - >>= (fun _ -> - (* Unison do the next line cause we want to keep a backup of the file. - FIX: We only need this when we are making backups *) - Update.updateArchive rootTo pathTo ui id >>= (fun _ -> - Update.replaceArchive - rootTo pathTo None Update.NoArchive id true false - >>= (fun localPathTo -> - (* Make sure the target is unchanged *) - (* (There is an unavoidable race condition here.) *) - Update.checkNoUpdates rootTo pathTo ui >>= (fun () -> - performDelete rootTo (None, localPathTo)))))) - -(* ------------------------------------------------------------ *) - -let setPropRemote = - Remote.registerRootCmd - "setProp" - (fun (fspath, (workingDir, path, kind, newDesc)) -> - Fileinfo.set workingDir path kind newDesc; - Lwt.return ()) - -let setPropRemote2 = - Remote.registerRootCmd - "setProp2" - (fun (fspath, (path, kind, newDesc)) -> - let (workingDir,realPath) = Fspath.findWorkingDir fspath path in - Fileinfo.set workingDir realPath kind newDesc; - Lwt.return ()) - -(* FIX: we should check there has been no update before performing the - change *) -let setProp fromRoot fromPath toRoot toPath newDesc oldDesc uiFrom uiTo = - debug (fun() -> - Util.msg - "setProp %s %s %s\n %s %s %s\n" - (root2string fromRoot) (Path.toString fromPath) - (Props.toString newDesc) - (root2string toRoot) (Path.toString toPath) - (Props.toString oldDesc)); - Update.transaction (fun id -> - Update.updateProps fromRoot fromPath None uiFrom id >>= (fun _ -> - (* [uiTo] provides the modtime while [desc] provides the other - file properties *) - Update.updateProps toRoot toPath (Some newDesc) uiTo id >>= - (fun toLocalPath -> - setPropRemote2 toRoot (toLocalPath, `Update oldDesc, newDesc)))) - -(* ------------------------------------------------------------ *) - -let mkdirRemote = - Remote.registerRootCmd - "mkdir" - (fun (fspath,(workingDir,path)) -> - let createIt() = Os.createDir workingDir path Props.dirDefault in - if Os.exists workingDir path then - if (Fileinfo.get false workingDir path).Fileinfo.typ <> `DIRECTORY then begin - Os.delete workingDir path; - createIt() - end else () - else - createIt(); - Lwt.return (Fileinfo.get false workingDir path).Fileinfo.desc) - -let mkdir onRoot workingDir path = mkdirRemote onRoot (workingDir,path) - -(* ------------------------------------------------------------ *) - -let renameLocal (root, (localTargetPath, fspath, pathFrom, pathTo)) = - debug (fun () -> Util.msg "Renaming %s to %s in %s; root is %s\n" - (Path.toString pathFrom) - (Path.toString pathTo) - (Fspath.toString fspath) - (Fspath.toString root)); - let source = Fspath.concat fspath pathFrom in - let target = Fspath.concat fspath pathTo in - Util.convertUnixErrorsToTransient - (Printf.sprintf "renaming %s to %s" - (Fspath.toString source) (Fspath.toString target)) - (fun () -> - debugverbose (fun() -> - Util.msg "calling Fileinfo.get from renameLocal\n"); - let filetypeFrom = - (Fileinfo.get false source Path.empty).Fileinfo.typ in - debugverbose (fun() -> - Util.msg "back from Fileinfo.get from renameLocal\n"); - if filetypeFrom = `ABSENT then raise (Util.Transient (Printf.sprintf - "Error while renaming %s to %s -- source file has disappeared!" - (Fspath.toString source) (Fspath.toString target))); - let filetypeTo = - (Fileinfo.get false target Path.empty).Fileinfo.typ in - - (* Windows and Unix operate differently if the target path of a - rename already exists: in Windows an exception is raised, in - Unix the file is clobbered. In both Windows and Unix, if - the target is an existing **directory**, an exception will - be raised. We want to avoid doing the move first, if possible, - because this opens a "window of danger" during which the contents of - the path is nothing. *) - let moveFirst = - match (filetypeFrom, filetypeTo) with - | (_, `ABSENT) -> false - | ((`FILE | `SYMLINK), - (`FILE | `SYMLINK)) -> Util.osType <> `Unix - | _ -> true (* Safe default *) in - if moveFirst then begin - debug (fun() -> Util.msg "rename: moveFirst=true\n"); - let tmpPath = Os.tempPath fspath pathTo in - let temp = Fspath.concat fspath tmpPath in - let temp' = Fspath.toString temp in - - debug (fun() -> Util.msg "moving %s to %s\n" (Fspath.toString target) temp'); - Stasher.backup root localTargetPath `ByCopying; - writeCommitLog source target temp'; - Util.finalize (fun() -> - (* If the first rename fails, the log can be removed: the - filesystem is in a consistent state *) - Os.rename "renameLocal(1)" target Path.empty temp Path.empty; - (* If the next renaming fails, we will be left with - DANGER.README file which will make any other - (similar) renaming fail in a cryptic way. So it - seems better to abort early by converting Unix errors - to Fatal ones (rather than Transient). *) - Util.convertUnixErrorsToFatal "renaming with commit log" - (fun () -> - debug (fun() -> Util.msg "rename %s to %s\n" - (Fspath.toString source) (Fspath.toString target)); - Os.rename "renameLocal(2)" - source Path.empty target Path.empty)) - (fun _ -> clearCommitLog()); - (* It is ok to leave a temporary file. So, the log can be - cleared before deleting it. *) - Os.delete temp Path.empty - end else begin - debug (fun() -> Util.msg "rename: moveFirst=false\n"); - Stasher.backup root localTargetPath `ByCopying; - Os.rename "renameLocal(3)" source Path.empty target Path.empty; - debug (fun() -> - if filetypeFrom = `FILE then - Util.msg - "Contents of %s after renaming = %s\n" - (Fspath.toString target) - (Fingerprint.toString (Fingerprint.file target Path.empty))); - end; - Lwt.return ()) - -let renameOnHost = Remote.registerRootCmd "rename" renameLocal - -(* FIX: maybe we should rename the destination before making any check ? *) -(* FIX: When this code was originally written, we assumed that the - checkNoUpdates would happen immediately before the renameOnHost, so that - the window of danger where other processes could invalidate the thing we - just checked was very small. But now that transport is multi-threaded, - this window of danger could get very long because other transfers are - saturating the link. It would be better, I think, to introduce a real - 2PC protocol here, so that both sides would (locally and almost-atomically) - check that their assumptions had not been violated and then switch the - temp file into place, but remain able to roll back if something fails - either locally or on the other side. *) -let rename root pathInArchive localPath workingDir pathOld pathNew ui = - debug (fun() -> - Util.msg "rename(root=%s, pathOld=%s, pathNew=%s)\n" - (root2string root) - (Path.toString pathOld) (Path.toString pathNew)); - (* Make sure the target is unchanged, then do the rename. - (Note that there is an unavoidable race condition here...) *) - Update.checkNoUpdates root pathInArchive ui >>= (fun () -> - renameOnHost root (localPath, workingDir, pathOld, pathNew)) - -(* ------------------------------------------------------------ *) - -let checkContentsChangeLocal - currfspath path archDesc archDig archStamp archRess = - let info = Fileinfo.get true currfspath path in - if Props.length archDesc <> Props.length info.Fileinfo.desc then - raise (Util.Transient (Printf.sprintf - "The file %s\nhas been modified during synchronization. \ - Transfer aborted." - (Fspath.concatToString currfspath path))); - match archStamp with - Fileinfo.InodeStamp inode - when info.Fileinfo.inode = inode - && Props.same_time info.Fileinfo.desc archDesc -> - () - | _ -> - (* Note that we fall back to the paranoid check (using a fingerprint) - even if a CtimeStamp was provided, since we do not trust them - completely. *) - let (info, newDig) = Os.safeFingerprint currfspath path info None in - if archDig <> newDig then - raise (Util.Transient (Printf.sprintf - "The file %s\nhas been modified during synchronization. \ - Transfer aborted.%s" - (Fspath.concatToString currfspath path) - (if Update.useFastChecking () - && Props.same_time info.Fileinfo.desc archDesc - then - " If this happens repeatedly, try running once with the \ - fastcheck option set to 'no'" - else - ""))) - -let checkContentsChangeOnHost = - Remote.registerRootCmd - "checkContentsChange" - (fun (currfspath, (path, archDesc, archDig, archStamp, archRess)) -> - checkContentsChangeLocal - currfspath path archDesc archDig archStamp archRess; - Lwt.return ()) - -let checkContentsChange root path archDesc archDig archStamp archRess = - checkContentsChangeOnHost root (path, archDesc, archDig, archStamp, archRess) - -(* ------------------------------------------------------------ *) - -(* Calculate the target working directory and paths for the copy. - workingDir is an fspath naming the directory on the target - host where the copied file will actually live. - (In the case where pathTo names a symbolic link, this - will be the parent directory of the file that the - symlink points to, not the symlink itself. Note that - this fspath may be outside of the replica, or even - on a different volume.) - realPathTo is the name of the target file relative to workingDir. - (If pathTo names a symlink, this will be the name of - the file pointed to by the symlink, not the name of the - link itself.) - tempPathTo is a temporary file name in the workingDir. The file (or - directory structure) will first be copied here, then - "almost atomically" moved onto realPathTo. *) - -let setupTargetPathsLocal (fspath, path) = - let localPath = Update.translatePathLocal fspath path in - let (workingDir,realPath) = Fspath.findWorkingDir fspath localPath in - let tempPath = Os.tempPath ~fresh:false workingDir realPath in - Lwt.return (workingDir, realPath, tempPath, localPath) - -let setupTargetPaths = - Remote.registerRootCmd "setupTargetPaths" setupTargetPathsLocal - -(* ------------------------------------------------------------ *) - -let makeSymlink = - Remote.registerRootCmd - "makeSymlink" - (fun (fspath, (workingDir, path, l)) -> - if Os.exists workingDir path then - Os.delete workingDir path; - Os.symlink workingDir path l; - Lwt.return ()) - -let copyReg = Lwt_util.make_region 50 - -let copy - update - rootFrom pathFrom (* copy from here... *) - uiFrom (* (and then check that this updateItem still - describes the current state of the src replica) *) - rootTo pathTo (* ...to here *) - uiTo (* (but, before committing the copy, check that - this updateItem still describes the current - state of the target replica) *) - id = (* for progress display *) - debug (fun() -> - Util.msg - "copy %s %s ---> %s %s \n" - (root2string rootFrom) (Path.toString pathFrom) - (root2string rootTo) (Path.toString pathTo)); - (* Calculate target paths *) - setupTargetPaths rootTo pathTo - >>= (fun (workingDir, realPathTo, tempPathTo, localPathTo) -> - (* Inner loop for recursive copy... *) - let rec copyRec pFrom (* Path to copy from *) - pTo (* (Temp) path to copy to *) - realPTo (* Path where this file will ultimately be placed - (needed by rsync, which uses the old contents - of this file to optimize transfer) *) - f = (* Source archive subtree for this path *) - debug (fun() -> - Util.msg "copyRec %s --> %s (really to %s)\n" - (Path.toString pFrom) (Path.toString pTo) - (Path.toString realPTo)); - match f with - Update.ArchiveFile (desc, dig, stamp, ress) -> - Lwt_util.run_in_region copyReg 1 (fun () -> - Abort.check id; - Copy.file - rootFrom pFrom rootTo workingDir pTo realPTo - update desc dig ress id - >>= (fun () -> - checkContentsChange rootFrom pFrom desc dig stamp ress)) - | Update.ArchiveSymlink l -> - Lwt_util.run_in_region copyReg 1 (fun () -> - debug (fun() -> Util.msg "Making symlink %s/%s -> %s\n" - (root2string rootTo) (Path.toString pTo) l); - Abort.check id; - makeSymlink rootTo (workingDir, pTo, l)) - | Update.ArchiveDir (desc, children) -> - Lwt_util.run_in_region copyReg 1 (fun () -> - debug (fun() -> Util.msg "Creating directory %s/%s\n" - (root2string rootTo) (Path.toString pTo)); - mkdir rootTo workingDir pTo) >>= (fun initialDesc -> - Abort.check id; - let runningThreads = ref [] in - Lwt.catch - (fun () -> - Update.NameMap.iter - (fun name child -> - let thread = - copyRec (Path.child pFrom name) - (Path.child pTo name) - (Path.child realPTo name) - child - in - runningThreads := thread :: !runningThreads) - children; - Lwt_util.join !runningThreads) - (fun e -> - (* If one thread fails (in a non-fatal way), we wait for - all other threads to terminate before continuing *) - if not (Abort.testException e) then Abort.file id; - match e with - Util.Transient _ -> - let e = ref e in - Lwt_util.iter - (fun act -> - Lwt.catch - (fun () -> act) - (fun e' -> - match e' with - Util.Transient _ -> - if Abort.testException !e then e := e'; - Lwt.return () - | _ -> - Lwt.fail e')) - !runningThreads >>= (fun () -> - Lwt.fail !e) - | _ -> - Lwt.fail e) >>= (fun () -> - Lwt_util.run_in_region copyReg 1 (fun () -> - (* We use the actual file permissions so as to preserve - inherited bits *) - Abort.check id; - setPropRemote rootTo - (workingDir, pTo, `Set initialDesc, desc)))) - | Update.NoArchive -> - assert false - in - (* BCP (6/08): We used to have an unwindProtect here that would *always* do the - final performDelete. This was removed so that failed partial transfers can - be restarted. We instead remove individual failing files (not - directories) inside replaceArchive. *) - Update.transaction (fun id -> - (* Update the archive on the source replica (but don't commit - the changes yet) and return the part of the new archive - corresponding to this path *) - Update.updateArchive rootFrom pathFrom uiFrom id - >>= (fun (localPathFrom, archFrom) -> - let make_backup = - (* Perform (asynchronously) a backup of the destination files *) - Update.updateArchive rootTo pathTo uiTo id - in - copyRec localPathFrom tempPathTo realPathTo archFrom >>= (fun () -> - make_backup >>= (fun _ -> - Update.replaceArchive - rootTo pathTo (Some (workingDir, tempPathTo)) - archFrom id true true >>= (fun _ -> - rename rootTo pathTo localPathTo workingDir tempPathTo realPathTo uiTo >>= (fun() -> - debug (fun() -> Util.msg "Removing temp files\n"); - performDelete rootTo (Some workingDir, tempPathTo) ))))))) - -(* ------------------------------------------------------------ *) - -let (>>=) = Lwt.bind - -let diffCmd = - Prefs.createString "diff" "diff -u CURRENT2 CURRENT1" - "!command for showing differences between files" - ("This preference can be used to control the name and command-line " - ^ "arguments of the system " - ^ "utility used to generate displays of file differences. The default " - ^ "is `\\verb|diff -u CURRENT2 CURRENT1|'. If the value of this preference contains the substrings " - ^ "CURRENT1 and CURRENT2, these will be replaced by the names of the files to be " - ^ "diffed. If not, the two filenames will be appended to the command. In both " - ^ "cases, the filenames are suitably quoted.") - -let tempName s = Os.tempFilePrefix ^ s - -let rec diff root1 path1 ui1 root2 path2 ui2 showDiff id = - debug (fun () -> - Util.msg - "diff %s %s %s %s ...\n" - (root2string root1) (Path.toString path1) - (root2string root2) (Path.toString path2)); - let displayDiff fspath1 fspath2 = - let cmd = - if Util.findsubstring "CURRENT1" (Prefs.read diffCmd) = None then - (Prefs.read diffCmd) - ^ " " ^ (Os.quotes (Fspath.toString fspath1)) - ^ " " ^ (Os.quotes (Fspath.toString fspath2)) - else - Util.replacesubstrings (Prefs.read diffCmd) - ["CURRENT1", Os.quotes (Fspath.toString fspath1); - "CURRENT2", Os.quotes (Fspath.toString fspath2)] in - (* Doesn't seem to work well on Windows! - let c = Lwt_unix.run (Lwt_unix.open_process_in cmd) in *) - let c = Unix.open_process_in - (if Util.osType = `Win32 && not Util.isCygwin then - (* BCP: Proposed by Karl M. to deal with the standard windows - command processor's weird treatment of spaces and quotes: *) - "\"" ^ cmd ^ "\"" - else - cmd) in - showDiff cmd (External.readChannelTillEof c); - ignore (Unix.close_process_in c) in - let (desc1, fp1, ress1, desc2, fp2, ress2) = Common.fileInfos ui1 ui2 in - match root1,root2 with - (Local,fspath1),(Local,fspath2) -> - Util.convertUnixErrorsToTransient - "diffing files" - (fun () -> - let path1 = Update.translatePathLocal fspath1 path1 in - let path2 = Update.translatePathLocal fspath2 path2 in - displayDiff - (Fspath.concat fspath1 path1) (Fspath.concat fspath2 path2)) - | (Local,fspath1),(Remote host2,fspath2) -> - Util.convertUnixErrorsToTransient - "diffing files" - (fun () -> - let path1 = Update.translatePathLocal fspath1 path1 in - let (workingDir, realPath) = Fspath.findWorkingDir fspath1 path1 in - let tmppath = - Path.addSuffixToFinalName realPath (tempName "diff-") in - Os.delete workingDir tmppath; - Lwt_unix.run - (Update.translatePath root2 path2 >>= (fun path2 -> - Copy.file root2 path2 root1 workingDir tmppath realPath - `Copy (Props.setLength Props.fileSafe (Props.length desc2)) - fp2 ress2 id)); - displayDiff - (Fspath.concat workingDir realPath) - (Fspath.concat workingDir tmppath); - Os.delete workingDir tmppath) - | (Remote host1,fspath1),(Local,fspath2) -> - Util.convertUnixErrorsToTransient - "diffing files" - (fun () -> - let path2 = Update.translatePathLocal fspath2 path2 in - let (workingDir, realPath) = Fspath.findWorkingDir fspath2 path2 in - let tmppath = - Path.addSuffixToFinalName realPath "#unisondiff-" in - Lwt_unix.run - (Update.translatePath root1 path1 >>= (fun path1 -> - (* Note that we don't need the resource fork *) - Copy.file root1 path1 root2 workingDir tmppath realPath - `Copy (Props.setLength Props.fileSafe (Props.length desc1)) - fp1 ress1 id)); - displayDiff - (Fspath.concat workingDir tmppath) - (Fspath.concat workingDir realPath); - Os.delete workingDir tmppath) - | (Remote host1,fspath1),(Remote host2,fspath2) -> - assert false - - -(**********************************************************************) - -(* Taken from ocamltk/jpf/fileselect.ml *) -let get_files_in_directory dir = - let dirh = Fspath.opendir (Fspath.canonize (Some dir)) in - let files = ref [] in - begin try - while true do files := Unix.readdir dirh :: !files done - with End_of_file -> - Unix.closedir dirh - end; - Sort.list (<) !files - -let ls dir pattern = - Util.convertUnixErrorsToTransient - "listing files" - (fun () -> - let files = get_files_in_directory dir in - let re = Rx.glob pattern in - let rec filter l = - match l with - [] -> - [] - | hd :: tl -> - if Rx.match_string re hd then hd :: filter tl else filter tl - in - filter files) - - -(*********************************************************************** - CALL OUT TO EXTERNAL MERGE PROGRAM -************************************************************************) - -let formatMergeCmd p f1 f2 backup out1 out2 outarch = - if not (Globals.shouldMerge p) then - raise (Util.Transient ("'merge' preference not set for "^(Path.toString p))); - let raw = - try Globals.mergeCmdForPath p - with Not_found -> - raise (Util.Transient ("'merge' preference does not provide a command " - ^ "template for " ^ (Path.toString p))) - in - let cooked = raw in - let cooked = Util.replacesubstring cooked "CURRENT1" f1 in - let cooked = Util.replacesubstring cooked "CURRENT2" f2 in - let cooked = - match backup with - None -> begin - let cooked = Util.replacesubstring cooked "CURRENTARCHOPT" "" in - match Util.findsubstring "CURRENTARCH" cooked with - None -> cooked - | Some _ -> raise (Util.Transient - ("No archive found, but the 'merge' command " - ^ "template expects one. (Consider enabling " - ^ "'backupcurrent' for this file or using CURRENTARCHOPT " - ^ "instead of CURRENTARCH.)")) - end - | Some(s) -> - let cooked = Util.replacesubstring cooked "CURRENTARCHOPT" s in - let cooked = Util.replacesubstring cooked "CURRENTARCH" s in - cooked in - let cooked = Util.replacesubstring cooked "NEW1" out1 in - let cooked = Util.replacesubstring cooked "NEW2" out2 in - let cooked = Util.replacesubstring cooked "NEWARCH" outarch in - let cooked = Util.replacesubstring cooked "NEW" out1 in - let cooked = Util.replacesubstring cooked "PATH" (Path.toString p) in - cooked - -let copyBack fspathFrom pathFrom rootTo pathTo propsTo uiTo id = - setupTargetPaths rootTo pathTo - >>= (fun (workingDirForCopy, realPathTo, tempPathTo, localPathTo) -> - let info = Fileinfo.get false fspathFrom pathFrom in - let fp = Os.fingerprint fspathFrom pathFrom info in - let stamp = Osx.stamp info.Fileinfo.osX in - let newprops = Props.setLength propsTo (Props.length info.Fileinfo.desc) in - Copy.file - (Local, fspathFrom) pathFrom rootTo workingDirForCopy tempPathTo realPathTo - `Copy newprops fp stamp id >>= (fun () -> - rename rootTo pathTo localPathTo workingDirForCopy tempPathTo realPathTo - uiTo )) - -let keeptempfilesaftermerge = - Prefs.createBool - "keeptempfilesaftermerge" false "*" "" - -let showStatus = function - | Unix.WEXITED i -> Printf.sprintf "exited (%d)" i - | Unix.WSIGNALED i -> Printf.sprintf "killed with signal %d" i - | Unix.WSTOPPED i -> Printf.sprintf "stopped with signal %d" i - -let merge root1 root2 path id ui1 ui2 showMergeFn = - debug (fun () -> Util.msg "merge path %s between roots %s and %s\n" - (Path.toString path) (root2string root1) (root2string root2)); - - (* The following assumes root1 is always local: switch them if needed to make this so *) - let (root1,root2) = - match root1 with - (Local,fspath1) -> (root1,root2) - | _ -> (root2,root1) in - - let (localPath1, (workingDirForMerge, basep), fspath1) = - match root1 with - (Local,fspath1) -> - let localPath1 = Update.translatePathLocal fspath1 path in - (localPath1, Fspath.findWorkingDir fspath1 localPath1, fspath1) - | _ -> assert false in - - (* We're going to be doing a lot of copying, so let's define a shorthand - that fixes most of the arguments to Copy.localfile *) - let copy l = - Safelist.iter - (fun (src,trg) -> - debug (fun () -> Util.msg "Copying %s to %s\n" (Path.toString src) (Path.toString trg)); - Os.delete workingDirForMerge trg; - let info = Fileinfo.get false workingDirForMerge src in - Copy.localFile - workingDirForMerge src - workingDirForMerge trg trg - `Copy info.Fileinfo.desc - (Osx.ressLength info.Fileinfo.osX.Osx.ressInfo) (Some id)) - l in - - let working1 = Path.addPrefixToFinalName basep (tempName "merge1-") in - let working2 = Path.addPrefixToFinalName basep (tempName "merge2-") in - let workingarch = Path.addPrefixToFinalName basep (tempName "mergearch-") in - let new1 = Path.addPrefixToFinalName basep (tempName "mergenew1-") in - let new2 = Path.addPrefixToFinalName basep (tempName "mergenew2-") in - let newarch = Path.addPrefixToFinalName basep (tempName "mergenewarch-") in - - let (desc1, fp1, ress1, desc2, fp2, ress2) = Common.fileInfos ui1 ui2 in - - Util.convertUnixErrorsToTransient "merging files" (fun () -> - (* Install finalizer (below) in case we unwind the stack *) - Util.finalize (fun () -> - - (* Make local copies of the two replicas *) - Os.delete workingDirForMerge working1; - Os.delete workingDirForMerge working2; - Os.delete workingDirForMerge workingarch; - Lwt_unix.run - (Copy.file - root1 localPath1 root1 workingDirForMerge working1 basep - `Copy desc1 fp1 ress1 id); - Lwt_unix.run - (Update.translatePath root2 path >>= (fun path -> - Copy.file - root2 path root1 workingDirForMerge working2 basep - `Copy desc2 fp2 ress2 id)); - - (* retrieve the archive for this file, if any *) - let arch = - match ui1, ui2 with - | Updates (_, Previous (_,_,dig,_)), Updates (_, Previous (_,_,dig2,_)) -> - if dig = dig2 then - Stasher.getRecentVersion fspath1 localPath1 dig - else - assert false - | NoUpdates, Updates(_, Previous (_,_,dig,_)) - | Updates(_, Previous (_,_,dig,_)), NoUpdates -> - Stasher.getRecentVersion fspath1 localPath1 dig - | Updates (_, New), Updates(_, New) - | Updates (_, New), NoUpdates - | NoUpdates, Updates (_, New) -> - debug (fun () -> Util.msg "File is new, no current version will be searched"); - None - | _ -> assert false in - - (* Make a local copy of the archive file (in case the merge program - overwrites it and the program crashes before the call to the Stasher). *) - begin - match arch with - Some fspath -> - let info = Fileinfo.get false fspath Path.empty in - Copy.localFile - fspath Path.empty - workingDirForMerge workingarch workingarch - `Copy - info.Fileinfo.desc - (Osx.ressLength info.Fileinfo.osX.Osx.ressInfo) - None - | None -> - () - end; - - (* run the merge command *) - Os.delete workingDirForMerge new1; - Os.delete workingDirForMerge new2; - Os.delete workingDirForMerge newarch; - let info1 = Fileinfo.get false workingDirForMerge working1 in - (* FIX: Why split out the parts of the pair? Why is it not abstract anyway??? *) - let dig1 = Os.fingerprint workingDirForMerge working1 info1 in - let info2 = Fileinfo.get false workingDirForMerge working2 in - let dig2 = Os.fingerprint workingDirForMerge working2 info2 in - let cmd = formatMergeCmd - path - (Os.quotes (Fspath.concatToString workingDirForMerge working1)) - (Os.quotes (Fspath.concatToString workingDirForMerge working2)) - (match arch with None -> None | Some f -> Some(Os.quotes (Fspath.toString f))) - (Os.quotes (Fspath.concatToString workingDirForMerge new1)) - (Os.quotes (Fspath.concatToString workingDirForMerge new2)) - (Os.quotes (Fspath.concatToString workingDirForMerge newarch)) in - Trace.log (Printf.sprintf "Merge command: %s\n" cmd); - - let returnValue, mergeResultLog = External.runExternalProgram cmd in - - Trace.log (Printf.sprintf "Merge result (%s):\n%s\n" - (showStatus returnValue) mergeResultLog); - debug (fun () -> Util.msg "Merge result = %s\n" - (showStatus returnValue)); - - (* This query to the user probably belongs below, after we've gone through all the - logic that might raise exceptions in various conditions. But it has the side effect of - *displaying* the results of the merge (or putting them in a "details" area), so we don't - want to skip doing it if we raise one of these exceptions. Better might be to split out - the displaying from the querying... *) - if not - (showMergeFn - (Printf.sprintf "Results of merging %s" (Path.toString path)) - mergeResultLog) then - raise (Util.Transient ("Merge command canceled by the user")); - - (* It's useful for now to be a bit verbose about what we're doing, but let's - keep it easy to switch this to debug-only in some later release... *) - let say f = f() in - - (* Check which files got created by the merge command and do something appropriate - with them *) - debug (fun()-> Util.msg "New file 1 = %s\n" (Fspath.concatToString workingDirForMerge new1)); - let new1exists = Sys.file_exists (Fspath.concatToString workingDirForMerge new1) in - let new2exists = Sys.file_exists (Fspath.concatToString workingDirForMerge new2) in - let newarchexists = Sys.file_exists (Fspath.concatToString workingDirForMerge newarch) in - - if new1exists && new2exists then begin - if newarchexists then - say (fun () -> Util.msg "Three outputs detected \n") - else - say (fun () -> Util.msg "Two outputs detected \n"); - let info1 = Fileinfo.get false workingDirForMerge new1 in - let info2 = Fileinfo.get false workingDirForMerge new2 in - let dig1' = Os.fingerprint workingDirForMerge new1 info1 in - let dig2' = Os.fingerprint workingDirForMerge new2 info2 in - if dig1'=dig2' then begin - debug (fun () -> Util.msg "Two outputs equal => update the archive\n"); - copy [(new1,working1); (new2,working2); (new1,workingarch)]; - end else - if returnValue = Unix.WEXITED 0 then begin - say (fun () -> (Util.msg "Two outputs not equal but merge command returned 0, so we will\n"; - Util.msg "overwrite the other replica and the archive with the first output\n")); - copy [(new1,working1); (new1,working2); (new1,workingarch)]; - end else begin - say (fun () -> (Util.msg "Two outputs not equal and the merge command exited with nonzero status, \n"; - Util.msg "so we will copy back the new files but not update the archive\n")); - copy [(new1,working1); (new2,working2)]; - - end - end - - else if new1exists && (not new2exists) && (not newarchexists) then begin - if returnValue = Unix.WEXITED 0 then begin - say (fun () -> Util.msg "One output detected \n"); - copy [(new1,working1); (new1,working2); (new1,workingarch)]; - end else begin - say (fun () -> Util.msg "One output detected but merge command returned nonzero exit status\n"); - raise (Util.Transient "One output detected but merge command returned nonzero exit status\n") - end - end - - else if (not new1exists) && new2exists && (not newarchexists) then begin - assert false - end - - else if (not new1exists) && (not new2exists) && (not newarchexists) then begin - say (fun () -> Util.msg "No outputs detected \n"); - let working1_still_exists = Sys.file_exists (Fspath.concatToString workingDirForMerge working1) in - let working2_still_exists = Sys.file_exists (Fspath.concatToString workingDirForMerge working2) in - - if working1_still_exists && working2_still_exists then begin - say (fun () -> Util.msg "No output from merge cmd and both original files are still present\n"); - let info1' = Fileinfo.get false workingDirForMerge working1 in - let dig1' = Os.fingerprint workingDirForMerge working1 info1' in - let info2' = Fileinfo.get false workingDirForMerge working2 in - let dig2' = Os.fingerprint workingDirForMerge working2 info2' in - if dig1 = dig1' && dig2 = dig2' then - raise (Util.Transient "Merge program didn't change either temp file"); - if dig1' = dig2' then begin - say (fun () -> Util.msg "Merge program made files equal\n"); - copy [(working1,workingarch)]; - end else if dig2 = dig2' then begin - say (fun () -> Util.msg "Merge program changed just first input\n"); - copy [(working1,working2);(working1,workingarch)] - end else if dig1 = dig1' then begin - say (fun () -> Util.msg "Merge program changed just second input\n"); - copy [(working2,working1);(working2,workingarch)] - end else - if returnValue <> Unix.WEXITED 0 then - raise (Util.Transient ("Error: the merge function changed both of " - ^ "its inputs but did not make them equal")) - else begin - say (fun () -> (Util.msg "Merge program changed both of its inputs in"; - Util.msg "different ways, but returned zero.\n")); - (* Note that we assume the merge program knew what it was doing when it - returned 0 -- i.e., we assume a zero result means that the files are - "morally equal" and either can be replaced by the other; we therefore - choose one of them (#2) as the unique new result, so that we can update - Unison's archive and call the file 'in sync' again. *) - copy [(working2,working1);(working2,workingarch)]; - end - end - - else if working1_still_exists && (not working2_still_exists) - && returnValue = Unix.WEXITED 0 then begin - say (fun () -> Util.msg "No outputs and second replica has been deleted \n"); - copy [(working1,working2); (working1,workingarch)]; - end - - else if (not working1_still_exists) && working2_still_exists - && returnValue = Unix.WEXITED 0 then begin - say (fun () -> Util.msg "No outputs and first replica has been deleted \n"); - copy [(working2,working1); (working2,workingarch)]; - end - else if returnValue = Unix.WEXITED 0 then begin - raise (Util.Transient ("Error: the merge program deleted both of its " - ^ "inputs and generated no output!")) - end else begin - say (fun() -> Util.msg "The merge program exited with nonzero status and did not leave"; - Util.msg " both files equal"); - raise (Util.Transient ("Error: the merge program failed and did not leave" - ^ " both files equal")) - end - end else begin - assert false - end; - - Lwt_unix.run - (debug (fun () -> Util.msg "Committing results of merge\n"); - copyBack workingDirForMerge working1 root1 path desc1 ui1 id >>= (fun () -> - copyBack workingDirForMerge working2 root2 path desc2 ui2 id >>= (fun () -> - let arch_fspath = Fspath.concat workingDirForMerge workingarch in - if (Sys.file_exists (Fspath.toString arch_fspath)) then begin - debug (fun () -> Util.msg "Updating unison archives for %s to reflect results of merge\n" - (Path.toString path)); - if not (Stasher.shouldBackupCurrent path) then - Util.msg "Warning: 'backupcurrent' is not set for path %s\n" (Path.toString path); - Stasher.stashCurrentVersion workingDirForMerge localPath1 (Some workingarch); - let infoarch = Fileinfo.get false workingDirForMerge workingarch in - let dig = Os.fingerprint arch_fspath Path.empty infoarch in - debug (fun () -> Util.msg "New digest is %s\n" (Os.fullfingerprint_to_string dig)); - let new_archive_entry = - Update.ArchiveFile - (Props.get (Fspath.stat arch_fspath) infoarch.osX, dig, - Fileinfo.stamp (Fileinfo.get true arch_fspath Path.empty), - Osx.stamp infoarch.osX) in - Update.transaction - (fun transid -> - Update.replaceArchive root1 path - (Some(workingDirForMerge, workingarch)) - new_archive_entry transid false false >>= (fun _ -> - Update.replaceArchive root2 path - (Some(workingDirForMerge, workingarch)) - new_archive_entry transid false false >>= (fun _ -> - Lwt.return ()))) - end else - (Lwt.return ()) )))) ) - (fun _ -> - Util.ignoreTransientErrors - (fun () -> - if not (Prefs.read keeptempfilesaftermerge) then begin - Os.delete workingDirForMerge working1; - Os.delete workingDirForMerge working2; - Os.delete workingDirForMerge workingarch; - Os.delete workingDirForMerge new1; - Os.delete workingDirForMerge new2; - Os.delete workingDirForMerge newarch - end)) Copied: branches/2.32/src/files.ml (from rev 320, trunk/src/files.ml) =================================================================== --- branches/2.32/src/files.ml (rev 0) +++ branches/2.32/src/files.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,931 @@ +(* Unison file synchronizer: src/files.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +open Common +open Lwt +open Fileinfo + +let debug = Trace.debug "files" +let debugverbose = Trace.debug "files+" + +(* ------------------------------------------------------------ *) + +let commitLogName = Util.fileInHomeDir "DANGER.README" + +let writeCommitLog source target tempname = + let sourcename = Fspath.toString source in + let targetname = Fspath.toString target in + debug (fun() -> Util.msg "Writing commit log: renaming %s to %s via %s\n" + sourcename targetname tempname); + Util.convertUnixErrorsToFatal + "writing commit log" + (fun () -> + let c = + open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_excl] + 0o600 commitLogName in + Printf.fprintf c "Warning: the last run of %s terminated abnormally " + Uutil.myName; + Printf.fprintf c "while moving\n %s\nto\n %s\nvia\n %s\n\n" + sourcename targetname tempname; + Printf.fprintf c "Please check the state of these files immediately\n"; + Printf.fprintf c "(and delete this notice when you've done so).\n"; + close_out c) + +let clearCommitLog () = + debug (fun() -> (Util.msg "Deleting commit log\n")); + Util.convertUnixErrorsToFatal + "clearing commit log" + (fun () -> Unix.unlink commitLogName) + +let processCommitLog () = + if Sys.file_exists commitLogName then begin + raise(Util.Fatal( + Printf.sprintf + "Warning: the previous run of %s terminated in a dangerous state. + Please consult the file %s, delete it, and try again." + Uutil.myName + commitLogName)) + end else + Lwt.return () + +let processCommitLogOnHost = + Remote.registerHostCmd "processCommitLog" processCommitLog + +let processCommitLogs() = + Lwt_unix.run + (Globals.allHostsIter (fun h -> processCommitLogOnHost h ())) + +(* ------------------------------------------------------------ *) + +let deleteLocal (fspath, (workingDirOpt, path)) = + (* when the workingDirectory is set, we are dealing with a temporary file *) + (* so we don't call the stasher in this case. *) + begin match workingDirOpt with + Some p -> + debug (fun () -> Util.msg "deleteLocal [%s] (%s, %s)\n" (Fspath.toString fspath) (Fspath.toString p) (Path.toString path)); + Os.delete p path + | None -> + debug (fun () -> Util.msg "deleteLocal [%s] (None, %s)\n" (Fspath.toString fspath) (Path.toString path)); + Stasher.backup fspath path `AndRemove + end; + Lwt.return () + +let performDelete = Remote.registerRootCmd "delete" deleteLocal + +(* FIX: maybe we should rename the destination before making any check ? *) +let delete rootFrom pathFrom rootTo pathTo ui = + Update.transaction (fun id -> + Update.replaceArchive rootFrom pathFrom None Update.NoArchive id true false + >>= (fun _ -> + (* Unison do the next line cause we want to keep a backup of the file. + FIX: We only need this when we are making backups *) + Update.updateArchive rootTo pathTo ui id >>= (fun _ -> + Update.replaceArchive + rootTo pathTo None Update.NoArchive id true false + >>= (fun localPathTo -> + (* Make sure the target is unchanged *) + (* (There is an unavoidable race condition here.) *) + Update.checkNoUpdates rootTo pathTo ui >>= (fun () -> + performDelete rootTo (None, localPathTo)))))) + +(* ------------------------------------------------------------ *) + +let setPropRemote = + Remote.registerRootCmd + "setProp" + (fun (fspath, (workingDir, path, kind, newDesc)) -> + Fileinfo.set workingDir path kind newDesc; + Lwt.return ()) + +let setPropRemote2 = + Remote.registerRootCmd + "setProp2" + (fun (fspath, (path, kind, newDesc)) -> + let (workingDir,realPath) = Fspath.findWorkingDir fspath path in + Fileinfo.set workingDir realPath kind newDesc; + Lwt.return ()) + +(* FIX: we should check there has been no update before performing the + change *) +let setProp fromRoot fromPath toRoot toPath newDesc oldDesc uiFrom uiTo = + debug (fun() -> + Util.msg + "setProp %s %s %s\n %s %s %s\n" + (root2string fromRoot) (Path.toString fromPath) + (Props.toString newDesc) + (root2string toRoot) (Path.toString toPath) + (Props.toString oldDesc)); + Update.transaction (fun id -> + Update.updateProps fromRoot fromPath None uiFrom id >>= (fun _ -> + (* [uiTo] provides the modtime while [desc] provides the other + file properties *) + Update.updateProps toRoot toPath (Some newDesc) uiTo id >>= + (fun toLocalPath -> + setPropRemote2 toRoot (toLocalPath, `Update oldDesc, newDesc)))) + +(* ------------------------------------------------------------ *) + +let mkdirRemote = + Remote.registerRootCmd + "mkdir" + (fun (fspath,(workingDir,path)) -> + let createIt() = Os.createDir workingDir path Props.dirDefault in + if Os.exists workingDir path then + if (Fileinfo.get false workingDir path).Fileinfo.typ <> `DIRECTORY then begin + Os.delete workingDir path; + createIt() + end else () + else + createIt(); + Lwt.return (Fileinfo.get false workingDir path).Fileinfo.desc) + +let mkdir onRoot workingDir path = mkdirRemote onRoot (workingDir,path) + +(* ------------------------------------------------------------ *) + +let renameLocal (root, (localTargetPath, fspath, pathFrom, pathTo)) = + debug (fun () -> Util.msg "Renaming %s to %s in %s; root is %s\n" + (Path.toString pathFrom) + (Path.toString pathTo) + (Fspath.toString fspath) + (Fspath.toString root)); + let source = Fspath.concat fspath pathFrom in + let target = Fspath.concat fspath pathTo in + Util.convertUnixErrorsToTransient + (Printf.sprintf "renaming %s to %s" + (Fspath.toString source) (Fspath.toString target)) + (fun () -> + debugverbose (fun() -> + Util.msg "calling Fileinfo.get from renameLocal\n"); + let filetypeFrom = + (Fileinfo.get false source Path.empty).Fileinfo.typ in + debugverbose (fun() -> + Util.msg "back from Fileinfo.get from renameLocal\n"); + if filetypeFrom = `ABSENT then raise (Util.Transient (Printf.sprintf + "Error while renaming %s to %s -- source file has disappeared!" + (Fspath.toString source) (Fspath.toString target))); + let filetypeTo = + (Fileinfo.get false target Path.empty).Fileinfo.typ in + + (* Windows and Unix operate differently if the target path of a + rename already exists: in Windows an exception is raised, in + Unix the file is clobbered. In both Windows and Unix, if + the target is an existing **directory**, an exception will + be raised. We want to avoid doing the move first, if possible, + because this opens a "window of danger" during which the contents of + the path is nothing. *) + let moveFirst = + match (filetypeFrom, filetypeTo) with + | (_, `ABSENT) -> false + | ((`FILE | `SYMLINK), + (`FILE | `SYMLINK)) -> Util.osType <> `Unix + | _ -> true (* Safe default *) in + if moveFirst then begin + debug (fun() -> Util.msg "rename: moveFirst=true\n"); + let tmpPath = Os.tempPath fspath pathTo in + let temp = Fspath.concat fspath tmpPath in + let temp' = Fspath.toString temp in + + debug (fun() -> Util.msg "moving %s to %s\n" (Fspath.toString target) temp'); + Stasher.backup root localTargetPath `ByCopying; + writeCommitLog source target temp'; + Util.finalize (fun() -> + (* If the first rename fails, the log can be removed: the + filesystem is in a consistent state *) + Os.rename "renameLocal(1)" target Path.empty temp Path.empty; + (* If the next renaming fails, we will be left with + DANGER.README file which will make any other + (similar) renaming fail in a cryptic way. So it + seems better to abort early by converting Unix errors + to Fatal ones (rather than Transient). *) + Util.convertUnixErrorsToFatal "renaming with commit log" + (fun () -> + debug (fun() -> Util.msg "rename %s to %s\n" + (Fspath.toString source) (Fspath.toString target)); + Os.rename "renameLocal(2)" + source Path.empty target Path.empty)) + (fun _ -> clearCommitLog()); + (* It is ok to leave a temporary file. So, the log can be + cleared before deleting it. *) + Os.delete temp Path.empty + end else begin + debug (fun() -> Util.msg "rename: moveFirst=false\n"); + Stasher.backup root localTargetPath `ByCopying; + Os.rename "renameLocal(3)" source Path.empty target Path.empty; + debug (fun() -> + if filetypeFrom = `FILE then + Util.msg + "Contents of %s after renaming = %s\n" + (Fspath.toString target) + (Fingerprint.toString (Fingerprint.file target Path.empty))); + end; + Lwt.return ()) + +let renameOnHost = Remote.registerRootCmd "rename" renameLocal + +(* FIX: maybe we should rename the destination before making any check ? *) +(* FIX: When this code was originally written, we assumed that the + checkNoUpdates would happen immediately before the renameOnHost, so that + the window of danger where other processes could invalidate the thing we + just checked was very small. But now that transport is multi-threaded, + this window of danger could get very long because other transfers are + saturating the link. It would be better, I think, to introduce a real + 2PC protocol here, so that both sides would (locally and almost-atomically) + check that their assumptions had not been violated and then switch the + temp file into place, but remain able to roll back if something fails + either locally or on the other side. *) +let rename root pathInArchive localPath workingDir pathOld pathNew ui = + debug (fun() -> + Util.msg "rename(root=%s, pathOld=%s, pathNew=%s)\n" + (root2string root) + (Path.toString pathOld) (Path.toString pathNew)); + (* Make sure the target is unchanged, then do the rename. + (Note that there is an unavoidable race condition here...) *) + Update.checkNoUpdates root pathInArchive ui >>= (fun () -> + renameOnHost root (localPath, workingDir, pathOld, pathNew)) + +(* ------------------------------------------------------------ *) + +let checkContentsChangeLocal + currfspath path archDesc archDig archStamp archRess = + let info = Fileinfo.get true currfspath path in + if Props.length archDesc <> Props.length info.Fileinfo.desc then + raise (Util.Transient (Printf.sprintf + "The file %s\nhas been modified during synchronization. \ + Transfer aborted." + (Fspath.concatToString currfspath path))); + match archStamp with + Fileinfo.InodeStamp inode + when info.Fileinfo.inode = inode + && Props.same_time info.Fileinfo.desc archDesc -> + () + | _ -> + (* Note that we fall back to the paranoid check (using a fingerprint) + even if a CtimeStamp was provided, since we do not trust them + completely. *) + let (info, newDig) = Os.safeFingerprint currfspath path info None in + if archDig <> newDig then + raise (Util.Transient (Printf.sprintf + "The file %s\nhas been modified during synchronization. \ + Transfer aborted.%s" + (Fspath.concatToString currfspath path) + (if Update.useFastChecking () + && Props.same_time info.Fileinfo.desc archDesc + then + " If this happens repeatedly, try running once with the \ + fastcheck option set to 'no'" + else + ""))) + +let checkContentsChangeOnHost = + Remote.registerRootCmd + "checkContentsChange" + (fun (currfspath, (path, archDesc, archDig, archStamp, archRess)) -> + checkContentsChangeLocal + currfspath path archDesc archDig archStamp archRess; + Lwt.return ()) + +let checkContentsChange root path archDesc archDig archStamp archRess = + checkContentsChangeOnHost root (path, archDesc, archDig, archStamp, archRess) + +(* ------------------------------------------------------------ *) + +(* Calculate the target working directory and paths for the copy. + workingDir is an fspath naming the directory on the target + host where the copied file will actually live. + (In the case where pathTo names a symbolic link, this + will be the parent directory of the file that the + symlink points to, not the symlink itself. Note that + this fspath may be outside of the replica, or even + on a different volume.) + realPathTo is the name of the target file relative to workingDir. + (If pathTo names a symlink, this will be the name of + the file pointed to by the symlink, not the name of the + link itself.) + tempPathTo is a temporary file name in the workingDir. The file (or + directory structure) will first be copied here, then + "almost atomically" moved onto realPathTo. *) + +let setupTargetPathsLocal (fspath, path) = + let localPath = Update.translatePathLocal fspath path in + let (workingDir,realPath) = Fspath.findWorkingDir fspath localPath in + let tempPath = Os.tempPath ~fresh:false workingDir realPath in + Lwt.return (workingDir, realPath, tempPath, localPath) + +let setupTargetPaths = + Remote.registerRootCmd "setupTargetPaths" setupTargetPathsLocal + +(* ------------------------------------------------------------ *) + +let makeSymlink = + Remote.registerRootCmd + "makeSymlink" + (fun (fspath, (workingDir, path, l)) -> + if Os.exists workingDir path then + Os.delete workingDir path; + Os.symlink workingDir path l; + Lwt.return ()) + +let copyReg = Lwt_util.make_region 50 + +let copy + update + rootFrom pathFrom (* copy from here... *) + uiFrom (* (and then check that this updateItem still + describes the current state of the src replica) *) + rootTo pathTo (* ...to here *) + uiTo (* (but, before committing the copy, check that + this updateItem still describes the current + state of the target replica) *) + id = (* for progress display *) + debug (fun() -> + Util.msg + "copy %s %s ---> %s %s \n" + (root2string rootFrom) (Path.toString pathFrom) + (root2string rootTo) (Path.toString pathTo)); + (* Calculate target paths *) + setupTargetPaths rootTo pathTo + >>= (fun (workingDir, realPathTo, tempPathTo, localPathTo) -> + (* Inner loop for recursive copy... *) + let rec copyRec pFrom (* Path to copy from *) + pTo (* (Temp) path to copy to *) + realPTo (* Path where this file will ultimately be placed + (needed by rsync, which uses the old contents + of this file to optimize transfer) *) + f = (* Source archive subtree for this path *) + debug (fun() -> + Util.msg "copyRec %s --> %s (really to %s)\n" + (Path.toString pFrom) (Path.toString pTo) + (Path.toString realPTo)); + match f with + Update.ArchiveFile (desc, dig, stamp, ress) -> + Lwt_util.run_in_region copyReg 1 (fun () -> + Abort.check id; + Copy.file + rootFrom pFrom rootTo workingDir pTo realPTo + update desc dig ress id + >>= (fun () -> + checkContentsChange rootFrom pFrom desc dig stamp ress)) + | Update.ArchiveSymlink l -> + Lwt_util.run_in_region copyReg 1 (fun () -> + debug (fun() -> Util.msg "Making symlink %s/%s -> %s\n" + (root2string rootTo) (Path.toString pTo) l); + Abort.check id; + makeSymlink rootTo (workingDir, pTo, l)) + | Update.ArchiveDir (desc, children) -> + Lwt_util.run_in_region copyReg 1 (fun () -> + debug (fun() -> Util.msg "Creating directory %s/%s\n" + (root2string rootTo) (Path.toString pTo)); + mkdir rootTo workingDir pTo) >>= (fun initialDesc -> + Abort.check id; + let runningThreads = ref [] in + Lwt.catch + (fun () -> + Update.NameMap.iter + (fun name child -> + let thread = + copyRec (Path.child pFrom name) + (Path.child pTo name) + (Path.child realPTo name) + child + in + runningThreads := thread :: !runningThreads) + children; + Lwt_util.join !runningThreads) + (fun e -> + (* If one thread fails (in a non-fatal way), we wait for + all other threads to terminate before continuing *) + if not (Abort.testException e) then Abort.file id; + match e with + Util.Transient _ -> + let e = ref e in + Lwt_util.iter + (fun act -> + Lwt.catch + (fun () -> act) + (fun e' -> + match e' with + Util.Transient _ -> + if Abort.testException !e then e := e'; + Lwt.return () + | _ -> + Lwt.fail e')) + !runningThreads >>= (fun () -> + Lwt.fail !e) + | _ -> + Lwt.fail e) >>= (fun () -> + Lwt_util.run_in_region copyReg 1 (fun () -> + (* We use the actual file permissions so as to preserve + inherited bits *) + Abort.check id; + setPropRemote rootTo + (workingDir, pTo, `Set initialDesc, desc)))) + | Update.NoArchive -> + assert false + in + (* BCP (6/08): We used to have an unwindProtect here that would *always* do the + final performDelete. This was removed so that failed partial transfers can + be restarted. We instead remove individual failing files (not + directories) inside replaceArchive. *) + Update.transaction (fun id -> + (* Update the archive on the source replica (but don't commit + the changes yet) and return the part of the new archive + corresponding to this path *) + Update.updateArchive rootFrom pathFrom uiFrom id + >>= (fun (localPathFrom, archFrom) -> + let make_backup = + (* Perform (asynchronously) a backup of the destination files *) + Update.updateArchive rootTo pathTo uiTo id + in + copyRec localPathFrom tempPathTo realPathTo archFrom >>= (fun () -> + make_backup >>= (fun _ -> + Update.replaceArchive + rootTo pathTo (Some (workingDir, tempPathTo)) + archFrom id true true >>= (fun _ -> + rename rootTo pathTo localPathTo workingDir tempPathTo realPathTo uiTo >>= (fun() -> + debug (fun() -> Util.msg "Removing temp files\n"); + performDelete rootTo (Some workingDir, tempPathTo) ))))))) + +(* ------------------------------------------------------------ *) + +let (>>=) = Lwt.bind + +let diffCmd = + Prefs.createString "diff" "diff -u CURRENT2 CURRENT1" + "!command for showing differences between files" + ("This preference can be used to control the name and command-line " + ^ "arguments of the system " + ^ "utility used to generate displays of file differences. The default " + ^ "is `\\verb|diff -u CURRENT2 CURRENT1|'. If the value of this preference contains the substrings " + ^ "CURRENT1 and CURRENT2, these will be replaced by the names of the files to be " + ^ "diffed. If not, the two filenames will be appended to the command. In both " + ^ "cases, the filenames are suitably quoted.") + +let tempName s = Os.tempFilePrefix ^ s + +let rec diff root1 path1 ui1 root2 path2 ui2 showDiff id = + debug (fun () -> + Util.msg + "diff %s %s %s %s ...\n" + (root2string root1) (Path.toString path1) + (root2string root2) (Path.toString path2)); + let displayDiff fspath1 fspath2 = + let cmd = + if Util.findsubstring "CURRENT1" (Prefs.read diffCmd) = None then + (Prefs.read diffCmd) + ^ " " ^ (Os.quotes (Fspath.toString fspath1)) + ^ " " ^ (Os.quotes (Fspath.toString fspath2)) + else + Util.replacesubstrings (Prefs.read diffCmd) + ["CURRENT1", Os.quotes (Fspath.toString fspath1); + "CURRENT2", Os.quotes (Fspath.toString fspath2)] in + (* Doesn't seem to work well on Windows! + let c = Lwt_unix.run (Lwt_unix.open_process_in cmd) in *) + let c = Unix.open_process_in + (if Util.osType = `Win32 && not Util.isCygwin then + (* BCP: Proposed by Karl M. to deal with the standard windows + command processor's weird treatment of spaces and quotes: *) + "\"" ^ cmd ^ "\"" + else + cmd) in + showDiff cmd (External.readChannelTillEof c); + ignore (Unix.close_process_in c) in + let (desc1, fp1, ress1, desc2, fp2, ress2) = Common.fileInfos ui1 ui2 in + match root1,root2 with + (Local,fspath1),(Local,fspath2) -> + Util.convertUnixErrorsToTransient + "diffing files" + (fun () -> + let path1 = Update.translatePathLocal fspath1 path1 in + let path2 = Update.translatePathLocal fspath2 path2 in + displayDiff + (Fspath.concat fspath1 path1) (Fspath.concat fspath2 path2)) + | (Local,fspath1),(Remote host2,fspath2) -> + Util.convertUnixErrorsToTransient + "diffing files" + (fun () -> + let path1 = Update.translatePathLocal fspath1 path1 in + let (workingDir, realPath) = Fspath.findWorkingDir fspath1 path1 in + let tmppath = + Path.addSuffixToFinalName realPath (tempName "diff-") in + Os.delete workingDir tmppath; + Lwt_unix.run + (Update.translatePath root2 path2 >>= (fun path2 -> + Copy.file root2 path2 root1 workingDir tmppath realPath + `Copy (Props.setLength Props.fileSafe (Props.length desc2)) + fp2 ress2 id)); + displayDiff + (Fspath.concat workingDir realPath) + (Fspath.concat workingDir tmppath); + Os.delete workingDir tmppath) + | (Remote host1,fspath1),(Local,fspath2) -> + Util.convertUnixErrorsToTransient + "diffing files" + (fun () -> + let path2 = Update.translatePathLocal fspath2 path2 in + let (workingDir, realPath) = Fspath.findWorkingDir fspath2 path2 in + let tmppath = + Path.addSuffixToFinalName realPath "#unisondiff-" in + Lwt_unix.run + (Update.translatePath root1 path1 >>= (fun path1 -> + (* Note that we don't need the resource fork *) + Copy.file root1 path1 root2 workingDir tmppath realPath + `Copy (Props.setLength Props.fileSafe (Props.length desc1)) + fp1 ress1 id)); + displayDiff + (Fspath.concat workingDir tmppath) + (Fspath.concat workingDir realPath); + Os.delete workingDir tmppath) + | (Remote host1,fspath1),(Remote host2,fspath2) -> + assert false + + +(**********************************************************************) + +(* Taken from ocamltk/jpf/fileselect.ml *) +let get_files_in_directory dir = + let dirh = Fspath.opendir (Fspath.canonize (Some dir)) in + let files = ref [] in + begin try + while true do files := Unix.readdir dirh :: !files done + with End_of_file -> + Unix.closedir dirh + end; + Sort.list (<) !files + +let ls dir pattern = + Util.convertUnixErrorsToTransient + "listing files" + (fun () -> + let files = get_files_in_directory dir in + let re = Rx.glob pattern in + let rec filter l = + match l with + [] -> + [] + | hd :: tl -> + if Rx.match_string re hd then hd :: filter tl else filter tl + in + filter files) + + +(*********************************************************************** + CALL OUT TO EXTERNAL MERGE PROGRAM +************************************************************************) + +let formatMergeCmd p f1 f2 backup out1 out2 outarch = + if not (Globals.shouldMerge p) then + raise (Util.Transient ("'merge' preference not set for "^(Path.toString p))); + let raw = + try Globals.mergeCmdForPath p + with Not_found -> + raise (Util.Transient ("'merge' preference does not provide a command " + ^ "template for " ^ (Path.toString p))) + in + let cooked = raw in + let cooked = Util.replacesubstring cooked "CURRENT1" f1 in + let cooked = Util.replacesubstring cooked "CURRENT2" f2 in + let cooked = + match backup with + None -> begin + let cooked = Util.replacesubstring cooked "CURRENTARCHOPT" "" in + match Util.findsubstring "CURRENTARCH" cooked with + None -> cooked + | Some _ -> raise (Util.Transient + ("No archive found, but the 'merge' command " + ^ "template expects one. (Consider enabling " + ^ "'backupcurrent' for this file or using CURRENTARCHOPT " + ^ "instead of CURRENTARCH.)")) + end + | Some(s) -> + let cooked = Util.replacesubstring cooked "CURRENTARCHOPT" s in + let cooked = Util.replacesubstring cooked "CURRENTARCH" s in + cooked in + let cooked = Util.replacesubstring cooked "NEW1" out1 in + let cooked = Util.replacesubstring cooked "NEW2" out2 in + let cooked = Util.replacesubstring cooked "NEWARCH" outarch in + let cooked = Util.replacesubstring cooked "NEW" out1 in + let cooked = Util.replacesubstring cooked "PATH" (Path.toString p) in + cooked + +let copyBack fspathFrom pathFrom rootTo pathTo propsTo uiTo id = + setupTargetPaths rootTo pathTo + >>= (fun (workingDirForCopy, realPathTo, tempPathTo, localPathTo) -> + let info = Fileinfo.get false fspathFrom pathFrom in + let fp = Os.fingerprint fspathFrom pathFrom info in + let stamp = Osx.stamp info.Fileinfo.osX in + let newprops = Props.setLength propsTo (Props.length info.Fileinfo.desc) in + Copy.file + (Local, fspathFrom) pathFrom rootTo workingDirForCopy tempPathTo realPathTo + `Copy newprops fp stamp id >>= (fun () -> + rename rootTo pathTo localPathTo workingDirForCopy tempPathTo realPathTo + uiTo )) + +let keeptempfilesaftermerge = + Prefs.createBool + "keeptempfilesaftermerge" false "*" "" + +let showStatus = function + | Unix.WEXITED i -> Printf.sprintf "exited (%d)" i + | Unix.WSIGNALED i -> Printf.sprintf "killed with signal %d" i + | Unix.WSTOPPED i -> Printf.sprintf "stopped with signal %d" i + +let merge root1 root2 path id ui1 ui2 showMergeFn = + debug (fun () -> Util.msg "merge path %s between roots %s and %s\n" + (Path.toString path) (root2string root1) (root2string root2)); + + (* The following assumes root1 is always local: switch them if needed to make this so *) + let (root1,root2) = + match root1 with + (Local,fspath1) -> (root1,root2) + | _ -> (root2,root1) in + + let (localPath1, (workingDirForMerge, basep), fspath1) = + match root1 with + (Local,fspath1) -> + let localPath1 = Update.translatePathLocal fspath1 path in + (localPath1, Fspath.findWorkingDir fspath1 localPath1, fspath1) + | _ -> assert false in + + (* We're going to be doing a lot of copying, so let's define a shorthand + that fixes most of the arguments to Copy.localfile *) + let copy l = + Safelist.iter + (fun (src,trg) -> + debug (fun () -> Util.msg "Copying %s to %s\n" (Path.toString src) (Path.toString trg)); + Os.delete workingDirForMerge trg; + let info = Fileinfo.get false workingDirForMerge src in + Copy.localFile + workingDirForMerge src + workingDirForMerge trg trg + `Copy info.Fileinfo.desc + (Osx.ressLength info.Fileinfo.osX.Osx.ressInfo) (Some id)) + l in + + let working1 = Path.addPrefixToFinalName basep (tempName "merge1-") in + let working2 = Path.addPrefixToFinalName basep (tempName "merge2-") in + let workingarch = Path.addPrefixToFinalName basep (tempName "mergearch-") in + let new1 = Path.addPrefixToFinalName basep (tempName "mergenew1-") in + let new2 = Path.addPrefixToFinalName basep (tempName "mergenew2-") in + let newarch = Path.addPrefixToFinalName basep (tempName "mergenewarch-") in + + let (desc1, fp1, ress1, desc2, fp2, ress2) = Common.fileInfos ui1 ui2 in + + Util.convertUnixErrorsToTransient "merging files" (fun () -> + (* Install finalizer (below) in case we unwind the stack *) + Util.finalize (fun () -> + + (* Make local copies of the two replicas *) + Os.delete workingDirForMerge working1; + Os.delete workingDirForMerge working2; + Os.delete workingDirForMerge workingarch; + Lwt_unix.run + (Copy.file + root1 localPath1 root1 workingDirForMerge working1 basep + `Copy desc1 fp1 ress1 id); + Lwt_unix.run + (Update.translatePath root2 path >>= (fun path -> + Copy.file + root2 path root1 workingDirForMerge working2 basep + `Copy desc2 fp2 ress2 id)); + + (* retrieve the archive for this file, if any *) + let arch = + match ui1, ui2 with + | Updates (_, Previous (_,_,dig,_)), Updates (_, Previous (_,_,dig2,_)) -> + if dig = dig2 then + Stasher.getRecentVersion fspath1 localPath1 dig + else + assert false + | NoUpdates, Updates(_, Previous (_,_,dig,_)) + | Updates(_, Previous (_,_,dig,_)), NoUpdates -> + Stasher.getRecentVersion fspath1 localPath1 dig + | Updates (_, New), Updates(_, New) + | Updates (_, New), NoUpdates + | NoUpdates, Updates (_, New) -> + debug (fun () -> Util.msg "File is new, no current version will be searched"); + None + | _ -> assert false in + + (* Make a local copy of the archive file (in case the merge program + overwrites it and the program crashes before the call to the Stasher). *) + begin + match arch with + Some fspath -> + let info = Fileinfo.get false fspath Path.empty in + Copy.localFile + fspath Path.empty + workingDirForMerge workingarch workingarch + `Copy + info.Fileinfo.desc + (Osx.ressLength info.Fileinfo.osX.Osx.ressInfo) + None + | None -> + () + end; + + (* run the merge command *) + Os.delete workingDirForMerge new1; + Os.delete workingDirForMerge new2; + Os.delete workingDirForMerge newarch; + let info1 = Fileinfo.get false workingDirForMerge working1 in + (* FIX: Why split out the parts of the pair? Why is it not abstract anyway??? *) + let dig1 = Os.fingerprint workingDirForMerge working1 info1 in + let info2 = Fileinfo.get false workingDirForMerge working2 in + let dig2 = Os.fingerprint workingDirForMerge working2 info2 in + let cmd = formatMergeCmd + path + (Os.quotes (Fspath.concatToString workingDirForMerge working1)) + (Os.quotes (Fspath.concatToString workingDirForMerge working2)) + (match arch with None -> None | Some f -> Some(Os.quotes (Fspath.toString f))) + (Os.quotes (Fspath.concatToString workingDirForMerge new1)) + (Os.quotes (Fspath.concatToString workingDirForMerge new2)) + (Os.quotes (Fspath.concatToString workingDirForMerge newarch)) in + Trace.log (Printf.sprintf "Merge command: %s\n" cmd); + + let returnValue, mergeResultLog = External.runExternalProgram cmd in + + Trace.log (Printf.sprintf "Merge result (%s):\n%s\n" + (showStatus returnValue) mergeResultLog); + debug (fun () -> Util.msg "Merge result = %s\n" + (showStatus returnValue)); + + (* This query to the user probably belongs below, after we've gone through all the + logic that might raise exceptions in various conditions. But it has the side effect of + *displaying* the results of the merge (or putting them in a "details" area), so we don't + want to skip doing it if we raise one of these exceptions. Better might be to split out + the displaying from the querying... *) + if not + (showMergeFn + (Printf.sprintf "Results of merging %s" (Path.toString path)) + mergeResultLog) then + raise (Util.Transient ("Merge command canceled by the user")); + + (* It's useful for now to be a bit verbose about what we're doing, but let's + keep it easy to switch this to debug-only in some later release... *) + let say f = f() in + + (* Check which files got created by the merge command and do something appropriate + with them *) + debug (fun()-> Util.msg "New file 1 = %s\n" (Fspath.concatToString workingDirForMerge new1)); + let new1exists = Sys.file_exists (Fspath.concatToString workingDirForMerge new1) in + let new2exists = Sys.file_exists (Fspath.concatToString workingDirForMerge new2) in + let newarchexists = Sys.file_exists (Fspath.concatToString workingDirForMerge newarch) in + + if new1exists && new2exists then begin + if newarchexists then + say (fun () -> Util.msg "Three outputs detected \n") + else + say (fun () -> Util.msg "Two outputs detected \n"); + let info1 = Fileinfo.get false workingDirForMerge new1 in + let info2 = Fileinfo.get false workingDirForMerge new2 in + let dig1' = Os.fingerprint workingDirForMerge new1 info1 in + let dig2' = Os.fingerprint workingDirForMerge new2 info2 in + if dig1'=dig2' then begin + debug (fun () -> Util.msg "Two outputs equal => update the archive\n"); + copy [(new1,working1); (new2,working2); (new1,workingarch)]; + end else + if returnValue = Unix.WEXITED 0 then begin + say (fun () -> (Util.msg "Two outputs not equal but merge command returned 0, so we will\n"; + Util.msg "overwrite the other replica and the archive with the first output\n")); + copy [(new1,working1); (new1,working2); (new1,workingarch)]; + end else begin + say (fun () -> (Util.msg "Two outputs not equal and the merge command exited with nonzero status, \n"; + Util.msg "so we will copy back the new files but not update the archive\n")); + copy [(new1,working1); (new2,working2)]; + + end + end + + else if new1exists && (not new2exists) && (not newarchexists) then begin + if returnValue = Unix.WEXITED 0 then begin + say (fun () -> Util.msg "One output detected \n"); + copy [(new1,working1); (new1,working2); (new1,workingarch)]; + end else begin + say (fun () -> Util.msg "One output detected but merge command returned nonzero exit status\n"); + raise (Util.Transient "One output detected but merge command returned nonzero exit status\n") + end + end + + else if (not new1exists) && new2exists && (not newarchexists) then begin + assert false + end + + else if (not new1exists) && (not new2exists) && (not newarchexists) then begin + say (fun () -> Util.msg "No outputs detected \n"); + let working1_still_exists = Sys.file_exists (Fspath.concatToString workingDirForMerge working1) in + let working2_still_exists = Sys.file_exists (Fspath.concatToString workingDirForMerge working2) in + + if working1_still_exists && working2_still_exists then begin + say (fun () -> Util.msg "No output from merge cmd and both original files are still present\n"); + let info1' = Fileinfo.get false workingDirForMerge working1 in + let dig1' = Os.fingerprint workingDirForMerge working1 info1' in + let info2' = Fileinfo.get false workingDirForMerge working2 in + let dig2' = Os.fingerprint workingDirForMerge working2 info2' in + if dig1 = dig1' && dig2 = dig2' then + raise (Util.Transient "Merge program didn't change either temp file"); + if dig1' = dig2' then begin + say (fun () -> Util.msg "Merge program made files equal\n"); + copy [(working1,workingarch)]; + end else if dig2 = dig2' then begin + say (fun () -> Util.msg "Merge program changed just first input\n"); + copy [(working1,working2);(working1,workingarch)] + end else if dig1 = dig1' then begin + say (fun () -> Util.msg "Merge program changed just second input\n"); + copy [(working2,working1);(working2,workingarch)] + end else + if returnValue <> Unix.WEXITED 0 then + raise (Util.Transient ("Error: the merge function changed both of " + ^ "its inputs but did not make them equal")) + else begin + say (fun () -> (Util.msg "Merge program changed both of its inputs in"; + Util.msg "different ways, but returned zero.\n")); + (* Note that we assume the merge program knew what it was doing when it + returned 0 -- i.e., we assume a zero result means that the files are + "morally equal" and either can be replaced by the other; we therefore + choose one of them (#2) as the unique new result, so that we can update + Unison's archive and call the file 'in sync' again. *) + copy [(working2,working1);(working2,workingarch)]; + end + end + + else if working1_still_exists && (not working2_still_exists) + && returnValue = Unix.WEXITED 0 then begin + say (fun () -> Util.msg "No outputs and second replica has been deleted \n"); + copy [(working1,working2); (working1,workingarch)]; + end + + else if (not working1_still_exists) && working2_still_exists + && returnValue = Unix.WEXITED 0 then begin + say (fun () -> Util.msg "No outputs and first replica has been deleted \n"); + copy [(working2,working1); (working2,workingarch)]; + end + else if returnValue = Unix.WEXITED 0 then begin + raise (Util.Transient ("Error: the merge program deleted both of its " + ^ "inputs and generated no output!")) + end else begin + say (fun() -> Util.msg "The merge program exited with nonzero status and did not leave"; + Util.msg " both files equal"); + raise (Util.Transient ("Error: the merge program failed and did not leave" + ^ " both files equal")) + end + end else begin + assert false + end; + + Lwt_unix.run + (debug (fun () -> Util.msg "Committing results of merge\n"); + copyBack workingDirForMerge working1 root1 path desc1 ui1 id >>= (fun () -> + copyBack workingDirForMerge working2 root2 path desc2 ui2 id >>= (fun () -> + let arch_fspath = Fspath.concat workingDirForMerge workingarch in + if (Sys.file_exists (Fspath.toString arch_fspath)) then begin + debug (fun () -> Util.msg "Updating unison archives for %s to reflect results of merge\n" + (Path.toString path)); + if not (Stasher.shouldBackupCurrent path) then + Util.msg "Warning: 'backupcurrent' is not set for path %s\n" (Path.toString path); + Stasher.stashCurrentVersion workingDirForMerge localPath1 (Some workingarch); + let infoarch = Fileinfo.get false workingDirForMerge workingarch in + let dig = Os.fingerprint arch_fspath Path.empty infoarch in + debug (fun () -> Util.msg "New digest is %s\n" (Os.fullfingerprint_to_string dig)); + let new_archive_entry = + Update.ArchiveFile + (Props.get (Fspath.stat arch_fspath) infoarch.osX, dig, + Fileinfo.stamp (Fileinfo.get true arch_fspath Path.empty), + Osx.stamp infoarch.osX) in + Update.transaction + (fun transid -> + Update.replaceArchive root1 path + (Some(workingDirForMerge, workingarch)) + new_archive_entry transid false false >>= (fun _ -> + Update.replaceArchive root2 path + (Some(workingDirForMerge, workingarch)) + new_archive_entry transid false false >>= (fun _ -> + Lwt.return ()))) + end else + (Lwt.return ()) )))) ) + (fun _ -> + Util.ignoreTransientErrors + (fun () -> + if not (Prefs.read keeptempfilesaftermerge) then begin + Os.delete workingDirForMerge working1; + Os.delete workingDirForMerge working2; + Os.delete workingDirForMerge workingarch; + Os.delete workingDirForMerge new1; + Os.delete workingDirForMerge new2; + Os.delete workingDirForMerge newarch + end)) Deleted: branches/2.32/src/files.mli =================================================================== --- trunk/src/files.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/files.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,83 +0,0 @@ -(* Unison file synchronizer: src/files.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* As usual, these functions should only be called by the client (i.e., in *) -(* the same address space as the user interface). *) - -(* Delete the given subtree of the given replica *) -val delete : - Common.root (* source root *) - -> Path.t (* deleted path *) - -> Common.root (* root *) - -> Path.t (* path to delete *) - -> Common.updateItem (* updates that will be discarded *) - -> unit Lwt.t - -(* Region used for the copying. Exported to be correctly set in transport.ml *) -(* to the maximum number of threads *) -val copyReg : Lwt_util.region - -(* Copy a path in one replica to another path in a second replica. The copy *) -(* is performed atomically (or as close to atomically as the os will *) -(* support) using temporary files. *) -val copy : - [`Update of (Uutil.Filesize.t * Uutil.Filesize.t) | `Copy] - (* whether there was already a file *) - -> Common.root (* from what root *) - -> Path.t (* from what path *) - -> Common.updateItem (* source updates *) - -> Common.root (* to what root *) - -> Path.t (* to what path *) - -> Common.updateItem (* dest. updates *) - -> Uutil.File.t (* id for showing progress of transfer *) - -> unit Lwt.t - -(* Copy the permission bits from a path in one replica to another path in a *) -(* second replica. *) -val setProp : - Common.root (* source root *) - -> Path.t (* source path *) - -> Common.root (* target root *) - -> Path.t (* target path *) - -> Props.t (* previous properties *) - -> Props.t (* new properties *) - -> Common.updateItem (* source updates *) - -> Common.updateItem (* target updates *) - -> unit Lwt.t - -(* Generate a difference summary for two (possibly remote) versions of a *) -(* file and send it to a given function *) -val diff : - Common.root (* first root *) - -> Path.t (* path on first root *) - -> Common.updateItem (* first root updates *) - -> Common.root (* other root *) - -> Path.t (* path on other root *) - -> Common.updateItem (* target updates *) - -> (string->string->unit) (* how to display the (title and) result *) - -> Uutil.File.t (* id for showing progress of transfer *) - -> unit - -(* This should be called at the beginning of execution, to detect and clean *) -(* up any pending file operations left over from previous (abnormally *) -(* terminated) synchronizations *) -val processCommitLogs : unit -> unit - -(* List the files in a directory matching a pattern. (It would be better - to use fspath, etc., here instead of string) *) -val ls : string -> string -> string list - -val get_files_in_directory : string -> string list - -val merge : - Common.root (* first root *) - -> Common.root (* second root *) - -> Path.t (* path to merge *) - -> Uutil.File.t (* id for showing progress of transfer *) - -> Common.updateItem (* differences from the archive *) - -> Common.updateItem (* ... *) - -> (string->string->bool) (* function to display the (title and) result - and ask user for confirmation (when -batch - is true, the function should not ask any - questions and should always return true) *) - -> unit Copied: branches/2.32/src/files.mli (from rev 320, trunk/src/files.mli) =================================================================== --- branches/2.32/src/files.mli (rev 0) +++ branches/2.32/src/files.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,83 @@ +(* Unison file synchronizer: src/files.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +(* As usual, these functions should only be called by the client (i.e., in *) +(* the same address space as the user interface). *) + +(* Delete the given subtree of the given replica *) +val delete : + Common.root (* source root *) + -> Path.t (* deleted path *) + -> Common.root (* root *) + -> Path.t (* path to delete *) + -> Common.updateItem (* updates that will be discarded *) + -> unit Lwt.t + +(* Region used for the copying. Exported to be correctly set in transport.ml *) +(* to the maximum number of threads *) +val copyReg : Lwt_util.region + +(* Copy a path in one replica to another path in a second replica. The copy *) +(* is performed atomically (or as close to atomically as the os will *) +(* support) using temporary files. *) +val copy : + [`Update of (Uutil.Filesize.t * Uutil.Filesize.t) | `Copy] + (* whether there was already a file *) + -> Common.root (* from what root *) + -> Path.t (* from what path *) + -> Common.updateItem (* source updates *) + -> Common.root (* to what root *) + -> Path.t (* to what path *) + -> Common.updateItem (* dest. updates *) + -> Uutil.File.t (* id for showing progress of transfer *) + -> unit Lwt.t + +(* Copy the permission bits from a path in one replica to another path in a *) +(* second replica. *) +val setProp : + Common.root (* source root *) + -> Path.t (* source path *) + -> Common.root (* target root *) + -> Path.t (* target path *) + -> Props.t (* previous properties *) + -> Props.t (* new properties *) + -> Common.updateItem (* source updates *) + -> Common.updateItem (* target updates *) + -> unit Lwt.t + +(* Generate a difference summary for two (possibly remote) versions of a *) +(* file and send it to a given function *) +val diff : + Common.root (* first root *) + -> Path.t (* path on first root *) + -> Common.updateItem (* first root updates *) + -> Common.root (* other root *) + -> Path.t (* path on other root *) + -> Common.updateItem (* target updates *) + -> (string->string->unit) (* how to display the (title and) result *) + -> Uutil.File.t (* id for showing progress of transfer *) + -> unit + +(* This should be called at the beginning of execution, to detect and clean *) +(* up any pending file operations left over from previous (abnormally *) +(* terminated) synchronizations *) +val processCommitLogs : unit -> unit + +(* List the files in a directory matching a pattern. (It would be better + to use fspath, etc., here instead of string) *) +val ls : string -> string -> string list + +val get_files_in_directory : string -> string list + +val merge : + Common.root (* first root *) + -> Common.root (* second root *) + -> Path.t (* path to merge *) + -> Uutil.File.t (* id for showing progress of transfer *) + -> Common.updateItem (* differences from the archive *) + -> Common.updateItem (* ... *) + -> (string->string->bool) (* function to display the (title and) result + and ask user for confirmation (when -batch + is true, the function should not ask any + questions and should always return true) *) + -> unit Deleted: branches/2.32/src/fileutil.ml =================================================================== --- trunk/src/fileutil.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/fileutil.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,23 +0,0 @@ -(* Unison file synchronizer: src/fileutil.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* Convert backslashes in a string to forward slashes. Useful in Windows. *) -let backslashes2forwardslashes s0 = - try - ignore(String.index s0 '\\'); (* avoid alloc if possible *) - let n = String.length s0 in - let s = String.create n in - for i = 0 to n-1 do - let c = String.get s0 i in - if c = '\\' - then String.set s i '/' - else String.set s i c - done; - s - with Not_found -> s0 - -let rec removeTrailingSlashes s = - let len = String.length s in - if len>0 && String.get s (len-1) = '/' - then removeTrailingSlashes (String.sub s 0 (len-1)) - else s Copied: branches/2.32/src/fileutil.ml (from rev 320, trunk/src/fileutil.ml) =================================================================== --- branches/2.32/src/fileutil.ml (rev 0) +++ branches/2.32/src/fileutil.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,38 @@ +(* Unison file synchronizer: src/fileutil.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +(* Convert backslashes in a string to forward slashes. Useful in Windows. *) +let backslashes2forwardslashes s0 = + try + ignore(String.index s0 '\\'); (* avoid alloc if possible *) + let n = String.length s0 in + let s = String.create n in + for i = 0 to n-1 do + let c = String.get s0 i in + if c = '\\' + then String.set s i '/' + else String.set s i c + done; + s + with Not_found -> s0 + +let rec removeTrailingSlashes s = + let len = String.length s in + if len>0 && String.get s (len-1) = '/' + then removeTrailingSlashes (String.sub s 0 (len-1)) + else s Deleted: branches/2.32/src/fileutil.mli =================================================================== --- trunk/src/fileutil.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/fileutil.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,7 +0,0 @@ -(* Unison file synchronizer: src/fileutil.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* Convert backslashes in a string to forward slashes. Useful in Windows. *) -val backslashes2forwardslashes : string -> string - -val removeTrailingSlashes : string -> string Copied: branches/2.32/src/fileutil.mli (from rev 320, trunk/src/fileutil.mli) =================================================================== --- branches/2.32/src/fileutil.mli (rev 0) +++ branches/2.32/src/fileutil.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,7 @@ +(* Unison file synchronizer: src/fileutil.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +(* Convert backslashes in a string to forward slashes. Useful in Windows. *) +val backslashes2forwardslashes : string -> string + +val removeTrailingSlashes : string -> string Deleted: branches/2.32/src/fingerprint.ml =================================================================== --- trunk/src/fingerprint.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/fingerprint.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,64 +0,0 @@ -(* Unison file synchronizer: src/fingerprint.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* NOTE: IF YOU CHANGE TYPE "FINGERPRINT", THE ARCHIVE FORMAT CHANGES; *) -(* INCREMENT "UPDATE.ARCHIVEFORMAT" *) -type t = string - -(* Assumes that (fspath, path) is a file and gives its ``digest '', that is *) -(* a short string of cryptographic quality representing it. *) -let file fspath path = - let f = Fspath.toString (Fspath.concat fspath path) in - Util.convertUnixErrorsToTransient - ("digesting " ^ f) - (fun () -> Digest.file f) - -let maxLength = Uutil.Filesize.ofInt max_int -let subfile path offset len = - if len > maxLength then - raise (Util.Transient - (Format.sprintf "File '%s' too big for fingerprinting" path)); - Util.convertUnixErrorsToTransient - "digesting subfile" - (fun () -> - let inch = open_in_bin path in - begin try - LargeFile.seek_in inch offset; - let res = Digest.channel inch (Uutil.Filesize.toInt len) in - close_in inch; - res - with - End_of_file -> - close_in_noerr inch; - raise (Util.Transient - (Format.sprintf - "Error in digesting subfile '%s': truncated file" path)) - | e -> - close_in_noerr inch; - raise e - end) - -let int2hexa quartet = - if quartet < 10 then - (char_of_int ((int_of_char '0') + quartet)) - else char_of_int ((int_of_char 'a') + quartet - 10) - -let hexaCode theChar = - let intCode = int_of_char theChar in - let first = intCode / 16 in - let second = intCode mod 16 in - (int2hexa first, int2hexa second) - -let toString md5 = - let length = String.length md5 in - let string = String.create (length * 2) in - for i=0 to (length - 1) do - let c1, c2 = hexaCode (md5.[i]) in - string.[2*i] <- c1; - string.[2*i + 1] <- c2; - done; - string - -let string = Digest.string - -let dummy = "" Copied: branches/2.32/src/fingerprint.ml (from rev 320, trunk/src/fingerprint.ml) =================================================================== --- branches/2.32/src/fingerprint.ml (rev 0) +++ branches/2.32/src/fingerprint.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,79 @@ +(* Unison file synchronizer: src/fingerprint.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +(* NOTE: IF YOU CHANGE TYPE "FINGERPRINT", THE ARCHIVE FORMAT CHANGES; *) +(* INCREMENT "UPDATE.ARCHIVEFORMAT" *) +type t = string + +(* Assumes that (fspath, path) is a file and gives its ``digest '', that is *) +(* a short string of cryptographic quality representing it. *) +let file fspath path = + let f = Fspath.toString (Fspath.concat fspath path) in + Util.convertUnixErrorsToTransient + ("digesting " ^ f) + (fun () -> Digest.file f) + +let maxLength = Uutil.Filesize.ofInt max_int +let subfile path offset len = + if len > maxLength then + raise (Util.Transient + (Format.sprintf "File '%s' too big for fingerprinting" path)); + Util.convertUnixErrorsToTransient + "digesting subfile" + (fun () -> + let inch = open_in_bin path in + begin try + LargeFile.seek_in inch offset; + let res = Digest.channel inch (Uutil.Filesize.toInt len) in + close_in inch; + res + with + End_of_file -> + close_in_noerr inch; + raise (Util.Transient + (Format.sprintf + "Error in digesting subfile '%s': truncated file" path)) + | e -> + close_in_noerr inch; + raise e + end) + +let int2hexa quartet = + if quartet < 10 then + (char_of_int ((int_of_char '0') + quartet)) + else char_of_int ((int_of_char 'a') + quartet - 10) + +let hexaCode theChar = + let intCode = int_of_char theChar in + let first = intCode / 16 in + let second = intCode mod 16 in + (int2hexa first, int2hexa second) + +let toString md5 = + let length = String.length md5 in + let string = String.create (length * 2) in + for i=0 to (length - 1) do + let c1, c2 = hexaCode (md5.[i]) in + string.[2*i] <- c1; + string.[2*i + 1] <- c2; + done; + string + +let string = Digest.string + +let dummy = "" Deleted: branches/2.32/src/fingerprint.mli =================================================================== --- trunk/src/fingerprint.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/fingerprint.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,16 +0,0 @@ -(* Unison file synchronizer: src/fingerprint.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -type t - -(* Os.safeFingerprint should usually be used rather than these functions *) -val file : Fspath.t -> Path.local -> t -val subfile : string -> Int64.t -> Uutil.Filesize.t -> t - -val string : string -> t - -val toString : t -> string - -(* This dummy fingerprint is guaranteed small and distinct from all - other fingerprints *) -val dummy : t Copied: branches/2.32/src/fingerprint.mli (from rev 320, trunk/src/fingerprint.mli) =================================================================== --- branches/2.32/src/fingerprint.mli (rev 0) +++ branches/2.32/src/fingerprint.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,16 @@ +(* Unison file synchronizer: src/fingerprint.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +type t + +(* Os.safeFingerprint should usually be used rather than these functions *) +val file : Fspath.t -> Path.local -> t +val subfile : string -> Int64.t -> Uutil.Filesize.t -> t + +val string : string -> t + +val toString : t -> string + +(* This dummy fingerprint is guaranteed small and distinct from all + other fingerprints *) +val dummy : t Deleted: branches/2.32/src/fspath.ml =================================================================== --- trunk/src/fspath.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/fspath.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,309 +0,0 @@ -(* Unison file synchronizer: src/fspath.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* Defines an abstract type of absolute filenames (fspaths). Keeping the *) -(* type abstract lets us enforce some invariants which are important for *) -(* correct behavior of some system calls. *) -(* - *) -(* Invariants: *) -(* Fspath "" is not allowed *) -(* All root directories end in / *) -(* All non-root directories end in some other character *) -(* All separator characters are /, even in Windows *) -(* All fspaths are absolute *) -(* - *) - -let debug = Util.debug "fspath" -let debugverbose = Util.debug "fspath+" - -type t = Fspath of string - -let toString (Fspath f) = f - -(* Needed to hack around some ocaml/Windows bugs, see comment at stat, below *) -let winRootRx = Rx.rx "(([a-zA-Z]:)?/|//[^/]+/[^/]+/)" -(* FIX I think we could just check the last character of [d]. *) -let isRootDir d = -(* We assume all path separators are slashes in d *) - d="/" || - (Util.osType = `Win32 && Rx.match_string winRootRx d) -let winRootFixRx = Rx.rx "//[^/]+/[^/]+" -let winRootFix d = - if Rx.match_string winRootFixRx d then d^"/" else d - -(* [differentSuffix: fspath -> fspath -> (string * string)] returns the *) -(* least distinguishing suffixes of two fspaths, for displaying in the user *) -(* interface. *) -let differentSuffix (Fspath f1) (Fspath f2) = - if isRootDir f1 or isRootDir f2 then (f1,f2) - else begin - (* We use the invariant that neither f1 nor f2 ends in slash *) - let len1 = String.length f1 in - let len2 = String.length f2 in - let n = - (* The position of the character from the right where the fspaths *) - (* differ *) - let rec loop n = - let i1 = len1-n in - if i1<0 then n+1 else - let i2 = len2-n in - if i2<0 then n+1 else - if compare (String.get f1 i1) (String.get f2 i2) = 0 - then loop (n+1) - else n in - loop 1 in - let suffix f len = - try - let n' = String.rindex_from f (len-n) '/' in - String.sub f (n'+1) (len-n'-1) - with _ -> f in - let s1 = suffix f1 len1 in - let s2 = suffix f2 len2 in - (s1,s2) - end - -(* When an HFS file is stored on a non-HFS system it is stored as two - files, the data fork, and the rest of the file including resource - fork is stored in the AppleDouble file, which has the same name as - the data fork file with ._ prepended. *) -let appleDouble (Fspath f) = - if isRootDir f then raise(Invalid_argument "Fspath.appleDouble") else - let len = String.length f in - let i = String.rindex f '/' in - let before = String.sub f 0 i in - let after = String.sub f (i+1) (len-i-1) in - Fspath(before^"/._"^after) - -let rsrc (Fspath f) = - if isRootDir f then raise(Invalid_argument "Fspath.appleDouble") else - Fspath(f^"/..namedfork/rsrc") - -(* WRAPPED SYSTEM CALLS *) - -(* CAREFUL! - Windows porting issue: - Unix.LargeFile.stat "c:\\windows\\" will fail, you must use - Unix.LargeFile.stat "c:\\windows" instead. - The standard file selection dialog, however, will return a directory - with a trailing backslash. - Therefore, be careful to remove a trailing slash or backslash before - calling this in Windows. - BUT Windows shares are weird! - //raptor/trevor and //raptor/trevor/mirror are directories - and //raptor/trevor/.bashrc is a file. We observe the following: - Unix.LargeFile.stat "//raptor" will fail. - Unix.LargeFile.stat "//raptor/" will fail. - Unix.LargeFile.stat "//raptor/trevor" will fail. - Unix.LargeFile.stat "//raptor/trevor/" will succeed. - Unix.LargeFile.stat "//raptor/trevor/mirror" will succeed. - Unix.LargeFile.stat "//raptor/trevor/mirror/" will fail. - Unix.LargeFile.stat "//raptor/trevor/.bashrc/" will fail. - Unix.LargeFile.stat "//raptor/trevor/.bashrc" will succeed. - Not sure what happens for, e.g., - Unix.LargeFile.stat "//raptor/FOO" - where //raptor/FOO is a file. - I guess the best we can do is: - To stat //host/xxx, assume xxx is a directory, and use - Unix.LargeFile.stat "//host/xxx/". If xxx is not a directory, - who knows. - To stat //host/path where path has length >1, don't use - a trailing slash. - The way I did this was to assume //host/xxx/ is a root directory. - Then by the invariants of fspath it should always end in /. - - Unix.LargeFile.stat "c:" will fail. - Unix.LargeFile.stat "c:/" will succeed. - Unix.LargeFile.stat "c://" will fail. - (The Unix version of ocaml handles either a trailing slash or no - trailing slash.) -*) -(* Invariant on fspath will guarantee that argument is OK for stat *) -let stat (Fspath f) = Unix.LargeFile.stat f -let lstat (Fspath f) = Unix.LargeFile.lstat f - -(* HACK: - Under Windows 98, - Unix.opendir "c:/" fails - Unix.opendir "c:/*" works - Unix.opendir "/" fails - Under Windows 2000, - Unix.opendir "c:/" works - Unix.opendir "c:/*" fails - Unix.opendir "/" fails - - Unix.opendir "c:" works as well, but, this refers to the current - working directory AFAIK. -*) -let opendir (Fspath d) = - if Util.osType<>`Win32 || not(isRootDir d) then Unix.opendir d else - try - Unix.opendir d - with Unix.Unix_error _ -> - Unix.opendir (d^"*") - -let child (Fspath f) n = - (* Note, f is not "" by invariants on Fspath *) - if - (* We use the invariant that f ends in / iff f is a root filename *) - isRootDir f - then - Fspath(Printf.sprintf "%s%s" f (Name.toString n)) - else - Fspath (Printf.sprintf "%s%c%s" f '/' (Name.toString n)) - -let concat fspath path = - if Path.isEmpty path then - fspath - else begin - let Fspath fspath = fspath in - if - (* We use the invariant that f ends in / iff f is a root filename *) - isRootDir fspath - then - Fspath (fspath ^ Path.toString path) - else - let p = Path.toString path in - let l = String.length fspath in - let l' = String.length p in - let s = String.create (l + l' + 1) in - String.blit fspath 0 s 0 l; - s.[l] <- '/'; - String.blit p 0 s (l + 1) l'; - Fspath s - end - -(* Filename.dirname is screwed up in Windows so we use this function. It *) -(* assumes that path separators are slashes. *) -let winBadDirnameArg = Rx.rx "[a-zA-Z]:/[^/]*" -let myDirname s = - if Util.osType=`Win32 && Rx.match_string winBadDirnameArg s - then String.sub s 0 3 - else Filename.dirname s - -(*****************************************************************************) -(* CANONIZING PATHS *) -(*****************************************************************************) - -(* Convert a string to an fspath. HELP ENFORCE INVARIANTS listed above. *) -let localString2fspath s = - (* Force path separators to be slashes in Windows, handle weirdness in *) - (* Windows network names *) - let s = - if Util.osType = `Win32 - then winRootFix (Fileutil.backslashes2forwardslashes s) - else s in - (* Note: s may still contain backslashes under Unix *) - if isRootDir s then Fspath s - else if String.length s > 0 then - let s' = Fileutil.removeTrailingSlashes s in - if String.length s' = 0 then Fspath "/" (* E.g., s="///" *) - else Fspath s' - else - (* Prevent Fspath "" *) - raise(Invalid_argument "Os.localString2fspath") - -(* Return the canonical fspath of a filename (string), relative to the *) -(* current host, current directory. *) - -(* THIS IS A HACK. It has to take account of some porting issues between *) -(* the Unix and Windows versions of ocaml, etc. In particular, the Unix, *) -(* Filename, and Sys modules of ocaml have subtle differences under Windows *) -(* and Unix. So, be very careful with any changes !!! *) -let canonizeFspath p0 = - let p = match p0 with None -> "." | Some "" -> "." | Some s -> s in - let p' = - begin - let original = Sys.getcwd() in - try - let newp = - (Sys.chdir p; (* This might raise Sys_error *) - Sys.getcwd()) in - Sys.chdir original; - newp - with - Sys_error why -> - (* We could not chdir to p. Either *) - (* - *) - (* (1) p does not exist *) - (* (2) p is a file *) - (* (3) p is a dir but we don't have permission *) - (* - *) - (* In any case, we try to cd to the parent of p, and if that *) - (* fails, we just quit. This works nicely for most cases of (1), *) - (* it works for (2), and on (3) it may leave a mess for someone *) - (* else to pick up. *) - let p = if Util.osType = `Win32 then Fileutil.backslashes2forwardslashes p else p in - if isRootDir p then raise - (Util.Fatal (Printf.sprintf - "Cannot find canonical name of root directory %s\n(%s)" p why)); - let parent = myDirname p in - let parent' = begin - (try Sys.chdir parent with - Sys_error why2 -> raise (Util.Fatal (Printf.sprintf - "Cannot find canonical name of %s: unable to cd either to it\n -(%s)\nor to its parent %s\n(%s)" p why parent why2))); - Sys.getcwd() end in - Sys.chdir original; - let bn = Filename.basename p in - if bn="" then parent' - else toString(child (localString2fspath parent') - (Name.fromString bn)) - end in - localString2fspath p' - -(* -(* TJ--I'm disabling this for now. It is causing directories to be created *) -(* with the wrong case, e.g., an upper case directory that needs to be *) -(* propagated will be created with a lower case name. We'll see if the *) -(* weird problem with changing case is still happening. *) - if Util.osType<>`Win32 then localString2fspath p' - else - (* A strange bug turns up in Windows: sometimes p' has mixed case, *) - (* sometimes it is all lower case. (Sys.getcwd seems to make a random *) - (* choice.) Since file names are not case-sensitive in Windows we just *) - (* force everything to lower case. *) - - (* NOTE: WE DON'T ENFORCE THAT FSPATHS CREATED BY CHILDFSPATH ARE ALL *) - (* LOWER CASE!! *) - let p' = String.lowercase p' in - localString2fspath p' -*) - -let canonize x = - Util.convertUnixErrorsToFatal "canonizing path" (fun () -> canonizeFspath x) - -let concatToString fspath path = toString (concat fspath path) - -let maxlinks = 100 -let findWorkingDir fspath path = - let abspath = concatToString fspath path in - let realpath = - if not (Path.followLink path) then abspath else - let rec followlinks n p = - if n>=maxlinks then - raise - (Util.Transient (Printf.sprintf - "Too many symbolic links from %s" abspath)); - try - let link = Unix.readlink p in - let linkabs = - if Filename.is_relative link then - Filename.concat (Filename.dirname p) link - else link in - followlinks (n+1) linkabs - with - Unix.Unix_error _ -> p in - followlinks 0 abspath in - if isRootDir realpath then - raise (Util.Transient(Printf.sprintf - "The path %s is a root directory" abspath)); - let realpath = Fileutil.removeTrailingSlashes realpath in - let p = Filename.basename realpath in - debug - (fun() -> - Util.msg "Os.findWorkingDir(%s,%s) = (%s,%s)\n" - (toString fspath) - (Path.toString path) - (myDirname realpath) - p); - (localString2fspath (myDirname realpath), Path.fromString p) Copied: branches/2.32/src/fspath.ml (from rev 320, trunk/src/fspath.ml) =================================================================== --- branches/2.32/src/fspath.ml (rev 0) +++ branches/2.32/src/fspath.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,324 @@ +(* Unison file synchronizer: src/fspath.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +(* Defines an abstract type of absolute filenames (fspaths). Keeping the *) +(* type abstract lets us enforce some invariants which are important for *) +(* correct behavior of some system calls. *) +(* - *) +(* Invariants: *) +(* Fspath "" is not allowed *) +(* All root directories end in / *) +(* All non-root directories end in some other character *) +(* All separator characters are /, even in Windows *) +(* All fspaths are absolute *) +(* - *) + +let debug = Util.debug "fspath" +let debugverbose = Util.debug "fspath+" + +type t = Fspath of string + +let toString (Fspath f) = f + +(* Needed to hack around some ocaml/Windows bugs, see comment at stat, below *) +let winRootRx = Rx.rx "(([a-zA-Z]:)?/|//[^/]+/[^/]+/)" +(* FIX I think we could just check the last character of [d]. *) +let isRootDir d = +(* We assume all path separators are slashes in d *) + d="/" || + (Util.osType = `Win32 && Rx.match_string winRootRx d) +let winRootFixRx = Rx.rx "//[^/]+/[^/]+" +let winRootFix d = + if Rx.match_string winRootFixRx d then d^"/" else d + +(* [differentSuffix: fspath -> fspath -> (string * string)] returns the *) +(* least distinguishing suffixes of two fspaths, for displaying in the user *) +(* interface. *) +let differentSuffix (Fspath f1) (Fspath f2) = + if isRootDir f1 or isRootDir f2 then (f1,f2) + else begin + (* We use the invariant that neither f1 nor f2 ends in slash *) + let len1 = String.length f1 in + let len2 = String.length f2 in + let n = + (* The position of the character from the right where the fspaths *) + (* differ *) + let rec loop n = + let i1 = len1-n in + if i1<0 then n+1 else + let i2 = len2-n in + if i2<0 then n+1 else + if compare (String.get f1 i1) (String.get f2 i2) = 0 + then loop (n+1) + else n in + loop 1 in + let suffix f len = + try + let n' = String.rindex_from f (len-n) '/' in + String.sub f (n'+1) (len-n'-1) + with _ -> f in + let s1 = suffix f1 len1 in + let s2 = suffix f2 len2 in + (s1,s2) + end + +(* When an HFS file is stored on a non-HFS system it is stored as two + files, the data fork, and the rest of the file including resource + fork is stored in the AppleDouble file, which has the same name as + the data fork file with ._ prepended. *) +let appleDouble (Fspath f) = + if isRootDir f then raise(Invalid_argument "Fspath.appleDouble") else + let len = String.length f in + let i = String.rindex f '/' in + let before = String.sub f 0 i in + let after = String.sub f (i+1) (len-i-1) in + Fspath(before^"/._"^after) + +let rsrc (Fspath f) = + if isRootDir f then raise(Invalid_argument "Fspath.appleDouble") else + Fspath(f^"/..namedfork/rsrc") + +(* WRAPPED SYSTEM CALLS *) + +(* CAREFUL! + Windows porting issue: + Unix.LargeFile.stat "c:\\windows\\" will fail, you must use + Unix.LargeFile.stat "c:\\windows" instead. + The standard file selection dialog, however, will return a directory + with a trailing backslash. + Therefore, be careful to remove a trailing slash or backslash before + calling this in Windows. + BUT Windows shares are weird! + //raptor/trevor and //raptor/trevor/mirror are directories + and //raptor/trevor/.bashrc is a file. We observe the following: + Unix.LargeFile.stat "//raptor" will fail. + Unix.LargeFile.stat "//raptor/" will fail. + Unix.LargeFile.stat "//raptor/trevor" will fail. + Unix.LargeFile.stat "//raptor/trevor/" will succeed. + Unix.LargeFile.stat "//raptor/trevor/mirror" will succeed. + Unix.LargeFile.stat "//raptor/trevor/mirror/" will fail. + Unix.LargeFile.stat "//raptor/trevor/.bashrc/" will fail. + Unix.LargeFile.stat "//raptor/trevor/.bashrc" will succeed. + Not sure what happens for, e.g., + Unix.LargeFile.stat "//raptor/FOO" + where //raptor/FOO is a file. + I guess the best we can do is: + To stat //host/xxx, assume xxx is a directory, and use + Unix.LargeFile.stat "//host/xxx/". If xxx is not a directory, + who knows. + To stat //host/path where path has length >1, don't use + a trailing slash. + The way I did this was to assume //host/xxx/ is a root directory. + Then by the invariants of fspath it should always end in /. + + Unix.LargeFile.stat "c:" will fail. + Unix.LargeFile.stat "c:/" will succeed. + Unix.LargeFile.stat "c://" will fail. + (The Unix version of ocaml handles either a trailing slash or no + trailing slash.) +*) +(* Invariant on fspath will guarantee that argument is OK for stat *) +let stat (Fspath f) = Unix.LargeFile.stat f +let lstat (Fspath f) = Unix.LargeFile.lstat f + +(* HACK: + Under Windows 98, + Unix.opendir "c:/" fails + Unix.opendir "c:/*" works + Unix.opendir "/" fails + Under Windows 2000, + Unix.opendir "c:/" works + Unix.opendir "c:/*" fails + Unix.opendir "/" fails + + Unix.opendir "c:" works as well, but, this refers to the current + working directory AFAIK. +*) +let opendir (Fspath d) = + if Util.osType<>`Win32 || not(isRootDir d) then Unix.opendir d else + try + Unix.opendir d + with Unix.Unix_error _ -> + Unix.opendir (d^"*") + +let child (Fspath f) n = + (* Note, f is not "" by invariants on Fspath *) + if + (* We use the invariant that f ends in / iff f is a root filename *) + isRootDir f + then + Fspath(Printf.sprintf "%s%s" f (Name.toString n)) + else + Fspath (Printf.sprintf "%s%c%s" f '/' (Name.toString n)) + +let concat fspath path = + if Path.isEmpty path then + fspath + else begin + let Fspath fspath = fspath in + if + (* We use the invariant that f ends in / iff f is a root filename *) + isRootDir fspath + then + Fspath (fspath ^ Path.toString path) + else + let p = Path.toString path in + let l = String.length fspath in + let l' = String.length p in + let s = String.create (l + l' + 1) in + String.blit fspath 0 s 0 l; + s.[l] <- '/'; + String.blit p 0 s (l + 1) l'; + Fspath s + end + +(* Filename.dirname is screwed up in Windows so we use this function. It *) +(* assumes that path separators are slashes. *) +let winBadDirnameArg = Rx.rx "[a-zA-Z]:/[^/]*" +let myDirname s = + if Util.osType=`Win32 && Rx.match_string winBadDirnameArg s + then String.sub s 0 3 + else Filename.dirname s + +(*****************************************************************************) +(* CANONIZING PATHS *) +(*****************************************************************************) + +(* Convert a string to an fspath. HELP ENFORCE INVARIANTS listed above. *) +let localString2fspath s = + (* Force path separators to be slashes in Windows, handle weirdness in *) + (* Windows network names *) + let s = + if Util.osType = `Win32 + then winRootFix (Fileutil.backslashes2forwardslashes s) + else s in + (* Note: s may still contain backslashes under Unix *) + if isRootDir s then Fspath s + else if String.length s > 0 then + let s' = Fileutil.removeTrailingSlashes s in + if String.length s' = 0 then Fspath "/" (* E.g., s="///" *) + else Fspath s' + else + (* Prevent Fspath "" *) + raise(Invalid_argument "Os.localString2fspath") + +(* Return the canonical fspath of a filename (string), relative to the *) +(* current host, current directory. *) + +(* THIS IS A HACK. It has to take account of some porting issues between *) +(* the Unix and Windows versions of ocaml, etc. In particular, the Unix, *) +(* Filename, and Sys modules of ocaml have subtle differences under Windows *) +(* and Unix. So, be very careful with any changes !!! *) +let canonizeFspath p0 = + let p = match p0 with None -> "." | Some "" -> "." | Some s -> s in + let p' = + begin + let original = Sys.getcwd() in + try + let newp = + (Sys.chdir p; (* This might raise Sys_error *) + Sys.getcwd()) in + Sys.chdir original; + newp + with + Sys_error why -> + (* We could not chdir to p. Either *) + (* - *) + (* (1) p does not exist *) + (* (2) p is a file *) + (* (3) p is a dir but we don't have permission *) + (* - *) + (* In any case, we try to cd to the parent of p, and if that *) + (* fails, we just quit. This works nicely for most cases of (1), *) + (* it works for (2), and on (3) it may leave a mess for someone *) + (* else to pick up. *) + let p = if Util.osType = `Win32 then Fileutil.backslashes2forwardslashes p else p in + if isRootDir p then raise + (Util.Fatal (Printf.sprintf + "Cannot find canonical name of root directory %s\n(%s)" p why)); + let parent = myDirname p in + let parent' = begin + (try Sys.chdir parent with + Sys_error why2 -> raise (Util.Fatal (Printf.sprintf + "Cannot find canonical name of %s: unable to cd either to it\n +(%s)\nor to its parent %s\n(%s)" p why parent why2))); + Sys.getcwd() end in + Sys.chdir original; + let bn = Filename.basename p in + if bn="" then parent' + else toString(child (localString2fspath parent') + (Name.fromString bn)) + end in + localString2fspath p' + +(* +(* TJ--I'm disabling this for now. It is causing directories to be created *) +(* with the wrong case, e.g., an upper case directory that needs to be *) +(* propagated will be created with a lower case name. We'll see if the *) +(* weird problem with changing case is still happening. *) + if Util.osType<>`Win32 then localString2fspath p' + else + (* A strange bug turns up in Windows: sometimes p' has mixed case, *) + (* sometimes it is all lower case. (Sys.getcwd seems to make a random *) + (* choice.) Since file names are not case-sensitive in Windows we just *) + (* force everything to lower case. *) + + (* NOTE: WE DON'T ENFORCE THAT FSPATHS CREATED BY CHILDFSPATH ARE ALL *) + (* LOWER CASE!! *) + let p' = String.lowercase p' in + localString2fspath p' +*) + +let canonize x = + Util.convertUnixErrorsToFatal "canonizing path" (fun () -> canonizeFspath x) + +let concatToString fspath path = toString (concat fspath path) + +let maxlinks = 100 +let findWorkingDir fspath path = + let abspath = concatToString fspath path in + let realpath = + if not (Path.followLink path) then abspath else + let rec followlinks n p = + if n>=maxlinks then + raise + (Util.Transient (Printf.sprintf + "Too many symbolic links from %s" abspath)); + try + let link = Unix.readlink p in + let linkabs = + if Filename.is_relative link then + Filename.concat (Filename.dirname p) link + else link in + followlinks (n+1) linkabs + with + Unix.Unix_error _ -> p in + followlinks 0 abspath in + if isRootDir realpath then + raise (Util.Transient(Printf.sprintf + "The path %s is a root directory" abspath)); + let realpath = Fileutil.removeTrailingSlashes realpath in + let p = Filename.basename realpath in + debug + (fun() -> + Util.msg "Os.findWorkingDir(%s,%s) = (%s,%s)\n" + (toString fspath) + (Path.toString path) + (myDirname realpath) + p); + (localString2fspath (myDirname realpath), Path.fromString p) Deleted: branches/2.32/src/fspath.mli =================================================================== --- trunk/src/fspath.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/fspath.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,33 +0,0 @@ -(* Unison file synchronizer: src/fspath.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* Defines an abstract type of absolute filenames (fspaths) *) - -type t - -val child : t -> Name.t -> t -val concat : t -> Path.local -> t - -val canonize : string option -> t -val toString : t -> string -val concatToString : t -> Path.local -> string - -(* If fspath+path refers to a (followed) symlink, then return the directory *) -(* of the symlink's target; otherwise return the parent dir of path. If *) -(* fspath+path is a root directory, raise Fatal. *) -val findWorkingDir : t -> Path.local -> (t * Path.local) - -(* Return the least distinguishing suffixes of two fspaths, for displaying *) -(* in the user interface. *) -val differentSuffix: t -> t -> (string * string) - -(* Return the AppleDouble filename; if root dir, raise Invalid_argument *) -val appleDouble : t -> t -(* Return the resource fork filename; if root dir, raise Invalid_argument *) -val rsrc : t -> t - -(* Wrapped system calls that use invariants of the fspath internal rep *) -(* BE SURE TO USE ONLY THESE, NOT VERSIONS FROM THE UNIX MODULE! *) -val stat : t -> Unix.LargeFile.stats -val lstat : t -> Unix.LargeFile.stats -val opendir : t -> Unix.dir_handle Copied: branches/2.32/src/fspath.mli (from rev 320, trunk/src/fspath.mli) =================================================================== --- branches/2.32/src/fspath.mli (rev 0) +++ branches/2.32/src/fspath.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,33 @@ +(* Unison file synchronizer: src/fspath.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +(* Defines an abstract type of absolute filenames (fspaths) *) + +type t + +val child : t -> Name.t -> t +val concat : t -> Path.local -> t + +val canonize : string option -> t +val toString : t -> string +val concatToString : t -> Path.local -> string + +(* If fspath+path refers to a (followed) symlink, then return the directory *) +(* of the symlink's target; otherwise return the parent dir of path. If *) +(* fspath+path is a root directory, raise Fatal. *) +val findWorkingDir : t -> Path.local -> (t * Path.local) + +(* Return the least distinguishing suffixes of two fspaths, for displaying *) +(* in the user interface. *) +val differentSuffix: t -> t -> (string * string) + +(* Return the AppleDouble filename; if root dir, raise Invalid_argument *) +val appleDouble : t -> t +(* Return the resource fork filename; if root dir, raise Invalid_argument *) +val rsrc : t -> t + +(* Wrapped system calls that use invariants of the fspath internal rep *) +(* BE SURE TO USE ONLY THESE, NOT VERSIONS FROM THE UNIX MODULE! *) +val stat : t -> Unix.LargeFile.stats +val lstat : t -> Unix.LargeFile.stats +val opendir : t -> Unix.dir_handle Deleted: branches/2.32/src/globals.ml =================================================================== --- trunk/src/globals.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/globals.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,275 +0,0 @@ -(* Unison file synchronizer: src/globals.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -open Common - -let debug = Trace.debug "globals" - -(*****************************************************************************) -(* ROOTS and PATHS *) -(*****************************************************************************) - -let rawroots = - Prefs.createStringList "root" - "root of a replica (should be used exactly twice)" - ("Each use of this preference names the root of one of the replicas " - ^ "for Unison to synchronize. Exactly two roots are needed, so normal " - ^ "modes of usage are either to give two values for \\verb|root| in the " - ^ "profile, or to give no values in the profile and provide two " - ^ "on the command line. " - ^ "Details of the syntax of roots can be found in " - ^ "\\sectionref{roots}{Roots}.\n\n" - ^ "The two roots can be given in either order; Unison will sort them " - ^ "into a canonical order before doing anything else. It also tries to " - ^ "`canonize' the machine names and paths that appear in the roots, so " - ^ "that, if Unison is invoked later with a slightly different name " - ^ "for the same root, it will be able to locate the correct archives.") - -let setRawRoots l = - Prefs.set rawroots l - -let rawRoots () = Prefs.read rawroots - -let rootsInitialName () = - match rawRoots () with - [r2; r1] -> (r1, r2) - | _ -> assert false - -let theroots = ref [] - -open Lwt -let installRoots termInteract = - let roots = rawRoots () in - if Safelist.length roots <> 2 then - raise (Util.Fatal (Printf.sprintf - "Wrong number of roots: 2 expected, but %d provided (%s)\n(Maybe you specified roots both on the command line and in the profile?)" - (Safelist.length roots) - (String.concat ", " roots) )); - Safelist.fold_right - (fun r cont -> - Remote.canonizeRoot r (Clroot.parseRoot r) termInteract - >>= (fun r' -> - cont >>= (fun l -> - return (r' :: l)))) - roots (return []) >>= (fun roots' -> - theroots := Safelist.rev roots'; - return ()) - -(* Alternate interface, should replace old interface eventually *) -let installRoots2 () = - debug (fun () -> Util.msg "Installing roots..."); - let roots = rawRoots () in - theroots := - Safelist.map Remote.canonize ((Safelist.map Clroot.parseRoot) roots); - theroots := Safelist.rev !theroots (* Not sure why this is needed... *) - -let roots () = - match !theroots with - [root1;root2] -> (root1,root2) - | _ -> assert false - -let rootsList() = !theroots - -let rootsInCanonicalOrder() = Common.sortRoots (!theroots) - -let reorderCanonicalListToUsersOrder l = - if rootsList() = rootsInCanonicalOrder() then l - else Safelist.rev l - -let rec nice_rec i - : unit Lwt.t = - if i <= 0 then - Lwt.return () - else - Lwt_unix.yield() >>= (fun () -> nice_rec (i - 1)) - -(* [nice r] yields 5 times on local roots [r] to give processes - corresponding to remote roots a chance to run *) -let nice r = - if List.exists (fun r -> fst r <> Local) (rootsList ()) && fst r = Local then - nice_rec 5 - else - Lwt.return () - -let allRootsIter f = - Lwt_util.iter - (fun r -> nice r >>= (fun () -> f r)) (rootsInCanonicalOrder ()) - -let allRootsIter2 f l = - let l = Safelist.combine (rootsList ()) l in - Lwt_util.iter (fun (r, v) -> nice r >>= (fun () -> f r v)) - (Safelist.sort (fun (r, _) (r', _) -> Common.compareRoots r r') l) - -let allRootsMap f = - Lwt_util.map - (fun r -> nice r >>= (fun () -> f r >>= (fun v -> return (r, v)))) - (rootsInCanonicalOrder ()) >>= (fun l -> - return (Safelist.map snd (reorderCanonicalListToUsersOrder l))) - -let allRootsMapWithWaitingAction f wa = - Lwt_util.map_with_waiting_action - (fun r -> nice r >>= (fun () -> f r >>= (fun v -> return (r, v)))) - (fun r -> wa r) - (rootsInCanonicalOrder ()) >>= (fun l -> - return (Safelist.map snd (reorderCanonicalListToUsersOrder l))) - -let replicaHostnames () = - Safelist.map - (function (Local, _) -> "" - | (Remote h,_) -> h) - (rootsList()) - -let allHostsIter f = - let rec iter l = - match l with - [] -> - return () - | root :: rem -> - f root >>= (fun () -> - iter rem) - in - iter (replicaHostnames ()) - -let allHostsMap f = Safelist.map f (replicaHostnames()) - -let paths = - Prefs.create "path" [] - "path to synchronize" - ("When no \\verb|path| preference is given, Unison will simply synchronize " - ^ "the two entire replicas, beginning from the given pair of roots. " - ^ "If one or more \\verb|path| preferences are given, then Unison will " - ^ "synchronize only these paths and their children. (This is useful " - ^ "for doing a fast sync of just one directory, for example.) " - ^ "Note that {\\tt path} preferences are intepreted literally---they " - ^ "are not regular expressions.") - (fun oldpaths string -> Safelist.append oldpaths [Path.fromString string]) - (fun l -> Safelist.map Path.toString l) - -(* FIX: this does weird things in case-insensitive mode... *) -let globPath lr p = - let p = Path.magic p in - debug (fun() -> - Util.msg "Checking path '%s' for expansions\n" - (Path.toDebugString p) ); - match Path.deconstructRev p with - Some(n,parent) when (Name.toString n = "*") -> begin - debug (fun() -> Util.msg "Expanding path %s\n" (Path.toString p)); - match lr with - None -> raise (Util.Fatal (Printf.sprintf - "Path %s ends with *, %s" - (Path.toString p) - "but first root (after canonizing) is non-local")) - | Some lrfspath -> - Safelist.map (fun c -> Path.magic' (Path.child parent c)) - (Os.childrenOf lrfspath parent) - end - | _ -> [Path.magic' p] - -let expandWildcardPaths() = - let lr = - match rootsInCanonicalOrder() with - [(Local, fspath); _] -> Some fspath - | _ -> None in - Prefs.set paths - (Safelist.flatten_map (globPath lr) (Prefs.read paths)) - -(*****************************************************************************) -(* PROPAGATION OF PREFERENCES *) -(*****************************************************************************) - -let propagatePrefsTo = - Remote.registerHostCmd - "installPrefs" - (fun prefs -> return (Prefs.load prefs)) - -let propagatePrefs () = - let prefs = Prefs.dump() in - let toHost root = - match root with - (Local, _) -> return () - | (Remote host,_) -> - propagatePrefsTo host prefs - in - allRootsIter toHost - -(*****************************************************************************) -(* PREFERENCES AND PREDICATES *) -(*****************************************************************************) - -let batch = - Prefs.createBool "batch" false "batch mode: ask no questions at all" - ("When this is set to {\\tt true}, the user " - ^ "interface will ask no questions at all. Non-conflicting changes " - ^ "will be propagated; conflicts will be skipped.") - -let confirmBigDeletes = - Prefs.createBool "confirmbigdel" true - "!ask about whole-replica (or path) deletes" - ("!When this is set to {\\tt true}, Unison will request an extra confirmation if it appears " - ^ "that the entire replica has been deleted, before propagating the change. If the {\\tt batch} " - ^ "flag is also set, synchronization will be aborted. When the {\\tt path} preference is used, " - ^ "the same confirmation will be requested for top-level paths. (At the moment, this flag only " - ^ "affects the text user interface.) See also the {\\tt mountpoint} preference.") - -let () = Prefs.alias confirmBigDeletes "confirmbigdeletes" - -let ignore = - Pred.create "ignore" - ("Including the preference \\texttt{-ignore \\ARG{pathspec}} causes Unison to " - ^ "completely ignore paths that match \\ARG{pathspec} (as well as their " - ^ "children). This is useful for avoiding synchronizing temporary " - ^ "files, object files, etc. The syntax of \\ARG{pathspec} is " - ^ "described in \\sectionref{pathspec}{Path Specification}, and further " - ^ "details on ignoring paths is found in" - ^ " \\sectionref{ignore}{Ignoring Paths}.") - -let ignorenot = - Pred.create "ignorenot" - ("This preference overrides the preference \\texttt{ignore}. - It gives a list of patterns - (in the same format as - \\verb|ignore|) for paths that should definitely {\\em not} be ignored, - whether or not they happen to match one of the \\verb|ignore| patterns. - \\par Note that the semantics of {\\tt ignore} and {\\tt ignorenot} is a - little counter-intuitive. When detecting updates, Unison examines - paths in depth-first order, starting from the roots of the replicas - and working downwards. Before examining each path, it checks whether - it matches {\\tt ignore} and does not match {\\tt ignorenot}; in this case - it skips this path {\\em and all its descendants}. This means that, - if some parent of a given path matches an {\\tt ignore} pattern, then - it will be skipped even if the path itself matches an {\\tt ignorenot} - pattern. In particular, putting {\\tt ignore = Path *} in your profile - and then using {\tt ignorenot} to select particular paths to be - synchronized will not work. Instead, you should use the {\\tt path} - preference to choose particular paths to synchronize.") - -let shouldIgnore p = - let p = Path.toString p in - (Pred.test ignore p) && not (Pred.test ignorenot p) - -let addRegexpToIgnore re = - let oldRE = Pred.extern ignore in - let newRE = re::oldRE in - Pred.intern ignore newRE - -let merge = - Pred.create "merge" ~advanced:true - ("This preference can be used to run a merge program which will create " - ^ "a new version for each of the files and the backup, " - ^ "with the last backup and the both replicas. Setting the {\\tt merge} " - ^ "preference for a path will also cause this path to be backed up, " - ^ "just like {\tt backup}. " - ^ "The syntax of \\ARG{pathspec>cmd} is " - ^ "described in \\sectionref{pathspec}{Path Specification}, and further " - ^ "details on Merging functions are present in " - ^ "\\sectionref{merge}{Merging files}.") - -let shouldMerge p = Pred.test merge (Path.toString p) - -let mergeCmdForPath p = Pred.assoc merge (Path.toString p) - -let someHostIsRunningWindows = - Prefs.createBool "someHostIsRunningWindows" false "*" "" - -let allHostsAreRunningWindows = - Prefs.createBool "allHostsAreRunningWindows" false "*" "" Copied: branches/2.32/src/globals.ml (from rev 320, trunk/src/globals.ml) =================================================================== --- branches/2.32/src/globals.ml (rev 0) +++ branches/2.32/src/globals.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,290 @@ +(* Unison file synchronizer: src/globals.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +open Common + +let debug = Trace.debug "globals" + +(*****************************************************************************) +(* ROOTS and PATHS *) +(*****************************************************************************) + +let rawroots = + Prefs.createStringList "root" + "root of a replica (should be used exactly twice)" + ("Each use of this preference names the root of one of the replicas " + ^ "for Unison to synchronize. Exactly two roots are needed, so normal " + ^ "modes of usage are either to give two values for \\verb|root| in the " + ^ "profile, or to give no values in the profile and provide two " + ^ "on the command line. " + ^ "Details of the syntax of roots can be found in " + ^ "\\sectionref{roots}{Roots}.\n\n" + ^ "The two roots can be given in either order; Unison will sort them " + ^ "into a canonical order before doing anything else. It also tries to " + ^ "`canonize' the machine names and paths that appear in the roots, so " + ^ "that, if Unison is invoked later with a slightly different name " + ^ "for the same root, it will be able to locate the correct archives.") + +let setRawRoots l = + Prefs.set rawroots l + +let rawRoots () = Prefs.read rawroots + +let rootsInitialName () = + match rawRoots () with + [r2; r1] -> (r1, r2) + | _ -> assert false + +let theroots = ref [] + +open Lwt +let installRoots termInteract = + let roots = rawRoots () in + if Safelist.length roots <> 2 then + raise (Util.Fatal (Printf.sprintf + "Wrong number of roots: 2 expected, but %d provided (%s)\n(Maybe you specified roots both on the command line and in the profile?)" + (Safelist.length roots) + (String.concat ", " roots) )); + Safelist.fold_right + (fun r cont -> + Remote.canonizeRoot r (Clroot.parseRoot r) termInteract + >>= (fun r' -> + cont >>= (fun l -> + return (r' :: l)))) + roots (return []) >>= (fun roots' -> + theroots := Safelist.rev roots'; + return ()) + +(* Alternate interface, should replace old interface eventually *) +let installRoots2 () = + debug (fun () -> Util.msg "Installing roots..."); + let roots = rawRoots () in + theroots := + Safelist.map Remote.canonize ((Safelist.map Clroot.parseRoot) roots); + theroots := Safelist.rev !theroots (* Not sure why this is needed... *) + +let roots () = + match !theroots with + [root1;root2] -> (root1,root2) + | _ -> assert false + +let rootsList() = !theroots + +let rootsInCanonicalOrder() = Common.sortRoots (!theroots) + +let reorderCanonicalListToUsersOrder l = + if rootsList() = rootsInCanonicalOrder() then l + else Safelist.rev l + +let rec nice_rec i + : unit Lwt.t = + if i <= 0 then + Lwt.return () + else + Lwt_unix.yield() >>= (fun () -> nice_rec (i - 1)) + +(* [nice r] yields 5 times on local roots [r] to give processes + corresponding to remote roots a chance to run *) +let nice r = + if List.exists (fun r -> fst r <> Local) (rootsList ()) && fst r = Local then + nice_rec 5 + else + Lwt.return () + +let allRootsIter f = + Lwt_util.iter + (fun r -> nice r >>= (fun () -> f r)) (rootsInCanonicalOrder ()) + +let allRootsIter2 f l = + let l = Safelist.combine (rootsList ()) l in + Lwt_util.iter (fun (r, v) -> nice r >>= (fun () -> f r v)) + (Safelist.sort (fun (r, _) (r', _) -> Common.compareRoots r r') l) + +let allRootsMap f = + Lwt_util.map + (fun r -> nice r >>= (fun () -> f r >>= (fun v -> return (r, v)))) + (rootsInCanonicalOrder ()) >>= (fun l -> + return (Safelist.map snd (reorderCanonicalListToUsersOrder l))) + +let allRootsMapWithWaitingAction f wa = + Lwt_util.map_with_waiting_action + (fun r -> nice r >>= (fun () -> f r >>= (fun v -> return (r, v)))) + (fun r -> wa r) + (rootsInCanonicalOrder ()) >>= (fun l -> + return (Safelist.map snd (reorderCanonicalListToUsersOrder l))) + +let replicaHostnames () = + Safelist.map + (function (Local, _) -> "" + | (Remote h,_) -> h) + (rootsList()) + +let allHostsIter f = + let rec iter l = + match l with + [] -> + return () + | root :: rem -> + f root >>= (fun () -> + iter rem) + in + iter (replicaHostnames ()) + +let allHostsMap f = Safelist.map f (replicaHostnames()) + +let paths = + Prefs.create "path" [] + "path to synchronize" + ("When no \\verb|path| preference is given, Unison will simply synchronize " + ^ "the two entire replicas, beginning from the given pair of roots. " + ^ "If one or more \\verb|path| preferences are given, then Unison will " + ^ "synchronize only these paths and their children. (This is useful " + ^ "for doing a fast sync of just one directory, for example.) " + ^ "Note that {\\tt path} preferences are intepreted literally---they " + ^ "are not regular expressions.") + (fun oldpaths string -> Safelist.append oldpaths [Path.fromString string]) + (fun l -> Safelist.map Path.toString l) + +(* FIX: this does weird things in case-insensitive mode... *) +let globPath lr p = + let p = Path.magic p in + debug (fun() -> + Util.msg "Checking path '%s' for expansions\n" + (Path.toDebugString p) ); + match Path.deconstructRev p with + Some(n,parent) when (Name.toString n = "*") -> begin + debug (fun() -> Util.msg "Expanding path %s\n" (Path.toString p)); + match lr with + None -> raise (Util.Fatal (Printf.sprintf + "Path %s ends with *, %s" + (Path.toString p) + "but first root (after canonizing) is non-local")) + | Some lrfspath -> + Safelist.map (fun c -> Path.magic' (Path.child parent c)) + (Os.childrenOf lrfspath parent) + end + | _ -> [Path.magic' p] + +let expandWildcardPaths() = + let lr = + match rootsInCanonicalOrder() with + [(Local, fspath); _] -> Some fspath + | _ -> None in + Prefs.set paths + (Safelist.flatten_map (globPath lr) (Prefs.read paths)) + +(*****************************************************************************) +(* PROPAGATION OF PREFERENCES *) +(*****************************************************************************) + +let propagatePrefsTo = + Remote.registerHostCmd + "installPrefs" + (fun prefs -> return (Prefs.load prefs)) + +let propagatePrefs () = + let prefs = Prefs.dump() in + let toHost root = + match root with + (Local, _) -> return () + | (Remote host,_) -> + propagatePrefsTo host prefs + in + allRootsIter toHost + +(*****************************************************************************) +(* PREFERENCES AND PREDICATES *) +(*****************************************************************************) + +let batch = + Prefs.createBool "batch" false "batch mode: ask no questions at all" + ("When this is set to {\\tt true}, the user " + ^ "interface will ask no questions at all. Non-conflicting changes " + ^ "will be propagated; conflicts will be skipped.") + +let confirmBigDeletes = + Prefs.createBool "confirmbigdel" true + "!ask about whole-replica (or path) deletes" + ("!When this is set to {\\tt true}, Unison will request an extra confirmation if it appears " + ^ "that the entire replica has been deleted, before propagating the change. If the {\\tt batch} " + ^ "flag is also set, synchronization will be aborted. When the {\\tt path} preference is used, " + ^ "the same confirmation will be requested for top-level paths. (At the moment, this flag only " + ^ "affects the text user interface.) See also the {\\tt mountpoint} preference.") + +let () = Prefs.alias confirmBigDeletes "confirmbigdeletes" + +let ignore = + Pred.create "ignore" + ("Including the preference \\texttt{-ignore \\ARG{pathspec}} causes Unison to " + ^ "completely ignore paths that match \\ARG{pathspec} (as well as their " + ^ "children). This is useful for avoiding synchronizing temporary " + ^ "files, object files, etc. The syntax of \\ARG{pathspec} is " + ^ "described in \\sectionref{pathspec}{Path Specification}, and further " + ^ "details on ignoring paths is found in" + ^ " \\sectionref{ignore}{Ignoring Paths}.") + +let ignorenot = + Pred.create "ignorenot" + ("This preference overrides the preference \\texttt{ignore}. + It gives a list of patterns + (in the same format as + \\verb|ignore|) for paths that should definitely {\\em not} be ignored, + whether or not they happen to match one of the \\verb|ignore| patterns. + \\par Note that the semantics of {\\tt ignore} and {\\tt ignorenot} is a + little counter-intuitive. When detecting updates, Unison examines + paths in depth-first order, starting from the roots of the replicas + and working downwards. Before examining each path, it checks whether + it matches {\\tt ignore} and does not match {\\tt ignorenot}; in this case + it skips this path {\\em and all its descendants}. This means that, + if some parent of a given path matches an {\\tt ignore} pattern, then + it will be skipped even if the path itself matches an {\\tt ignorenot} + pattern. In particular, putting {\\tt ignore = Path *} in your profile + and then using {\tt ignorenot} to select particular paths to be + synchronized will not work. Instead, you should use the {\\tt path} + preference to choose particular paths to synchronize.") + +let shouldIgnore p = + let p = Path.toString p in + (Pred.test ignore p) && not (Pred.test ignorenot p) + +let addRegexpToIgnore re = + let oldRE = Pred.extern ignore in + let newRE = re::oldRE in + Pred.intern ignore newRE + +let merge = + Pred.create "merge" ~advanced:true + ("This preference can be used to run a merge program which will create " + ^ "a new version for each of the files and the backup, " + ^ "with the last backup and the both replicas. Setting the {\\tt merge} " + ^ "preference for a path will also cause this path to be backed up, " + ^ "just like {\tt backup}. " + ^ "The syntax of \\ARG{pathspec>cmd} is " + ^ "described in \\sectionref{pathspec}{Path Specification}, and further " + ^ "details on Merging functions are present in " + ^ "\\sectionref{merge}{Merging files}.") + +let shouldMerge p = Pred.test merge (Path.toString p) + +let mergeCmdForPath p = Pred.assoc merge (Path.toString p) + +let someHostIsRunningWindows = + Prefs.createBool "someHostIsRunningWindows" false "*" "" + +let allHostsAreRunningWindows = + Prefs.createBool "allHostsAreRunningWindows" false "*" "" Deleted: branches/2.32/src/globals.mli =================================================================== --- trunk/src/globals.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/globals.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,86 +0,0 @@ -(* Unison file synchronizer: src/globals.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* Global variables and functions needed by top-level modules and user *) -(* interfaces *) - -(* The raw names of the roots as specified in the profile or on the command *) -(* line *) -val rawRoots : unit -> string list -val setRawRoots : string list -> unit - -(* Parse and canonize roots from their raw names *) -val installRoots : (string -> string -> string) option -> unit Lwt.t - -(* An alternate method (under development?) *) -val installRoots2 : unit -> unit - -(* The roots of the synchronization (with names canonized, but in the same *) -(* order as the user gave them) *) -val roots : unit -> Common.root * Common.root - -(* 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 *) -val rootsInCanonicalOrder : unit -> Common.root list - -(* Run a command on all roots *) -val allRootsIter : - (Common.root -> unit Lwt.t) -> unit Lwt.t - -(* Run a command on all roots *) -val allRootsIter2 : - (Common.root -> 'a -> unit Lwt.t) -> 'a list -> - unit Lwt.t - -(* Run a command on all roots and collect results *) -val allRootsMap : - (Common.root -> 'a Lwt.t) -> 'a list Lwt.t - -(* Run a command on all roots in parallel, and collect the results. *) -(* [allRootsMapWIthWaitingAction f wa] calls the function [wa] before *) -(* waiting for the result for the corresponding root. *) -val allRootsMapWithWaitingAction: - (Common.root -> 'a Lwt.t) -> (Common.root -> unit) -> 'a list Lwt.t - -(* The set of paths to synchronize within the replicas *) -val paths : Path.t list Prefs.t - -(* Expand any paths ending with * *) -val expandWildcardPaths : unit -> unit - -(* Run a command on all hosts in roots *) -val allHostsIter : (string -> unit Lwt.t) -> unit Lwt.t - -(* Run a command on all hosts in roots and collect results *) -val allHostsMap : (string -> 'a) -> 'a list - -(* Make sure that the server has the same settings for its preferences as we *) -(* do locally. Should be called whenever the local preferences have *) -(* changed. (This isn't conceptually a part of this module, but it can't *) -(* live in the Prefs module because that would introduce a circular *) -(* dependency.) *) -val propagatePrefs : unit -> unit Lwt.t - -(* User preference: when true, don't ask any questions *) -val batch : bool Prefs.t - -(* User preference: ask for confirmation when propagating a deletion of a whole replica or top-level path *) -val confirmBigDeletes : bool Prefs.t - -(* Predicates on paths *) -val shouldIgnore : 'a Path.path -> bool -val shouldMerge : 'a Path.path -> bool - -(* Be careful calling this to add new patterns to be ignored: Its value does NOT persist - when a new profile is loaded, so it has to be called again whenever this happens. *) -val addRegexpToIgnore : string -> unit - -(* Merging commands *) -val mergeCmdForPath : Path.t -> string - -(* Internal prefs, needed to know whether to do filenames checks *) -val someHostIsRunningWindows : bool Prefs.t -val allHostsAreRunningWindows : bool Prefs.t Copied: branches/2.32/src/globals.mli (from rev 320, trunk/src/globals.mli) =================================================================== --- branches/2.32/src/globals.mli (rev 0) +++ branches/2.32/src/globals.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,86 @@ +(* Unison file synchronizer: src/globals.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +(* Global variables and functions needed by top-level modules and user *) +(* interfaces *) + +(* The raw names of the roots as specified in the profile or on the command *) +(* line *) +val rawRoots : unit -> string list +val setRawRoots : string list -> unit + +(* Parse and canonize roots from their raw names *) +val installRoots : (string -> string -> string) option -> unit Lwt.t + +(* An alternate method (under development?) *) +val installRoots2 : unit -> unit + +(* The roots of the synchronization (with names canonized, but in the same *) +(* order as the user gave them) *) +val roots : unit -> Common.root * Common.root + +(* 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 *) +val rootsInCanonicalOrder : unit -> Common.root list + +(* Run a command on all roots *) +val allRootsIter : + (Common.root -> unit Lwt.t) -> unit Lwt.t + +(* Run a command on all roots *) +val allRootsIter2 : + (Common.root -> 'a -> unit Lwt.t) -> 'a list -> + unit Lwt.t + +(* Run a command on all roots and collect results *) +val allRootsMap : + (Common.root -> 'a Lwt.t) -> 'a list Lwt.t + +(* Run a command on all roots in parallel, and collect the results. *) +(* [allRootsMapWIthWaitingAction f wa] calls the function [wa] before *) +(* waiting for the result for the corresponding root. *) +val allRootsMapWithWaitingAction: + (Common.root -> 'a Lwt.t) -> (Common.root -> unit) -> 'a list Lwt.t + +(* The set of paths to synchronize within the replicas *) +val paths : Path.t list Prefs.t + +(* Expand any paths ending with * *) +val expandWildcardPaths : unit -> unit + +(* Run a command on all hosts in roots *) +val allHostsIter : (string -> unit Lwt.t) -> unit Lwt.t + +(* Run a command on all hosts in roots and collect results *) +val allHostsMap : (string -> 'a) -> 'a list + +(* Make sure that the server has the same settings for its preferences as we *) +(* do locally. Should be called whenever the local preferences have *) +(* changed. (This isn't conceptually a part of this module, but it can't *) +(* live in the Prefs module because that would introduce a circular *) +(* dependency.) *) +val propagatePrefs : unit -> unit Lwt.t + +(* User preference: when true, don't ask any questions *) +val batch : bool Prefs.t + +(* User preference: ask for confirmation when propagating a deletion of a whole replica or top-level path *) +val confirmBigDeletes : bool Prefs.t + +(* Predicates on paths *) +val shouldIgnore : 'a Path.path -> bool +val shouldMerge : 'a Path.path -> bool + +(* Be careful calling this to add new patterns to be ignored: Its value does NOT persist + when a new profile is loaded, so it has to be called again whenever this happens. *) +val addRegexpToIgnore : string -> unit + +(* Merging commands *) +val mergeCmdForPath : Path.t -> string + +(* Internal prefs, needed to know whether to do filenames checks *) +val someHostIsRunningWindows : bool Prefs.t +val allHostsAreRunningWindows : bool Prefs.t Deleted: branches/2.32/src/linkgtk.ml =================================================================== --- trunk/src/linkgtk.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/linkgtk.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,4 +0,0 @@ -(* Unison file synchronizer: src/linkgtk.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -module TopLevel = Main.Body(Uigtk.Body) Copied: branches/2.32/src/linkgtk.ml (from rev 320, trunk/src/linkgtk.ml) =================================================================== --- branches/2.32/src/linkgtk.ml (rev 0) +++ branches/2.32/src/linkgtk.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,19 @@ +(* Unison file synchronizer: src/linkgtk.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +module TopLevel = Main.Body(Uigtk.Body) Deleted: branches/2.32/src/linkgtk2.ml =================================================================== --- trunk/src/linkgtk2.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/linkgtk2.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,4 +0,0 @@ -(* Unison file synchronizer: src/linkgtk2.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -module TopLevel = Main.Body(Uigtk2.Body) Copied: branches/2.32/src/linkgtk2.ml (from rev 320, trunk/src/linkgtk2.ml) =================================================================== --- branches/2.32/src/linkgtk2.ml (rev 0) +++ branches/2.32/src/linkgtk2.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,19 @@ +(* Unison file synchronizer: src/linkgtk2.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +module TopLevel = Main.Body(Uigtk2.Body) Deleted: branches/2.32/src/linktext.ml =================================================================== --- trunk/src/linktext.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/linktext.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,4 +0,0 @@ -(* Unison file synchronizer: src/linktext.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -module TopLevel = Main.Body(Uitext.Body) Copied: branches/2.32/src/linktext.ml (from rev 320, trunk/src/linktext.ml) =================================================================== --- branches/2.32/src/linktext.ml (rev 0) +++ branches/2.32/src/linktext.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,19 @@ +(* Unison file synchronizer: src/linktext.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +module TopLevel = Main.Body(Uitext.Body) Deleted: branches/2.32/src/linktk.ml =================================================================== --- trunk/src/linktk.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/linktk.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,4 +0,0 @@ -(* Unison file synchronizer: src/linktk.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -module TopLevel = Main.Body(Uitk.Body) Copied: branches/2.32/src/linktk.ml (from rev 320, trunk/src/linktk.ml) =================================================================== --- branches/2.32/src/linktk.ml (rev 0) +++ branches/2.32/src/linktk.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,19 @@ +(* Unison file synchronizer: src/linktk.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +module TopLevel = Main.Body(Uitk.Body) Deleted: branches/2.32/src/lock.ml =================================================================== --- trunk/src/lock.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/lock.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,41 +0,0 @@ -(* Unison file synchronizer: src/lock.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -let rename oldFile newFile = - begin try Unix.link oldFile newFile with Unix.Unix_error _ -> () end; - let res = try (Unix.LargeFile.stat oldFile).Unix.LargeFile.st_nlink = 2 - with Unix.Unix_error _ -> false - in - Unix.unlink oldFile; - res - -let flags = [Unix.O_WRONLY; Unix.O_CREAT; Unix.O_EXCL] -let create name mode = - try - Unix.close (Unix.openfile name flags mode); - true - with Unix.Unix_error (Unix.EEXIST, _, _) -> - false - -let rec unique name i mode = - let nm = name ^ string_of_int i in - if create nm mode then nm else - (* highly unlikely *) - unique name (i + 1) mode - -let acquire name = - Util.convertUnixErrorsToTransient - "Lock.acquire" - (fun () -> - match Util.osType with - `Unix -> (* O_EXCL is broken under NFS... *) - rename (unique name (Unix.getpid ()) 0o600) name - | _ -> - create name 0o600) - -let release name = try Unix.unlink name with Unix.Unix_error _ -> () - -let is_locked name = - Util.convertUnixErrorsToTransient - "Lock.test" - (fun () -> Sys.file_exists name) Copied: branches/2.32/src/lock.ml (from rev 320, trunk/src/lock.ml) =================================================================== --- branches/2.32/src/lock.ml (rev 0) +++ branches/2.32/src/lock.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,56 @@ +(* Unison file synchronizer: src/lock.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +let rename oldFile newFile = + begin try Unix.link oldFile newFile with Unix.Unix_error _ -> () end; + let res = try (Unix.LargeFile.stat oldFile).Unix.LargeFile.st_nlink = 2 + with Unix.Unix_error _ -> false + in + Unix.unlink oldFile; + res + +let flags = [Unix.O_WRONLY; Unix.O_CREAT; Unix.O_EXCL] +let create name mode = + try + Unix.close (Unix.openfile name flags mode); + true + with Unix.Unix_error (Unix.EEXIST, _, _) -> + false + +let rec unique name i mode = + let nm = name ^ string_of_int i in + if create nm mode then nm else + (* highly unlikely *) + unique name (i + 1) mode + +let acquire name = + Util.convertUnixErrorsToTransient + "Lock.acquire" + (fun () -> + match Util.osType with + `Unix -> (* O_EXCL is broken under NFS... *) + rename (unique name (Unix.getpid ()) 0o600) name + | _ -> + create name 0o600) + +let release name = try Unix.unlink name with Unix.Unix_error _ -> () + +let is_locked name = + Util.convertUnixErrorsToTransient + "Lock.test" + (fun () -> Sys.file_exists name) Deleted: branches/2.32/src/lock.mli =================================================================== --- trunk/src/lock.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/lock.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,9 +0,0 @@ -(* Unison file synchronizer: src/lock.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* A simple utility module for setting and releasing inter-process locks - using entries in the filesystem. *) - -val acquire : string -> bool -val release : string -> unit -val is_locked : string -> bool Copied: branches/2.32/src/lock.mli (from rev 320, trunk/src/lock.mli) =================================================================== --- branches/2.32/src/lock.mli (rev 0) +++ branches/2.32/src/lock.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,9 @@ +(* Unison file synchronizer: src/lock.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +(* A simple utility module for setting and releasing inter-process locks + using entries in the filesystem. *) + +val acquire : string -> bool +val release : string -> unit +val is_locked : string -> bool Deleted: branches/2.32/src/lwt/pqueue.ml =================================================================== --- trunk/src/lwt/pqueue.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/lwt/pqueue.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,79 +0,0 @@ -(* Unison file synchronizer: src/lwt/pqueue.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -module type OrderedType = - sig - type t - val compare: t -> t -> int - end - -module type S = - sig - type elt - type t - val empty: t - val is_empty: t -> bool - val add: elt -> t -> t - val union: t -> t -> t - val find_min: t -> elt - val remove_min: t -> t - end - -module Make(Ord: OrderedType) : (S with type elt = Ord.t) = - struct - type elt = Ord.t - - type t = tree list - and tree = Node of elt * int * tree list - - let root (Node (x, _, _)) = x - let rank (Node (_, r, _)) = r - let link (Node (x1, r1, c1) as t1) (Node (x2, r2, c2) as t2) = - let c = Ord.compare x1 x2 in - if c <= 0 then Node (x1, r1 + 1, t2::c1) else Node(x2, r2 + 1, t1::c2) - let rec ins t = - function - [] -> - [t] - | (t'::_) as ts when rank t < rank t' -> - t::ts - | t'::ts -> - ins (link t t') ts - - let empty = [] - let is_empty ts = ts = [] - let add x ts = ins (Node (x, 0, [])) ts - let rec union ts ts' = - match ts, ts' with - ([], _) -> ts' - | (_, []) -> ts - | (t1::ts1, t2::ts2) -> - if rank t1 < rank t2 then t1 :: union ts1 (t2::ts2) - else if rank t2 < rank t1 then t2 :: union (t1::ts1) ts2 - else ins (link t1 t2) (union ts1 ts2) - - let rec find_min = - function - [] -> raise Not_found - | [t] -> root t - | t::ts -> - let x = find_min ts in - let c = Ord.compare (root t) x in - if c < 0 then root t else x - - let rec get_min = - function - [] -> assert false - | [t] -> (t, []) - | t::ts -> - let (t', ts') = get_min ts in - let c = Ord.compare (root t) (root t') in - if c < 0 then (t, ts) else (t', t::ts') - - let remove_min = - function - [] -> raise Not_found - | ts -> - let (Node (x, r, c), ts) = get_min ts in - union (List.rev c) ts - end Copied: branches/2.32/src/lwt/pqueue.ml (from rev 320, trunk/src/lwt/pqueue.ml) =================================================================== --- branches/2.32/src/lwt/pqueue.ml (rev 0) +++ branches/2.32/src/lwt/pqueue.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,94 @@ +(* Unison file synchronizer: src/lwt/pqueue.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +module type OrderedType = + sig + type t + val compare: t -> t -> int + end + +module type S = + sig + type elt + type t + val empty: t + val is_empty: t -> bool + val add: elt -> t -> t + val union: t -> t -> t + val find_min: t -> elt + val remove_min: t -> t + end + +module Make(Ord: OrderedType) : (S with type elt = Ord.t) = + struct + type elt = Ord.t + + type t = tree list + and tree = Node of elt * int * tree list + + let root (Node (x, _, _)) = x + let rank (Node (_, r, _)) = r + let link (Node (x1, r1, c1) as t1) (Node (x2, r2, c2) as t2) = + let c = Ord.compare x1 x2 in + if c <= 0 then Node (x1, r1 + 1, t2::c1) else Node(x2, r2 + 1, t1::c2) + let rec ins t = + function + [] -> + [t] + | (t'::_) as ts when rank t < rank t' -> + t::ts + | t'::ts -> + ins (link t t') ts + + let empty = [] + let is_empty ts = ts = [] + let add x ts = ins (Node (x, 0, [])) ts + let rec union ts ts' = + match ts, ts' with + ([], _) -> ts' + | (_, []) -> ts + | (t1::ts1, t2::ts2) -> + if rank t1 < rank t2 then t1 :: union ts1 (t2::ts2) + else if rank t2 < rank t1 then t2 :: union (t1::ts1) ts2 + else ins (link t1 t2) (union ts1 ts2) + + let rec find_min = + function + [] -> raise Not_found + | [t] -> root t + | t::ts -> + let x = find_min ts in + let c = Ord.compare (root t) x in + if c < 0 then root t else x + + let rec get_min = + function + [] -> assert false + | [t] -> (t, []) + | t::ts -> + let (t', ts') = get_min ts in + let c = Ord.compare (root t) (root t') in + if c < 0 then (t, ts) else (t', t::ts') + + let remove_min = + function + [] -> raise Not_found + | ts -> + let (Node (x, r, c), ts) = get_min ts in + union (List.rev c) ts + end Deleted: branches/2.32/src/lwt/pqueue.mli =================================================================== --- trunk/src/lwt/pqueue.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/lwt/pqueue.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,22 +0,0 @@ -(* Unison file synchronizer: src/lwt/pqueue.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -module type OrderedType = - sig - type t - val compare: t -> t -> int - end - -module type S = - sig - type elt - type t - val empty: t - val is_empty: t -> bool - val add: elt -> t -> t - val union: t -> t -> t - val find_min: t -> elt - val remove_min: t -> t - end - -module Make(Ord: OrderedType) : S with type elt = Ord.t Copied: branches/2.32/src/lwt/pqueue.mli (from rev 320, trunk/src/lwt/pqueue.mli) =================================================================== --- branches/2.32/src/lwt/pqueue.mli (rev 0) +++ branches/2.32/src/lwt/pqueue.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,22 @@ +(* Unison file synchronizer: src/lwt/pqueue.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +module type OrderedType = + sig + type t + val compare: t -> t -> int + end + +module type S = + sig + type elt + type t + val empty: t + val is_empty: t -> bool + val add: elt -> t -> t + val union: t -> t -> t + val find_min: t -> elt + val remove_min: t -> t + end + +module Make(Ord: OrderedType) : S with type elt = Ord.t Deleted: branches/2.32/src/main.ml =================================================================== --- trunk/src/main.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/main.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,226 +0,0 @@ -(* Unison file synchronizer: src/main.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* ---------------------------------------------------------------------- *) - -(* This is the main program -- the thing that gets executed first when - unison is run. - - The Main module is actually a functor that takes the user interface - (e.g., Uitext or Uigtk) as a parameter. This allows us to build with - just one user interface at a time, which avoids having to always link - in all the libraries needed by all the user interfaces. - - A non-functor interface is provided to allow the Mac GUI to reuse the - startup code for non-GUI options. - *) - -(* ---------------------------------------------------------------------- *) - -(* Some command-line arguments are handled specially during startup, e.g., - -doc - -help - -version - -server - -socket - -ui - They are expected to appear on the command-line only, not in a - profile. In particular, -version and -doc will print to the - standard output, so they only make sense if invoked from the - command-line (and not a click-launched gui that has no standard - output). - - Furthermore, the actions associated with these command-line - arguments are executed without loading a profile or doing the usual - command-line parsing. This is because we want to run the actions - without loading a profile; and then we can't do command-line - parsing because it is intertwined with profile loading. - - NB: the Mac GUI handles these options itself and needs to change - if any more are added. -*) - -let versionPrefName = "version" -let printVersionAndExit = - Prefs.createBool versionPrefName false "print version and exit" - ("Print the current version number and exit. " - ^ "(This option only makes sense on the command line.)") - -let docsPrefName = "doc" -let docs = - Prefs.createString docsPrefName "" - "show documentation ('-doc topics' lists topics)" - ( "The command-line argument \\texttt{-doc \\ARG{secname}} causes unison to " - ^ "display section \\ARG{secname} of the manual on the standard output " - ^ "and then exit. Use \\verb|-doc all| to display the whole manual, " - ^ "which includes exactly the same information as the printed and HTML " - ^ "manuals, modulo " - ^ "formatting. Use \\verb|-doc topics| to obtain a list of the " - ^ "names of the various sections that can be printed.") - -let prefsdocsPrefName = "prefsdocs" -let prefsdocs = - Prefs.createBool prefsdocsPrefName false - "*show full documentation for all preferences (and then exit)" - "" - -let serverPrefName = "server" -let server = - Prefs.createBool serverPrefName false "*normal or server mode" "" - -let socketPrefName = "socket" -let socket = - Prefs.create socketPrefName None - "!act as a server on a socket" "" - (fun _ -> fun i -> - (try - Some(int_of_string i) - with Failure "int_of_string" -> - raise(Prefs.IllegalValue "-socket must be followed by a number"))) - (function None -> [] | Some(i) -> [string_of_int i]) ;; - -let serverHostName = "host" -let serverHost = - Prefs.createString serverHostName "" - "!bind the socket to this host name in server socket mode" "" - -(* User preference for which UI to use if there is a choice *) -let uiPrefName = "ui" -let interface = - Prefs.create uiPrefName Uicommon.Graphic - "!select UI ('text' or 'graphic'); command-line only" - ("This preference selects either the graphical or the textual user " - ^ "interface. Legal values are \\verb|graphic| or \\verb|text|. " - ^ "\n\nBecause this option is processed specially during Unison's " - ^ "start-up sequence, it can {\\em only} be used on the command line. " - ^ "In preference files it has no effect." - ^ "\n\nIf " - ^ "the Unison executable was compiled with only a textual interface, " - ^ "this option has " - ^ "no effect. (The pre-compiled binaries are all compiled with both " - ^ "interfaces available.)") - (fun _ -> function - "text" -> Uicommon.Text - | "graphic" -> Uicommon.Graphic - | other -> - raise (Prefs.IllegalValue ("option ui :\n\ - text -> textual user interface\n\ - graphic -> graphic user interface\n" - ^other^ " is not a legal value"))) - (function Uicommon.Text -> ["text"] - | Uicommon.Graphic -> ["graphic"]);; - -let init() = begin - ignore (Gc.set {(Gc.get ()) with Gc.max_overhead = 150}); - - let argv = Prefs.scanCmdLine Uicommon.usageMsg in - - let catch_all f = - (try f () with e -> Util.msg "%s\n" (Uicommon.exn2string e); exit 1) in - - (* Print version if requested *) - if Util.StringMap.mem versionPrefName argv then begin - Printf.printf "%s version %s\n" Uutil.myName Uutil.myVersion; - exit 0 - end; - - (* Print docs for all preferences if requested (this is used when building - the manual) *) - if Util.StringMap.mem prefsdocsPrefName argv then begin - Prefs.printFullDocs(); - exit 0 - end; - - (* Display documentation if requested *) - begin try - begin match Util.StringMap.find docsPrefName argv with - [] -> - assert false - | "topics"::_ -> - Printf.printf "Documentation topics:\n"; - Safelist.iter - (fun (sn,(n,doc)) -> - if sn<>"" then Printf.printf " %12s %s\n" sn n) - Strings.docs; - Printf.printf - "\nType \"%s -doc \" for detailed information about \n" - Uutil.myName; - Printf.printf - "or \"%s -doc all\" for the whole manual\n\n" - Uutil.myName - | "all"::_ -> - Printf.printf "\n"; - Safelist.iter - (fun (sn,(n,doc)) -> if n<>"Junk" then Printf.printf "%s\n" doc) - Strings.docs - | topic::_ -> - (try - let (_,d) = Safelist.assoc topic Strings.docs in - Printf.printf "\n%s\n" d - with - Not_found -> - Printf.printf "Documentation topic %s not recognized:" - topic; - Printf.printf "\nType \"%s -doc topics\" for a list\n" - Uutil.myName) - end; - exit 0 - with Not_found -> () end; - - (* 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 -> Fspath.toString (Os.fileInUnisonDir(n))); - - (* Start a server if requested *) - if Util.StringMap.mem serverPrefName argv then begin - catch_all (fun () -> - Os.createUnisonDir(); - Remote.beAServer(); - exit 0) - end; - - (* Start a socket server if requested *) - begin try - let i = List.hd (Util.StringMap.find socketPrefName argv) in - catch_all (fun () -> - Os.createUnisonDir(); - Remote.waitOnPort - (begin try - match Util.StringMap.find serverHostName argv with - [] -> None - | s :: _ -> Some s - with Not_found -> - None - end) - i); - exit 0 - with Not_found -> () end; - argv -end - -(* non-GUI startup for Mac GUI version *) -let nonGuiStartup() = begin - let argv = init() in (* might not return *) - (* if it returns start a UI *) - (try - (match Util.StringMap.find uiPrefName argv with - "text"::_ -> (Uitext.Body.start Uicommon.Text; exit 0) - | "graphic"::_ -> () (* fallthru *) - | _ -> Prefs.printUsage Uicommon.usageMsg; exit 1) - with Not_found -> ()); - () -end - -module Body = functor(Ui : Uicommon.UI) -> struct - let argv = init() in (* might not return *) - (* if it returns start a UI *) - Ui.start - (try - (match Util.StringMap.find uiPrefName argv with - "text"::_ -> Uicommon.Text - | "graphic"::_ -> Uicommon.Graphic - | _ -> Prefs.printUsage Uicommon.usageMsg; exit 1) - with Not_found -> Ui.defaultUi) -end Copied: branches/2.32/src/main.ml (from rev 320, trunk/src/main.ml) =================================================================== --- branches/2.32/src/main.ml (rev 0) +++ branches/2.32/src/main.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,241 @@ +(* Unison file synchronizer: src/main.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +(* ---------------------------------------------------------------------- *) + +(* This is the main program -- the thing that gets executed first when + unison is run. + + The Main module is actually a functor that takes the user interface + (e.g., Uitext or Uigtk) as a parameter. This allows us to build with + just one user interface at a time, which avoids having to always link + in all the libraries needed by all the user interfaces. + + A non-functor interface is provided to allow the Mac GUI to reuse the + startup code for non-GUI options. + *) + +(* ---------------------------------------------------------------------- *) + +(* Some command-line arguments are handled specially during startup, e.g., + -doc + -help + -version + -server + -socket + -ui + They are expected to appear on the command-line only, not in a + profile. In particular, -version and -doc will print to the + standard output, so they only make sense if invoked from the + command-line (and not a click-launched gui that has no standard + output). + + Furthermore, the actions associated with these command-line + arguments are executed without loading a profile or doing the usual + command-line parsing. This is because we want to run the actions + without loading a profile; and then we can't do command-line + parsing because it is intertwined with profile loading. + + NB: the Mac GUI handles these options itself and needs to change + if any more are added. +*) + +let versionPrefName = "version" +let printVersionAndExit = + Prefs.createBool versionPrefName false "print version and exit" + ("Print the current version number and exit. " + ^ "(This option only makes sense on the command line.)") + +let docsPrefName = "doc" +let docs = + Prefs.createString docsPrefName "" + "show documentation ('-doc topics' lists topics)" + ( "The command-line argument \\texttt{-doc \\ARG{secname}} causes unison to " + ^ "display section \\ARG{secname} of the manual on the standard output " + ^ "and then exit. Use \\verb|-doc all| to display the whole manual, " + ^ "which includes exactly the same information as the printed and HTML " + ^ "manuals, modulo " + ^ "formatting. Use \\verb|-doc topics| to obtain a list of the " + ^ "names of the various sections that can be printed.") + +let prefsdocsPrefName = "prefsdocs" +let prefsdocs = + Prefs.createBool prefsdocsPrefName false + "*show full documentation for all preferences (and then exit)" + "" + +let serverPrefName = "server" +let server = + Prefs.createBool serverPrefName false "*normal or server mode" "" + +let socketPrefName = "socket" +let socket = + Prefs.create socketPrefName None + "!act as a server on a socket" "" + (fun _ -> fun i -> + (try + Some(int_of_string i) + with Failure "int_of_string" -> + raise(Prefs.IllegalValue "-socket must be followed by a number"))) + (function None -> [] | Some(i) -> [string_of_int i]) ;; + +let serverHostName = "host" +let serverHost = + Prefs.createString serverHostName "" + "!bind the socket to this host name in server socket mode" "" + +(* User preference for which UI to use if there is a choice *) +let uiPrefName = "ui" +let interface = + Prefs.create uiPrefName Uicommon.Graphic + "!select UI ('text' or 'graphic'); command-line only" + ("This preference selects either the graphical or the textual user " + ^ "interface. Legal values are \\verb|graphic| or \\verb|text|. " + ^ "\n\nBecause this option is processed specially during Unison's " + ^ "start-up sequence, it can {\\em only} be used on the command line. " + ^ "In preference files it has no effect." + ^ "\n\nIf " + ^ "the Unison executable was compiled with only a textual interface, " + ^ "this option has " + ^ "no effect. (The pre-compiled binaries are all compiled with both " + ^ "interfaces available.)") + (fun _ -> function + "text" -> Uicommon.Text + | "graphic" -> Uicommon.Graphic + | other -> + raise (Prefs.IllegalValue ("option ui :\n\ + text -> textual user interface\n\ + graphic -> graphic user interface\n" + ^other^ " is not a legal value"))) + (function Uicommon.Text -> ["text"] + | Uicommon.Graphic -> ["graphic"]);; + +let init() = begin + ignore (Gc.set {(Gc.get ()) with Gc.max_overhead = 150}); + + let argv = Prefs.scanCmdLine Uicommon.usageMsg in + + let catch_all f = + (try f () with e -> Util.msg "%s\n" (Uicommon.exn2string e); exit 1) in + + (* Print version if requested *) + if Util.StringMap.mem versionPrefName argv then begin + Printf.printf "%s version %s\n" Uutil.myName Uutil.myVersion; + exit 0 + end; + + (* Print docs for all preferences if requested (this is used when building + the manual) *) + if Util.StringMap.mem prefsdocsPrefName argv then begin + Prefs.printFullDocs(); + exit 0 + end; + + (* Display documentation if requested *) + begin try + begin match Util.StringMap.find docsPrefName argv with + [] -> + assert false + | "topics"::_ -> + Printf.printf "Documentation topics:\n"; + Safelist.iter + (fun (sn,(n,doc)) -> + if sn<>"" then Printf.printf " %12s %s\n" sn n) + Strings.docs; + Printf.printf + "\nType \"%s -doc \" for detailed information about \n" + Uutil.myName; + Printf.printf + "or \"%s -doc all\" for the whole manual\n\n" + Uutil.myName + | "all"::_ -> + Printf.printf "\n"; + Safelist.iter + (fun (sn,(n,doc)) -> if n<>"Junk" then Printf.printf "%s\n" doc) + Strings.docs + | topic::_ -> + (try + let (_,d) = Safelist.assoc topic Strings.docs in + Printf.printf "\n%s\n" d + with + Not_found -> + Printf.printf "Documentation topic %s not recognized:" + topic; + Printf.printf "\nType \"%s -doc topics\" for a list\n" + Uutil.myName) + end; + exit 0 + with Not_found -> () end; + + (* 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 -> Fspath.toString (Os.fileInUnisonDir(n))); + + (* Start a server if requested *) + if Util.StringMap.mem serverPrefName argv then begin + catch_all (fun () -> + Os.createUnisonDir(); + Remote.beAServer(); + exit 0) + end; + + (* Start a socket server if requested *) + begin try + let i = List.hd (Util.StringMap.find socketPrefName argv) in + catch_all (fun () -> + Os.createUnisonDir(); + Remote.waitOnPort + (begin try + match Util.StringMap.find serverHostName argv with + [] -> None + | s :: _ -> Some s + with Not_found -> + None + end) + i); + exit 0 + with Not_found -> () end; + argv +end + +(* non-GUI startup for Mac GUI version *) +let nonGuiStartup() = begin + let argv = init() in (* might not return *) + (* if it returns start a UI *) + (try + (match Util.StringMap.find uiPrefName argv with + "text"::_ -> (Uitext.Body.start Uicommon.Text; exit 0) + | "graphic"::_ -> () (* fallthru *) + | _ -> Prefs.printUsage Uicommon.usageMsg; exit 1) + with Not_found -> ()); + () +end + +module Body = functor(Ui : Uicommon.UI) -> struct + let argv = init() in (* might not return *) + (* if it returns start a UI *) + Ui.start + (try + (match Util.StringMap.find uiPrefName argv with + "text"::_ -> Uicommon.Text + | "graphic"::_ -> Uicommon.Graphic + | _ -> Prefs.printUsage Uicommon.usageMsg; exit 1) + with Not_found -> Ui.defaultUi) +end Deleted: branches/2.32/src/mkProjectInfo.ml =================================================================== --- trunk/src/mkProjectInfo.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/mkProjectInfo.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,105 +0,0 @@ -(* Program for printing project info into a Makefile. Documentation below. *) - -(* FIX: When the time comes for the next alpha-release, remember to - increment the archive version number first. See update.ml. *) - -let projectName = "unison" -let majorVersion = 2 -let minorVersion = 32 -let pointVersionOrigin = 313 (* Revision that corresponds to point version 0 *) - -(* Documentation: - This is a program to construct a version of the form Major.Minor.Point, - e.g., 2.10.4. - The Point release number is calculated from the Subversion revision number, - so it will be automatically incremented on svn commit. - The Major and Minor numbers are hard coded, as is the revision number - corresponding to the 0 point release. - - If you want to increment the Major or Minor number, you will have to do a - little thinking to get the Point number back to 0. Suppose the current svn - revision number is 27, and we have below - - let majorVersion = 2 - let minorVersion = 11 - let pointVersionOrigin = 3 - - This means that the current Unison version is 2.11.24, since 27-3 = 24. - If we want to change the release to 3.0.0 we need to change things to - - let majorVersion = 3 - let minorVersion = 0 - let pointVersionOrigin = 28 - - and then do a svn commit. - - The first two lines are obvious. The last line says that Subversion - revision 28 corresponds to a 0 point release. Since we were at revision - 27 and we're going to do a commit before making a release, we - will be at 28 after the commit and this will be Unison version 3.0.0. -*) - -(* ---------------------------------------------------------------------- *) -(* You shouldn't need to edit below. *) - -let revisionString = "$Rev$";; -let revision = Scanf.sscanf revisionString "$Rev: %d " (fun x -> x);; -let pointVersion = revision - pointVersionOrigin;; - -Printf.printf "MAJORVERSION=%d.%d\n" majorVersion minorVersion;; -Printf.printf "VERSION=%d.%d.%d\n" majorVersion minorVersion pointVersion;; -Printf.printf "NAME=%s\n" projectName;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Copied: branches/2.32/src/mkProjectInfo.ml (from rev 321, trunk/src/mkProjectInfo.ml) =================================================================== --- branches/2.32/src/mkProjectInfo.ml (rev 0) +++ branches/2.32/src/mkProjectInfo.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,107 @@ +(* Program for printing project info into a Makefile. Documentation below. *) + +(* FIX: When the time comes for the next alpha-release, remember to + increment the archive version number first. See update.ml. *) + +let projectName = "unison" +let majorVersion = 2 +let minorVersion = 32 +let pointVersionOrigin = 313 (* Revision that corresponds to point version 0 *) + +(* Documentation: + This is a program to construct a version of the form Major.Minor.Point, + e.g., 2.10.4. + The Point release number is calculated from the Subversion revision number, + so it will be automatically incremented on svn commit. + The Major and Minor numbers are hard coded, as is the revision number + corresponding to the 0 point release. + + If you want to increment the Major or Minor number, you will have to do a + little thinking to get the Point number back to 0. Suppose the current svn + revision number is 27, and we have below + + let majorVersion = 2 + let minorVersion = 11 + let pointVersionOrigin = 3 + + This means that the current Unison version is 2.11.24, since 27-3 = 24. + If we want to change the release to 3.0.0 we need to change things to + + let majorVersion = 3 + let minorVersion = 0 + let pointVersionOrigin = 28 + + and then do a svn commit. + + The first two lines are obvious. The last line says that Subversion + revision 28 corresponds to a 0 point release. Since we were at revision + 27 and we're going to do a commit before making a release, we + will be at 28 after the commit and this will be Unison version 3.0.0. +*) + +(* ---------------------------------------------------------------------- *) +(* You shouldn't need to edit below. *) + +let revisionString = "$Rev$";; +let revision = Scanf.sscanf revisionString "$Rev: %d " (fun x -> x);; +let pointVersion = revision - pointVersionOrigin;; + +Printf.printf "MAJORVERSION=%d.%d\n" majorVersion minorVersion;; +Printf.printf "VERSION=%d.%d.%d\n" majorVersion minorVersion pointVersion;; +Printf.printf "NAME=%s\n" projectName;; + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + Deleted: branches/2.32/src/name.ml =================================================================== --- trunk/src/name.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/name.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,30 +0,0 @@ -(* Unison file synchronizer: src/name.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* NOTE: IF YOU CHANGE TYPE "NAME", THE ARCHIVE FORMAT CHANGES; - INCREMENT "UPDATE.ARCHIVEFORMAT" *) -type t = string - -let compare n1 n2 = - if Case.insensitive () then - Util.nocase_cmp (Case.normalize n1) (Case.normalize n2) - else - compare n1 n2 - -let eq a b = (0 = (compare a b)) - -let toString n = n - -let fromString s = - if String.length s = 0 then - raise(Invalid_argument "Name.fromString(empty string)"); - (* Make sure there are no slashes in the s *) - begin try - ignore(String.index s '/'); - raise (Util.Transient (Printf.sprintf "Filename '%s' contains a '/'" s)) - with Not_found -> () end; - (* We ought to consider further checks, e.g., in Windows, no colons *) - s - -let hash n = - Hashtbl.hash (if Case.insensitive () then String.lowercase (Case.normalize n) else n) Copied: branches/2.32/src/name.ml (from rev 320, trunk/src/name.ml) =================================================================== --- branches/2.32/src/name.ml (rev 0) +++ branches/2.32/src/name.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,45 @@ +(* Unison file synchronizer: src/name.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +(* NOTE: IF YOU CHANGE TYPE "NAME", THE ARCHIVE FORMAT CHANGES; + INCREMENT "UPDATE.ARCHIVEFORMAT" *) +type t = string + +let compare n1 n2 = + if Case.insensitive () then + Util.nocase_cmp (Case.normalize n1) (Case.normalize n2) + else + compare n1 n2 + +let eq a b = (0 = (compare a b)) + +let toString n = n + +let fromString s = + if String.length s = 0 then + raise(Invalid_argument "Name.fromString(empty string)"); + (* Make sure there are no slashes in the s *) + begin try + ignore(String.index s '/'); + raise (Util.Transient (Printf.sprintf "Filename '%s' contains a '/'" s)) + with Not_found -> () end; + (* We ought to consider further checks, e.g., in Windows, no colons *) + s + +let hash n = + Hashtbl.hash (if Case.insensitive () then String.lowercase (Case.normalize n) else n) Deleted: branches/2.32/src/name.mli =================================================================== --- trunk/src/name.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/name.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,11 +0,0 @@ -(* Unison file synchronizer: src/name.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -type t - -val fromString : string -> t -val toString : t -> string - -val compare : t -> t -> int -val eq : t -> t -> bool -val hash : t -> int Copied: branches/2.32/src/name.mli (from rev 320, trunk/src/name.mli) =================================================================== --- branches/2.32/src/name.mli (rev 0) +++ branches/2.32/src/name.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,11 @@ +(* Unison file synchronizer: src/name.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +type t + +val fromString : string -> t +val toString : t -> string + +val compare : t -> t -> int +val eq : t -> t -> bool +val hash : t -> int Deleted: branches/2.32/src/os.ml =================================================================== --- trunk/src/os.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/os.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,349 +0,0 @@ -(* Unison file synchronizer: src/os.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* This file attempts to isolate operating system specific details from the *) -(* rest of the program. *) - -let debug = Util.debug "os" - -let myCanonicalHostName = - try Unix.getenv "UNISONLOCALHOSTNAME" - with Not_found -> Unix.gethostname() - -let tempFilePrefix = ".unison." -let tempFileSuffixFixed = ".unison.tmp" -let tempFileSuffix = ref tempFileSuffixFixed -let includeInTempNames s = - (* BCP: Added this in Jan 08. If (as I believe) it never fails, then this tricky - stuff can be deleted. *) - assert (s<>""); - tempFileSuffix := - if s = "" then tempFileSuffixFixed - else "." ^ s ^ tempFileSuffixFixed - -let xferDelete = ref (fun (fp,p) -> ()) -let xferRename = ref (fun (fp,p) (ftp,tp) -> ()) - -let initializeXferFunctions del ren = - xferDelete := del; - xferRename := ren - - -(*****************************************************************************) -(* ESCAPING SHELL PARAMETERS *) -(*****************************************************************************) - -(* Using single quotes is simpler under Unix but they are not accepted - by the Windows shell. Double quotes without further quoting is - sufficient with Windows as filenames are not allowed to contain - double quotes. *) -let quotes s = - if Util.osType = `Win32 && not Util.isCygwin then - "\"" ^ s ^ "\"" - else - "'" ^ Util.replacesubstring s "'" "'\\''" ^ "'" - -(*****************************************************************************) -(* QUERYING THE FILESYSTEM *) -(*****************************************************************************) - -let exists fspath path = - (Fileinfo.get false fspath path).Fileinfo.typ <> `ABSENT - -let readLink fspath path = - Util.convertUnixErrorsToTransient - "reading symbolic link" - (fun () -> - let abspath = Fspath.concatToString fspath path in - Unix.readlink abspath) - -let rec isAppleDoubleFile file = - Prefs.read Osx.rsrc && - String.length file > 2 && file.[0] = '.' && file.[1] = '_' - -(* Assumes that (fspath, path) is a directory, and returns the list of *) -(* children, except for '.' and '..'. *) -let allChildrenOf fspath path = - Util.convertUnixErrorsToTransient - "scanning directory" - (fun () -> - let rec loop children directory = - let newFile = try Unix.readdir directory with End_of_file -> "" in - if newFile = "" then children else - let newChildren = - if newFile = "." || newFile = ".." then - children - else - Name.fromString newFile :: children in - loop newChildren directory - in - let absolutePath = Fspath.concat fspath path in - let directory = - try - Some (Fspath.opendir absolutePath) - with Unix.Unix_error (Unix.ENOENT, _, _) -> - (* FIX (in Ocaml): under Windows, when a directory is empty - (not even "." and ".."), FindFirstFile fails with - ERROR_FILE_NOT_FOUND while ocaml expects the error - ERROR_NO_MORE_FILES *) - None - in - match directory with - Some directory -> - begin try - let result = loop [] directory in - Unix.closedir directory; - result - with Unix.Unix_error _ as e -> - begin try - Unix.closedir directory - with Unix.Unix_error _ -> () end; - raise e - end - | None -> - []) - -(* Assumes that (fspath, path) is a directory, and returns the list of *) -(* children, except for temporary files and AppleDouble files. *) -let rec childrenOf fspath path = - List.filter - (fun filename -> - let file = Name.toString filename in - if isAppleDoubleFile file then - false -(* does it belong to here ? *) -(* else if Util.endswith file backupFileSuffix then begin *) -(* let newPath = Path.child path filename in *) -(* removeBackupIfUnwanted fspath newPath; *) -(* false *) -(* end *) - else if - Util.endswith file tempFileSuffixFixed && - Util.startswith file tempFilePrefix - then begin - if Util.endswith file !tempFileSuffix then begin - let p = Path.child path filename in - let i = Fileinfo.get false fspath p in - let secondsinthirtydays = 2592000.0 in - if Props.time i.Fileinfo.desc +. secondsinthirtydays < Util.time() - then begin - debug (fun()-> Util.msg "deleting old temp file %s\n" - (Fspath.concatToString fspath p)); - delete fspath p - end else - debug (fun()-> Util.msg - "keeping temp file %s since it is less than 30 days old\n" - (Fspath.concatToString fspath p)); - end; - false - end else - true) - (allChildrenOf fspath path) - -(*****************************************************************************) -(* ACTIONS ON FILESYSTEM *) -(*****************************************************************************) - -(* Deletes a file or a directory, but checks before if there is something *) -and delete fspath path = - Util.convertUnixErrorsToTransient - "deleting" - (fun () -> - let absolutePath = Fspath.concatToString fspath path in - match (Fileinfo.get false fspath path).Fileinfo.typ with - `DIRECTORY -> - begin try - Unix.chmod absolutePath 0o700 - with Unix.Unix_error _ -> () end; - Safelist.iter - (fun child -> delete fspath (Path.child path child)) - (allChildrenOf fspath path); - (!xferDelete) (fspath, path); - Unix.rmdir absolutePath - | `FILE -> - if Util.osType <> `Unix then begin - try - Unix.chmod absolutePath 0o600; - with Unix.Unix_error _ -> () - end; - (!xferDelete) (fspath, path); - Unix.unlink absolutePath; - if Prefs.read Osx.rsrc then begin - let pathDouble = Osx.appleDoubleFile fspath path in - if Sys.file_exists pathDouble then - Unix.unlink pathDouble - end - | `SYMLINK -> - (* Note that chmod would not do the right thing on links *) - Unix.unlink absolutePath - | `ABSENT -> - ()) - -let rename fname sourcefspath sourcepath targetfspath targetpath = - let source = Fspath.concat sourcefspath sourcepath in - let source' = Fspath.toString source in - let target = Fspath.concat targetfspath targetpath in - let target' = Fspath.toString target in - if source' = target' then - raise (Util.Transient ("Rename ("^fname^"): identical source and target " ^ source')); - Util.convertUnixErrorsToTransient ("renaming " ^ source' ^ " to " ^ target') - (fun () -> - debug (fun() -> Util.msg "rename %s to %s\n" source' target'); - (!xferRename) (sourcefspath, sourcepath) (targetfspath, targetpath); - Unix.rename source' target'; - if Prefs.read Osx.rsrc then begin - let sourceDouble = Osx.appleDoubleFile sourcefspath sourcepath in - let targetDouble = Osx.appleDoubleFile targetfspath targetpath in - if Sys.file_exists sourceDouble then - Unix.rename sourceDouble targetDouble - else if Sys.file_exists targetDouble then - Unix.unlink targetDouble - end) - -let symlink = - if Util.isCygwin || (Util.osType != `Win32) then - fun fspath path l -> - Util.convertUnixErrorsToTransient - "writing symbolic link" - (fun () -> - let abspath = Fspath.concatToString fspath path in - Unix.symlink l abspath) - else - fun fspath path l -> - raise (Util.Transient "symlink not supported under Win32") - -(* Create a new directory, using the permissions from the given props *) -let createDir fspath path props = - Util.convertUnixErrorsToTransient - "creating directory" - (fun () -> - let absolutePath = Fspath.concatToString fspath path in - Unix.mkdir absolutePath (Props.perms props)) - -(*****************************************************************************) -(* FINGERPRINTS *) -(*****************************************************************************) - -type fullfingerprint = Fingerprint.t * Fingerprint.t - -let fingerprint fspath path info = - (Fingerprint.file fspath path, - Osx.ressFingerprint fspath path info.Fileinfo.osX) - -(* FIX: not completely safe under Unix *) -(* (with networked file system such as NFS) *) -let safeFingerprint fspath path info optDig = - let rec retryLoop count info optDig optRessDig = - if count = 0 then - raise (Util.Transient - (Printf.sprintf - "Failed to fingerprint file \"%s\": \ - the file keeps on changing" - (Fspath.concatToString fspath path))) - else - let dig = - match optDig with - None -> Fingerprint.file fspath path - | Some dig -> dig - in - let ressDig = - match optRessDig with - None -> Osx.ressFingerprint fspath path info.Fileinfo.osX - | Some ress -> ress - in - let (info', dataUnchanged, ressUnchanged) = - Fileinfo.unchanged fspath path info in - if dataUnchanged && ressUnchanged then - (info', (dig, ressDig)) - else - retryLoop (count - 1) info' - (if dataUnchanged then Some dig else None) - (if ressUnchanged then Some ressDig else None) - in - retryLoop 10 info (* Maximum retries: 10 times *) - (match optDig with None -> None | Some (d, _) -> Some d) - (match optDig with None -> None | Some (_, d) -> Some d) - -let fullfingerprint_to_string (fp,rfp) = - Printf.sprintf "(%s,%s)" (Fingerprint.toString fp) (Fingerprint.toString rfp) - -let reasonForFingerprintMismatch (digdata,digress) (digdata',digress') = - if digdata = digdata' then "resource fork" - else if digress = digress' then "file contents" - else "both file contents and resource fork" - -let fullfingerprint_dummy = (Fingerprint.dummy,Fingerprint.dummy) - -(*****************************************************************************) -(* UNISON DIRECTORY *) -(*****************************************************************************) - -(* Gives the fspath of the archive directory on the machine, depending on *) -(* which OS we use *) -let unisonDir = - try Fspath.canonize (Some (Unix.getenv "UNISON")) - with Not_found -> - let genericName = Util.fileInHomeDir (Printf.sprintf ".%s" Uutil.myName) in - if Osx.isMacOSX then - let osxName = Util.fileInHomeDir "Library/Application Support/Unison" in - if Sys.file_exists genericName then Fspath.canonize (Some genericName) - else Fspath.canonize (Some osxName) - else - Fspath.canonize (Some genericName) - -(* build a fspath representing an archive child path whose name is given *) -let fileInUnisonDir str = - let n = - try Name.fromString str - with Invalid_argument _ -> - raise (Util.Transient - ("Ill-formed name of file in UNISON directory: "^str)) - in - Fspath.child unisonDir n - -(* Make sure archive directory exists *) -let createUnisonDir() = - try ignore (Fspath.stat unisonDir) - with Unix.Unix_error(_) -> - Util.convertUnixErrorsToFatal - (Printf.sprintf "creating unison directory %s" - (Fspath.toString unisonDir)) - (fun () -> - ignore (Unix.mkdir (Fspath.toString unisonDir) 0o700)) - -(*****************************************************************************) -(* TEMPORARY FILES *) -(*****************************************************************************) - -(* Generates an unused fspath for a temporary file. *) -let genTempPath fresh fspath path prefix suffix = - let rec f i = - let s = - if i=0 then suffix - else Printf.sprintf "..%03d.%s" i suffix in - let tempPath = - Path.addPrefixToFinalName - (Path.addSuffixToFinalName path s) - prefix - in - if fresh && exists fspath tempPath then f (i + 1) else tempPath - in f 0 - -let tempPath ?(fresh=true) fspath path = - genTempPath fresh fspath path tempFilePrefix !tempFileSuffix - -(*****************************************************************************) -(* INTERRUPTED SYSTEM CALLS *) -(*****************************************************************************) -(* Needed because in lwt/lwt_unix.ml we set a signal handler for SIG_CHLD, - which means that slow system calls can be interrupted to handle - SIG_CHLD. We want to restart these system calls. It would be much - better to do this using SA_RESTART, however, ocaml's Unix module does - not support this, probably because it isn't nicely portable. *) -let accept fd = - let rec loop () = - try Unix.accept fd - with Unix.Unix_error(Unix.EINTR,_,_) -> loop() in - loop() - - Copied: branches/2.32/src/os.ml (from rev 320, trunk/src/os.ml) =================================================================== --- branches/2.32/src/os.ml (rev 0) +++ branches/2.32/src/os.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,364 @@ +(* Unison file synchronizer: src/os.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +(* This file attempts to isolate operating system specific details from the *) +(* rest of the program. *) + +let debug = Util.debug "os" + +let myCanonicalHostName = + try Unix.getenv "UNISONLOCALHOSTNAME" + with Not_found -> Unix.gethostname() + +let tempFilePrefix = ".unison." +let tempFileSuffixFixed = ".unison.tmp" +let tempFileSuffix = ref tempFileSuffixFixed +let includeInTempNames s = + (* BCP: Added this in Jan 08. If (as I believe) it never fails, then this tricky + stuff can be deleted. *) + assert (s<>""); + tempFileSuffix := + if s = "" then tempFileSuffixFixed + else "." ^ s ^ tempFileSuffixFixed + +let xferDelete = ref (fun (fp,p) -> ()) +let xferRename = ref (fun (fp,p) (ftp,tp) -> ()) + +let initializeXferFunctions del ren = + xferDelete := del; + xferRename := ren + + +(*****************************************************************************) +(* ESCAPING SHELL PARAMETERS *) +(*****************************************************************************) + +(* Using single quotes is simpler under Unix but they are not accepted + by the Windows shell. Double quotes without further quoting is + sufficient with Windows as filenames are not allowed to contain + double quotes. *) +let quotes s = + if Util.osType = `Win32 && not Util.isCygwin then + "\"" ^ s ^ "\"" + else + "'" ^ Util.replacesubstring s "'" "'\\''" ^ "'" + +(*****************************************************************************) +(* QUERYING THE FILESYSTEM *) +(*****************************************************************************) + +let exists fspath path = + (Fileinfo.get false fspath path).Fileinfo.typ <> `ABSENT + +let readLink fspath path = + Util.convertUnixErrorsToTransient + "reading symbolic link" + (fun () -> + let abspath = Fspath.concatToString fspath path in + Unix.readlink abspath) + +let rec isAppleDoubleFile file = + Prefs.read Osx.rsrc && + String.length file > 2 && file.[0] = '.' && file.[1] = '_' + +(* Assumes that (fspath, path) is a directory, and returns the list of *) +(* children, except for '.' and '..'. *) +let allChildrenOf fspath path = + Util.convertUnixErrorsToTransient + "scanning directory" + (fun () -> + let rec loop children directory = + let newFile = try Unix.readdir directory with End_of_file -> "" in + if newFile = "" then children else + let newChildren = + if newFile = "." || newFile = ".." then + children + else + Name.fromString newFile :: children in + loop newChildren directory + in + let absolutePath = Fspath.concat fspath path in + let directory = + try + Some (Fspath.opendir absolutePath) + with Unix.Unix_error (Unix.ENOENT, _, _) -> + (* FIX (in Ocaml): under Windows, when a directory is empty + (not even "." and ".."), FindFirstFile fails with + ERROR_FILE_NOT_FOUND while ocaml expects the error + ERROR_NO_MORE_FILES *) + None + in + match directory with + Some directory -> + begin try + let result = loop [] directory in + Unix.closedir directory; + result + with Unix.Unix_error _ as e -> + begin try + Unix.closedir directory + with Unix.Unix_error _ -> () end; + raise e + end + | None -> + []) + +(* Assumes that (fspath, path) is a directory, and returns the list of *) +(* children, except for temporary files and AppleDouble files. *) +let rec childrenOf fspath path = + List.filter + (fun filename -> + let file = Name.toString filename in + if isAppleDoubleFile file then + false +(* does it belong to here ? *) +(* else if Util.endswith file backupFileSuffix then begin *) +(* let newPath = Path.child path filename in *) +(* removeBackupIfUnwanted fspath newPath; *) +(* false *) +(* end *) + else if + Util.endswith file tempFileSuffixFixed && + Util.startswith file tempFilePrefix + then begin + if Util.endswith file !tempFileSuffix then begin + let p = Path.child path filename in + let i = Fileinfo.get false fspath p in + let secondsinthirtydays = 2592000.0 in + if Props.time i.Fileinfo.desc +. secondsinthirtydays < Util.time() + then begin + debug (fun()-> Util.msg "deleting old temp file %s\n" + (Fspath.concatToString fspath p)); + delete fspath p + end else + debug (fun()-> Util.msg + "keeping temp file %s since it is less than 30 days old\n" + (Fspath.concatToString fspath p)); + end; + false + end else + true) + (allChildrenOf fspath path) + +(*****************************************************************************) +(* ACTIONS ON FILESYSTEM *) +(*****************************************************************************) + +(* Deletes a file or a directory, but checks before if there is something *) +and delete fspath path = + Util.convertUnixErrorsToTransient + "deleting" + (fun () -> + let absolutePath = Fspath.concatToString fspath path in + match (Fileinfo.get false fspath path).Fileinfo.typ with + `DIRECTORY -> + begin try + Unix.chmod absolutePath 0o700 + with Unix.Unix_error _ -> () end; + Safelist.iter + (fun child -> delete fspath (Path.child path child)) + (allChildrenOf fspath path); + (!xferDelete) (fspath, path); + Unix.rmdir absolutePath + | `FILE -> + if Util.osType <> `Unix then begin + try + Unix.chmod absolutePath 0o600; + with Unix.Unix_error _ -> () + end; + (!xferDelete) (fspath, path); + Unix.unlink absolutePath; + if Prefs.read Osx.rsrc then begin + let pathDouble = Osx.appleDoubleFile fspath path in + if Sys.file_exists pathDouble then + Unix.unlink pathDouble + end + | `SYMLINK -> + (* Note that chmod would not do the right thing on links *) + Unix.unlink absolutePath + | `ABSENT -> + ()) + +let rename fname sourcefspath sourcepath targetfspath targetpath = + let source = Fspath.concat sourcefspath sourcepath in + let source' = Fspath.toString source in + let target = Fspath.concat targetfspath targetpath in + let target' = Fspath.toString target in + if source' = target' then + raise (Util.Transient ("Rename ("^fname^"): identical source and target " ^ source')); + Util.convertUnixErrorsToTransient ("renaming " ^ source' ^ " to " ^ target') + (fun () -> + debug (fun() -> Util.msg "rename %s to %s\n" source' target'); + (!xferRename) (sourcefspath, sourcepath) (targetfspath, targetpath); + Unix.rename source' target'; + if Prefs.read Osx.rsrc then begin + let sourceDouble = Osx.appleDoubleFile sourcefspath sourcepath in + let targetDouble = Osx.appleDoubleFile targetfspath targetpath in + if Sys.file_exists sourceDouble then + Unix.rename sourceDouble targetDouble + else if Sys.file_exists targetDouble then + Unix.unlink targetDouble + end) + +let symlink = + if Util.isCygwin || (Util.osType != `Win32) then + fun fspath path l -> + Util.convertUnixErrorsToTransient + "writing symbolic link" + (fun () -> + let abspath = Fspath.concatToString fspath path in + Unix.symlink l abspath) + else + fun fspath path l -> + raise (Util.Transient "symlink not supported under Win32") + +(* Create a new directory, using the permissions from the given props *) +let createDir fspath path props = + Util.convertUnixErrorsToTransient + "creating directory" + (fun () -> + let absolutePath = Fspath.concatToString fspath path in + Unix.mkdir absolutePath (Props.perms props)) + +(*****************************************************************************) +(* FINGERPRINTS *) +(*****************************************************************************) + +type fullfingerprint = Fingerprint.t * Fingerprint.t + +let fingerprint fspath path info = + (Fingerprint.file fspath path, + Osx.ressFingerprint fspath path info.Fileinfo.osX) + +(* FIX: not completely safe under Unix *) +(* (with networked file system such as NFS) *) +let safeFingerprint fspath path info optDig = + let rec retryLoop count info optDig optRessDig = + if count = 0 then + raise (Util.Transient + (Printf.sprintf + "Failed to fingerprint file \"%s\": \ + the file keeps on changing" + (Fspath.concatToString fspath path))) + else + let dig = + match optDig with + None -> Fingerprint.file fspath path + | Some dig -> dig + in + let ressDig = + match optRessDig with + None -> Osx.ressFingerprint fspath path info.Fileinfo.osX + | Some ress -> ress + in + let (info', dataUnchanged, ressUnchanged) = + Fileinfo.unchanged fspath path info in + if dataUnchanged && ressUnchanged then + (info', (dig, ressDig)) + else + retryLoop (count - 1) info' + (if dataUnchanged then Some dig else None) + (if ressUnchanged then Some ressDig else None) + in + retryLoop 10 info (* Maximum retries: 10 times *) + (match optDig with None -> None | Some (d, _) -> Some d) + (match optDig with None -> None | Some (_, d) -> Some d) + +let fullfingerprint_to_string (fp,rfp) = + Printf.sprintf "(%s,%s)" (Fingerprint.toString fp) (Fingerprint.toString rfp) + +let reasonForFingerprintMismatch (digdata,digress) (digdata',digress') = + if digdata = digdata' then "resource fork" + else if digress = digress' then "file contents" + else "both file contents and resource fork" + +let fullfingerprint_dummy = (Fingerprint.dummy,Fingerprint.dummy) + +(*****************************************************************************) +(* UNISON DIRECTORY *) +(*****************************************************************************) + +(* Gives the fspath of the archive directory on the machine, depending on *) +(* which OS we use *) +let unisonDir = + try Fspath.canonize (Some (Unix.getenv "UNISON")) + with Not_found -> + let genericName = Util.fileInHomeDir (Printf.sprintf ".%s" Uutil.myName) in + if Osx.isMacOSX then + let osxName = Util.fileInHomeDir "Library/Application Support/Unison" in + if Sys.file_exists genericName then Fspath.canonize (Some genericName) + else Fspath.canonize (Some osxName) + else + Fspath.canonize (Some genericName) + +(* build a fspath representing an archive child path whose name is given *) +let fileInUnisonDir str = + let n = + try Name.fromString str + with Invalid_argument _ -> + raise (Util.Transient + ("Ill-formed name of file in UNISON directory: "^str)) + in + Fspath.child unisonDir n + +(* Make sure archive directory exists *) +let createUnisonDir() = + try ignore (Fspath.stat unisonDir) + with Unix.Unix_error(_) -> + Util.convertUnixErrorsToFatal + (Printf.sprintf "creating unison directory %s" + (Fspath.toString unisonDir)) + (fun () -> + ignore (Unix.mkdir (Fspath.toString unisonDir) 0o700)) + +(*****************************************************************************) +(* TEMPORARY FILES *) +(*****************************************************************************) + +(* Generates an unused fspath for a temporary file. *) +let genTempPath fresh fspath path prefix suffix = + let rec f i = + let s = + if i=0 then suffix + else Printf.sprintf "..%03d.%s" i suffix in + let tempPath = + Path.addPrefixToFinalName + (Path.addSuffixToFinalName path s) + prefix + in + if fresh && exists fspath tempPath then f (i + 1) else tempPath + in f 0 + +let tempPath ?(fresh=true) fspath path = + genTempPath fresh fspath path tempFilePrefix !tempFileSuffix + +(*****************************************************************************) +(* INTERRUPTED SYSTEM CALLS *) +(*****************************************************************************) +(* Needed because in lwt/lwt_unix.ml we set a signal handler for SIG_CHLD, + which means that slow system calls can be interrupted to handle + SIG_CHLD. We want to restart these system calls. It would be much + better to do this using SA_RESTART, however, ocaml's Unix module does + not support this, probably because it isn't nicely portable. *) +let accept fd = + let rec loop () = + try Unix.accept fd + with Unix.Unix_error(Unix.EINTR,_,_) -> loop() in + loop() + + Deleted: branches/2.32/src/os.mli =================================================================== --- trunk/src/os.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/os.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,58 +0,0 @@ -(* Unison file synchronizer: src/os.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -val myCanonicalHostName : string - -val tempPath : ?fresh:bool -> Fspath.t -> Path.local -> Path.local -val tempFilePrefix : string -val includeInTempNames : string -> unit - -val exists : Fspath.t -> Path.local -> bool - -val createUnisonDir : unit -> unit -val fileInUnisonDir : string -> Fspath.t -val unisonDir : Fspath.t - -val childrenOf : Fspath.t -> Path.local -> Name.t list -val readLink : Fspath.t -> Path.local -> string -val symlink : Fspath.t -> Path.local -> string -> unit - -val rename : string -> Fspath.t -> Path.local -> Fspath.t -> Path.local -> unit -val createDir : Fspath.t -> Path.local -> Props.t -> unit -val delete : Fspath.t -> Path.local -> unit - -(* We define a new type of fingerprints here so that clients of - Os.fingerprint do not need to worry about whether files have resource - forks, or whatever, that need to be fingerprinted separately. They can - sensibly be compared for equality using =. Internally, a fullfingerprint - is a pair of the main file's fingerprint and the resource fork fingerprint, - if any. *) -type fullfingerprint -val fullfingerprint_to_string : fullfingerprint -> string -val reasonForFingerprintMismatch : fullfingerprint -> fullfingerprint -> string -val fullfingerprint_dummy : fullfingerprint - -(* Use this function if the file may change during fingerprinting *) -val safeFingerprint : - Fspath.t -> Path.local -> (* coordinates of file to fingerprint *) - Fileinfo.t -> (* old fileinfo *) - fullfingerprint option -> (* fingerprint corresponding to the old fileinfo *) - Fileinfo.t * fullfingerprint - (* current fileinfo, fingerprint and fork info *) -val fingerprint : - Fspath.t -> Path.local -> (* coordinates of file to fingerprint *) - Fileinfo.t -> (* old fileinfo *) - fullfingerprint (* current fingerprint *) - -(* Versions of system calls that will restart when interrupted by - signal handling *) -val accept : Unix.file_descr -> (Unix.file_descr * Unix.sockaddr) - -(* Called during program initialization to resolve a circular dependency - between this module and Xferhints *) -val initializeXferFunctions : - (Fspath.t * Path.local -> unit) -> - ((Fspath.t * Path.local) -> (Fspath.t * Path.local) -> unit) -> - unit - -val quotes : string -> string Copied: branches/2.32/src/os.mli (from rev 320, trunk/src/os.mli) =================================================================== --- branches/2.32/src/os.mli (rev 0) +++ branches/2.32/src/os.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,58 @@ +(* Unison file synchronizer: src/os.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +val myCanonicalHostName : string + +val tempPath : ?fresh:bool -> Fspath.t -> Path.local -> Path.local +val tempFilePrefix : string +val includeInTempNames : string -> unit + +val exists : Fspath.t -> Path.local -> bool + +val createUnisonDir : unit -> unit +val fileInUnisonDir : string -> Fspath.t +val unisonDir : Fspath.t + +val childrenOf : Fspath.t -> Path.local -> Name.t list +val readLink : Fspath.t -> Path.local -> string +val symlink : Fspath.t -> Path.local -> string -> unit + +val rename : string -> Fspath.t -> Path.local -> Fspath.t -> Path.local -> unit +val createDir : Fspath.t -> Path.local -> Props.t -> unit +val delete : Fspath.t -> Path.local -> unit + +(* We define a new type of fingerprints here so that clients of + Os.fingerprint do not need to worry about whether files have resource + forks, or whatever, that need to be fingerprinted separately. They can + sensibly be compared for equality using =. Internally, a fullfingerprint + is a pair of the main file's fingerprint and the resource fork fingerprint, + if any. *) +type fullfingerprint +val fullfingerprint_to_string : fullfingerprint -> string +val reasonForFingerprintMismatch : fullfingerprint -> fullfingerprint -> string +val fullfingerprint_dummy : fullfingerprint + +(* Use this function if the file may change during fingerprinting *) +val safeFingerprint : + Fspath.t -> Path.local -> (* coordinates of file to fingerprint *) + Fileinfo.t -> (* old fileinfo *) + fullfingerprint option -> (* fingerprint corresponding to the old fileinfo *) + Fileinfo.t * fullfingerprint + (* current fileinfo, fingerprint and fork info *) +val fingerprint : + Fspath.t -> Path.local -> (* coordinates of file to fingerprint *) + Fileinfo.t -> (* old fileinfo *) + fullfingerprint (* current fingerprint *) + +(* Versions of system calls that will restart when interrupted by + signal handling *) +val accept : Unix.file_descr -> (Unix.file_descr * Unix.sockaddr) + +(* Called during program initialization to resolve a circular dependency + between this module and Xferhints *) +val initializeXferFunctions : + (Fspath.t * Path.local -> unit) -> + ((Fspath.t * Path.local) -> (Fspath.t * Path.local) -> unit) -> + unit + +val quotes : string -> string Deleted: branches/2.32/src/osx.ml =================================================================== --- trunk/src/osx.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/osx.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,433 +0,0 @@ -(* Unison file synchronizer: src/osx.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -external isMacOSXPred : unit -> bool = "isMacOSX" - -let isMacOSX = isMacOSXPred () - -(****) - -let rsrcSync = - Prefs.createString "rsrc" "default" - "!synchronize resource forks (true/false/default)" - "When set to {\\tt true}, this flag causes Unison to synchronize \ - resource forks and HFS meta-data. On filesystems that do not \ - natively support resource forks, this data is stored in \ - Carbon-compatible .\\_ AppleDouble files. When the flag is set \ - to {\\tt false}, Unison will not synchronize these data. \ - Ordinarily, the flag is set to {\\tt default}, and these data are - automatically synchronized if either host is running OSX. In \ - rare circumstances it is useful to set the flag manually." - -(* Defining this variable as a preference ensures that it will be propagated - to the other host during initialization *) -let rsrc = - Prefs.createBool "rsrc-aux" false - "*synchronize resource forks and HFS meta-data" "" - -let init b = - Prefs.set rsrc - (Prefs.read rsrcSync = "yes" || - Prefs.read rsrcSync = "true" || - (Prefs.read rsrcSync = "default" && b)) - -(****) - -let appleDoubleFile fspath path = - let f = Fspath.concatToString fspath path in - let len = String.length f in - try - let i = 1 + String.rindex f '/' in - let res = String.create (len + 2) in - String.blit f 0 res 0 i; - res.[i] <- '.'; - res.[i + 1] <- '_'; - String.blit f i res (i + 2) (len - i); - res - with Not_found -> - assert false - -let doubleMagic = "\000\005\022\007" -let doubleVersion = "\000\002\000\000" -let doubleFiller = String.make 16 '\000' -let finfoLength = 32L -let emptyFinderInfo () = String.make 32 '\000' - -let getInt2 buf ofs = (Char.code buf.[ofs]) * 256 + Char.code buf.[ofs + 1] - -let getInt4 buf ofs = - let get i = Int64.of_int (Char.code buf.[ofs + i]) in - let combine x y = Int64.logor (Int64.shift_left x 8) y in - combine (combine (combine (get 0) (get 1)) (get 2)) (get 3) - -let getID buf ofs = - let get i = Char.code buf.[ofs + i] in - if get ofs <> 0 || get (ofs + 1) <> 0 || get (ofs + 2) <> 0 then - `UNKNOWN - else - match get (ofs + 3) with - 2 -> `RSRC - | 9 -> `FINFO - | _ -> `UNKNOWN - -let setInt4 v = - let s = String.create 4 in - let set i = - s.[i] <- - Char.chr (Int64.to_int (Int64.logand 255L - (Int64.shift_right v (24 - 8 * i)))) in - set 0; set 1; set 2; set 3; - s - -let fail path msg = - raise (Util.Transient - (Format.sprintf "Malformed AppleDouble file '%s' (%s)" path msg)) - -let readDouble path inch len = - let buf = String.create len in - begin try - really_input inch buf 0 len - with End_of_file -> - fail path "truncated" - end; - buf - -let readDoubleFromOffset path inch offset len = - LargeFile.seek_in inch offset; - readDouble path inch len - -let writeDoubleFromOffset path outch offset str = - LargeFile.seek_out outch offset; - output_string outch str - -let protect f g = - try - f () - with Sys_error _ | Unix.Unix_error _ | Util.Transient _ as e -> - begin try g () with Sys_error _ | Unix.Unix_error _ -> () end; - raise e - -let openDouble fspath path = - let path = appleDoubleFile fspath path in - let inch = try open_in_bin path with Sys_error _ -> raise Not_found in - protect (fun () -> - Util.convertUnixErrorsToTransient "opening AppleDouble file" (fun () -> - let header = readDouble path inch 26 in - if String.sub header 0 4 <> doubleMagic then - fail path "bad magic number"; - if String.sub header 4 4 <> doubleVersion then - fail path "bad version"; - if String.sub header 8 16 <> doubleFiller then - fail path "bad filler"; - let numEntries = getInt2 header 24 in - let entries = ref [] in - for i = 1 to numEntries do - let entry = readDouble path inch 12 in - let id = getID entry 0 in - let ofs = getInt4 entry 4 in - let len = getInt4 entry 8 in - entries := (id, (ofs, len)) :: !entries - done; - (path, inch, !entries))) - (fun () -> close_in_noerr inch) - -(****) - -type 'a ressInfo = - NoRess - | HfsRess of Uutil.Filesize.t - | AppleDoubleRess of int * float * float * Uutil.Filesize.t * 'a - -type ressStamp = unit ressInfo - -let ressStampToString r = - match r with - NoRess -> - "NoRess" - | HfsRess len -> - Format.sprintf "Hfs(%s)" (Uutil.Filesize.toString len) - | AppleDoubleRess (ino, mtime, ctime, len, _) -> - Format.sprintf "Hfs(%d,%f,%f,%s)" - ino mtime ctime (Uutil.Filesize.toString len) - -type info = - { ressInfo : (string * int64) ressInfo; - finfo : string } - -external getFileInfosInternal : - string -> bool -> string * int64 = "getFileInfos" -external setFileInfosInternal : string -> string -> unit = "setFileInfos" - -let defaultInfos typ = - match typ with - `FILE -> { ressInfo = NoRess; finfo = "F" } - | `DIRECTORY -> { ressInfo = NoRess; finfo = "D" } - | _ -> { ressInfo = NoRess; finfo = "" } - -let noTypeCreator = String.make 10 '\000' - -(* Remove trailing zeroes *) -let trim s = - let rec trim_rec s pos = - if s.[pos - 1] = '\000' then - trim_rec s (pos - 1) - else - String.sub s 0 pos - in - trim_rec s (String.length s) - -let extractInfo typ info = - let flags = String.sub info 8 2 in - let xflags = String.sub info 24 2 in - let typeCreator = String.sub info 0 8 in - (* Ignore hasBeenInited flag *) - flags.[0] <- Char.chr (Char.code flags.[0] land 0xfe); - (* If the extended flags should be ignored, clear them *) - let xflags = - if Char.code xflags.[0] land 0x80 <> 0 then "\000\000" else xflags - in - let info = - match typ with - `FILE -> "F" ^ typeCreator ^ flags ^ xflags - | `DIRECTORY -> "D" ^ flags ^ xflags - in - trim info - -let getFileInfos fspath path typ = - if not (Prefs.read rsrc) then defaultInfos typ else - match typ with - (`FILE | `DIRECTORY) as typ -> - Util.convertUnixErrorsToTransient "getting file informations" (fun () -> - try - let (fInfo, rsrcLength) = - getFileInfosInternal - (Fspath.concatToString fspath path) (typ = `FILE) in - { ressInfo = - if rsrcLength = 0L then NoRess - else HfsRess (Uutil.Filesize.ofInt64 rsrcLength); - finfo = extractInfo typ fInfo } - with Unix.Unix_error ((Unix.EOPNOTSUPP | Unix.ENOSYS), _, _) -> - (* Not a HFS volume. Look for an AppleDouble file *) - try - let (fspath, path) = Fspath.findWorkingDir fspath path in - let (doublePath, inch, entries) = openDouble fspath path in - let (rsrcOffset, rsrcLength) = - try Safelist.assoc `RSRC entries with Not_found -> - (0L, 0L) - in - let finfo = - protect (fun () -> - try - let (ofs, len) = Safelist.assoc `FINFO entries in - if len <> finfoLength then fail doublePath "bad finder info"; - let res = readDoubleFromOffset doublePath inch ofs 32 in - close_in inch; - res - with Not_found -> - "") - (fun () -> close_in_noerr inch) - in - let stats = Unix.LargeFile.stat doublePath in - { ressInfo = - if rsrcLength = 0L then NoRess else - AppleDoubleRess - (begin match Util.osType with - `Win32 -> 0 - | `Unix -> (* The inode number is truncated so that - it fits in a 31 bit ocaml integer *) - stats.Unix.LargeFile.st_ino land 0x3FFFFFFF - end, - stats.Unix.LargeFile.st_mtime, - begin match Util.osType with - `Win32 -> (* Was "stats.Unix.LargeFile.st_ctime", but - this was bogus: Windows ctimes are - not reliable. [BCP, Apr 07] *) - 0. - | `Unix -> 0. - end, - Uutil.Filesize.ofInt64 rsrcLength, - (doublePath, rsrcOffset)); - finfo = extractInfo typ finfo } - with Not_found -> - defaultInfos typ) - | _ -> - defaultInfos typ - -let zeroes = String.make 13 '\000' - -let insertInfo fullInfo info = - let info = info ^ zeroes in - let isFile = info.[0] = 'F' in - let offset = if isFile then 9 else 1 in - (* Type and creator *) - if isFile then String.blit info 1 fullInfo 0 8; - (* Finder flags *) - String.blit info offset fullInfo 8 2; - (* Extended finder flags *) - String.blit info (offset + 2) fullInfo 24 2; - fullInfo - -let setFileInfos fspath path finfo = - assert (finfo <> ""); - Util.convertUnixErrorsToTransient "setting file informations" (fun () -> - try - let (fullFinfo, _) = - getFileInfosInternal (Fspath.concatToString fspath path) false in - setFileInfosInternal (Fspath.concatToString fspath path) - (insertInfo fullFinfo finfo) - with Unix.Unix_error ((Unix.EOPNOTSUPP | Unix.ENOSYS), _, _) -> - (* Not an HFS volume. Look for an AppleDouble file *) - let (fspath, path) = Fspath.findWorkingDir fspath path in - begin try - let (doublePath, inch, entries) = openDouble fspath path in - begin try - let (ofs, len) = Safelist.assoc `FINFO entries in - if len <> finfoLength then fail doublePath "bad finder info"; - let fullFinfo = - protect - (fun () -> - let res = readDoubleFromOffset doublePath inch ofs 32 in - close_in inch; - res) - (fun () -> close_in_noerr inch) - in - let outch = - open_out_gen [Open_wronly; Open_binary] 0o600 doublePath in - protect - (fun () -> - writeDoubleFromOffset doublePath outch ofs - (insertInfo fullFinfo finfo); - close_out outch) - (fun () -> - close_out_noerr outch); - with Not_found -> - close_in_noerr inch; - raise (Util.Transient - (Format.sprintf - "Unable to set the file type and creator: \n\ - The AppleDouble file '%s' has no fileinfo entry." - doublePath)) - end - with Not_found -> - (* No AppleDouble file, create one if needed. *) - if finfo <> "F" && finfo <> "D" then begin - let path = appleDoubleFile fspath path in - let outch = - open_out_gen - [Open_wronly; Open_creat; Open_excl; Open_binary] 0o600 path - in - protect (fun () -> - output_string outch doubleMagic; - output_string outch doubleVersion; - output_string outch doubleFiller; - output_string outch "\000\001"; (* One entry *) - output_string outch "\000\000\000\009"; (* Finder info *) - output_string outch "\000\000\000\038"; (* offset *) - output_string outch "\000\000\000\032"; (* length *) - output_string outch (insertInfo (emptyFinderInfo ()) finfo); - close_out outch) - (fun () -> close_out_noerr outch) - end - end) - -let ressUnchanged info info' t0 dataUnchanged = - match info, info' with - NoRess, NoRess -> - true - | HfsRess len, HfsRess len' -> - dataUnchanged && len = len' - | AppleDoubleRess (ino, mt, ct, _, _), - AppleDoubleRess (ino', mt', ct', _, _) -> - ino = ino' && mt = mt' && ct = ct' && - if Some mt' <> t0 then - true - else begin - begin try - Unix.sleep 1 - with Unix.Unix_error _ -> () end; - false - end - | _ -> - false - -(****) - -let name1 = Name.fromString "..namedfork" -let name2 = Name.fromString "rsrc" -let ressPath p = Path.child (Path.child p name1) name2 - -let stamp info = - match info.ressInfo with - NoRess -> - NoRess - | (HfsRess len) as s -> - s - | AppleDoubleRess (inode, mtime, ctime, len, _) -> - AppleDoubleRess (inode, mtime, ctime, len, ()) - -let ressFingerprint fspath path info = - match info.ressInfo with - NoRess -> - Fingerprint.dummy - | HfsRess _ -> - Fingerprint.file fspath (ressPath path) - | AppleDoubleRess (_, _, _, len, (path, offset)) -> - Fingerprint.subfile path offset len - -let ressLength ress = - match ress with - NoRess -> Uutil.Filesize.zero - | HfsRess len -> len - | AppleDoubleRess (_, _, _, len, _) -> len - -let ressDummy = NoRess - -(****) - -let openRessIn fspath path = - Util.convertUnixErrorsToTransient "reading resource fork" (fun () -> - try - Unix.in_channel_of_descr - (Unix.openfile - (Fspath.concatToString fspath (ressPath path)) - [Unix.O_RDONLY] 0o444) - with Unix.Unix_error ((Unix.ENOENT | Unix.ENOTDIR), _, _) -> - let (doublePath, inch, entries) = openDouble fspath path in - try - let (rsrcOffset, rsrcLength) = Safelist.assoc `RSRC entries in - protect (fun () -> LargeFile.seek_in inch rsrcOffset) - (fun () -> close_in_noerr inch); - inch - with Not_found -> - close_in_noerr inch; - raise (Util.Transient "No resource fork found")) - -let openRessOut fspath path length = - Util.convertUnixErrorsToTransient "writing resource fork" (fun () -> - try - Unix.out_channel_of_descr - (Unix.openfile - (Fspath.concatToString fspath (ressPath path)) - [Unix.O_WRONLY;Unix.O_TRUNC] 0o600) - with Unix.Unix_error ((Unix.ENOENT | Unix.ENOTDIR), _, _) -> - let path = appleDoubleFile fspath path in - let outch = - open_out_gen - [Open_wronly; Open_creat; Open_excl; Open_binary] 0o600 path - in - protect (fun () -> - output_string outch doubleMagic; - output_string outch doubleVersion; - output_string outch doubleFiller; - output_string outch "\000\002"; (* Two entries *) - output_string outch "\000\000\000\009"; (* Finder info *) - output_string outch "\000\000\000\050"; (* offset *) - output_string outch "\000\000\000\032"; (* length *) - output_string outch "\000\000\000\002"; (* Resource fork *) - output_string outch "\000\000\000\082"; (* offset *) - output_string outch (setInt4 (Uutil.Filesize.toInt64 length)); - (* length *) - output_string outch (emptyFinderInfo ()); - flush outch) - (fun () -> close_out_noerr outch); - outch) Copied: branches/2.32/src/osx.ml (from rev 320, trunk/src/osx.ml) =================================================================== --- branches/2.32/src/osx.ml (rev 0) +++ branches/2.32/src/osx.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,448 @@ +(* Unison file synchronizer: src/osx.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +external isMacOSXPred : unit -> bool = "isMacOSX" + +let isMacOSX = isMacOSXPred () + +(****) + +let rsrcSync = + Prefs.createString "rsrc" "default" + "!synchronize resource forks (true/false/default)" + "When set to {\\tt true}, this flag causes Unison to synchronize \ + resource forks and HFS meta-data. On filesystems that do not \ + natively support resource forks, this data is stored in \ + Carbon-compatible .\\_ AppleDouble files. When the flag is set \ + to {\\tt false}, Unison will not synchronize these data. \ + Ordinarily, the flag is set to {\\tt default}, and these data are + automatically synchronized if either host is running OSX. In \ + rare circumstances it is useful to set the flag manually." + +(* Defining this variable as a preference ensures that it will be propagated + to the other host during initialization *) +let rsrc = + Prefs.createBool "rsrc-aux" false + "*synchronize resource forks and HFS meta-data" "" + +let init b = + Prefs.set rsrc + (Prefs.read rsrcSync = "yes" || + Prefs.read rsrcSync = "true" || + (Prefs.read rsrcSync = "default" && b)) + +(****) + +let appleDoubleFile fspath path = + let f = Fspath.concatToString fspath path in + let len = String.length f in + try + let i = 1 + String.rindex f '/' in + let res = String.create (len + 2) in + String.blit f 0 res 0 i; + res.[i] <- '.'; + res.[i + 1] <- '_'; + String.blit f i res (i + 2) (len - i); + res + with Not_found -> + assert false + +let doubleMagic = "\000\005\022\007" +let doubleVersion = "\000\002\000\000" +let doubleFiller = String.make 16 '\000' +let finfoLength = 32L +let emptyFinderInfo () = String.make 32 '\000' + +let getInt2 buf ofs = (Char.code buf.[ofs]) * 256 + Char.code buf.[ofs + 1] + +let getInt4 buf ofs = + let get i = Int64.of_int (Char.code buf.[ofs + i]) in + let combine x y = Int64.logor (Int64.shift_left x 8) y in + combine (combine (combine (get 0) (get 1)) (get 2)) (get 3) + +let getID buf ofs = + let get i = Char.code buf.[ofs + i] in + if get ofs <> 0 || get (ofs + 1) <> 0 || get (ofs + 2) <> 0 then + `UNKNOWN + else + match get (ofs + 3) with + 2 -> `RSRC + | 9 -> `FINFO + | _ -> `UNKNOWN + +let setInt4 v = + let s = String.create 4 in + let set i = + s.[i] <- + Char.chr (Int64.to_int (Int64.logand 255L + (Int64.shift_right v (24 - 8 * i)))) in + set 0; set 1; set 2; set 3; + s + +let fail path msg = + raise (Util.Transient + (Format.sprintf "Malformed AppleDouble file '%s' (%s)" path msg)) + +let readDouble path inch len = + let buf = String.create len in + begin try + really_input inch buf 0 len + with End_of_file -> + fail path "truncated" + end; + buf + +let readDoubleFromOffset path inch offset len = + LargeFile.seek_in inch offset; + readDouble path inch len + +let writeDoubleFromOffset path outch offset str = + LargeFile.seek_out outch offset; + output_string outch str + +let protect f g = + try + f () + with Sys_error _ | Unix.Unix_error _ | Util.Transient _ as e -> + begin try g () with Sys_error _ | Unix.Unix_error _ -> () end; + raise e + +let openDouble fspath path = + let path = appleDoubleFile fspath path in + let inch = try open_in_bin path with Sys_error _ -> raise Not_found in + protect (fun () -> + Util.convertUnixErrorsToTransient "opening AppleDouble file" (fun () -> + let header = readDouble path inch 26 in + if String.sub header 0 4 <> doubleMagic then + fail path "bad magic number"; + if String.sub header 4 4 <> doubleVersion then + fail path "bad version"; + if String.sub header 8 16 <> doubleFiller then + fail path "bad filler"; + let numEntries = getInt2 header 24 in + let entries = ref [] in + for i = 1 to numEntries do + let entry = readDouble path inch 12 in + let id = getID entry 0 in + let ofs = getInt4 entry 4 in + let len = getInt4 entry 8 in + entries := (id, (ofs, len)) :: !entries + done; + (path, inch, !entries))) + (fun () -> close_in_noerr inch) + +(****) + +type 'a ressInfo = + NoRess + | HfsRess of Uutil.Filesize.t + | AppleDoubleRess of int * float * float * Uutil.Filesize.t * 'a + +type ressStamp = unit ressInfo + +let ressStampToString r = + match r with + NoRess -> + "NoRess" + | HfsRess len -> + Format.sprintf "Hfs(%s)" (Uutil.Filesize.toString len) + | AppleDoubleRess (ino, mtime, ctime, len, _) -> + Format.sprintf "Hfs(%d,%f,%f,%s)" + ino mtime ctime (Uutil.Filesize.toString len) + +type info = + { ressInfo : (string * int64) ressInfo; + finfo : string } + +external getFileInfosInternal : + string -> bool -> string * int64 = "getFileInfos" +external setFileInfosInternal : string -> string -> unit = "setFileInfos" + +let defaultInfos typ = + match typ with + `FILE -> { ressInfo = NoRess; finfo = "F" } + | `DIRECTORY -> { ressInfo = NoRess; finfo = "D" } + | _ -> { ressInfo = NoRess; finfo = "" } + +let noTypeCreator = String.make 10 '\000' + +(* Remove trailing zeroes *) +let trim s = + let rec trim_rec s pos = + if s.[pos - 1] = '\000' then + trim_rec s (pos - 1) + else + String.sub s 0 pos + in + trim_rec s (String.length s) + +let extractInfo typ info = + let flags = String.sub info 8 2 in + let xflags = String.sub info 24 2 in + let typeCreator = String.sub info 0 8 in + (* Ignore hasBeenInited flag *) + flags.[0] <- Char.chr (Char.code flags.[0] land 0xfe); + (* If the extended flags should be ignored, clear them *) + let xflags = + if Char.code xflags.[0] land 0x80 <> 0 then "\000\000" else xflags + in + let info = + match typ with + `FILE -> "F" ^ typeCreator ^ flags ^ xflags + | `DIRECTORY -> "D" ^ flags ^ xflags + in + trim info + +let getFileInfos fspath path typ = + if not (Prefs.read rsrc) then defaultInfos typ else + match typ with + (`FILE | `DIRECTORY) as typ -> + Util.convertUnixErrorsToTransient "getting file informations" (fun () -> + try + let (fInfo, rsrcLength) = + getFileInfosInternal + (Fspath.concatToString fspath path) (typ = `FILE) in + { ressInfo = + if rsrcLength = 0L then NoRess + else HfsRess (Uutil.Filesize.ofInt64 rsrcLength); + finfo = extractInfo typ fInfo } + with Unix.Unix_error ((Unix.EOPNOTSUPP | Unix.ENOSYS), _, _) -> + (* Not a HFS volume. Look for an AppleDouble file *) + try + let (fspath, path) = Fspath.findWorkingDir fspath path in + let (doublePath, inch, entries) = openDouble fspath path in + let (rsrcOffset, rsrcLength) = + try Safelist.assoc `RSRC entries with Not_found -> + (0L, 0L) + in + let finfo = + protect (fun () -> + try + let (ofs, len) = Safelist.assoc `FINFO entries in + if len <> finfoLength then fail doublePath "bad finder info"; + let res = readDoubleFromOffset doublePath inch ofs 32 in + close_in inch; + res + with Not_found -> + "") + (fun () -> close_in_noerr inch) + in + let stats = Unix.LargeFile.stat doublePath in + { ressInfo = + if rsrcLength = 0L then NoRess else + AppleDoubleRess + (begin match Util.osType with + `Win32 -> 0 + | `Unix -> (* The inode number is truncated so that + it fits in a 31 bit ocaml integer *) + stats.Unix.LargeFile.st_ino land 0x3FFFFFFF + end, + stats.Unix.LargeFile.st_mtime, + begin match Util.osType with + `Win32 -> (* Was "stats.Unix.LargeFile.st_ctime", but + this was bogus: Windows ctimes are + not reliable. [BCP, Apr 07] *) + 0. + | `Unix -> 0. + end, + Uutil.Filesize.ofInt64 rsrcLength, + (doublePath, rsrcOffset)); + finfo = extractInfo typ finfo } + with Not_found -> + defaultInfos typ) + | _ -> + defaultInfos typ + +let zeroes = String.make 13 '\000' + +let insertInfo fullInfo info = + let info = info ^ zeroes in + let isFile = info.[0] = 'F' in + let offset = if isFile then 9 else 1 in + (* Type and creator *) + if isFile then String.blit info 1 fullInfo 0 8; + (* Finder flags *) + String.blit info offset fullInfo 8 2; + (* Extended finder flags *) + String.blit info (offset + 2) fullInfo 24 2; + fullInfo + +let setFileInfos fspath path finfo = + assert (finfo <> ""); + Util.convertUnixErrorsToTransient "setting file informations" (fun () -> + try + let (fullFinfo, _) = + getFileInfosInternal (Fspath.concatToString fspath path) false in + setFileInfosInternal (Fspath.concatToString fspath path) + (insertInfo fullFinfo finfo) + with Unix.Unix_error ((Unix.EOPNOTSUPP | Unix.ENOSYS), _, _) -> + (* Not an HFS volume. Look for an AppleDouble file *) + let (fspath, path) = Fspath.findWorkingDir fspath path in + begin try + let (doublePath, inch, entries) = openDouble fspath path in + begin try + let (ofs, len) = Safelist.assoc `FINFO entries in + if len <> finfoLength then fail doublePath "bad finder info"; + let fullFinfo = + protect + (fun () -> + let res = readDoubleFromOffset doublePath inch ofs 32 in + close_in inch; + res) + (fun () -> close_in_noerr inch) + in + let outch = + open_out_gen [Open_wronly; Open_binary] 0o600 doublePath in + protect + (fun () -> + writeDoubleFromOffset doublePath outch ofs + (insertInfo fullFinfo finfo); + close_out outch) + (fun () -> + close_out_noerr outch); + with Not_found -> + close_in_noerr inch; + raise (Util.Transient + (Format.sprintf + "Unable to set the file type and creator: \n\ + The AppleDouble file '%s' has no fileinfo entry." + doublePath)) + end + with Not_found -> + (* No AppleDouble file, create one if needed. *) + if finfo <> "F" && finfo <> "D" then begin + let path = appleDoubleFile fspath path in + let outch = + open_out_gen + [Open_wronly; Open_creat; Open_excl; Open_binary] 0o600 path + in + protect (fun () -> + output_string outch doubleMagic; + output_string outch doubleVersion; + output_string outch doubleFiller; + output_string outch "\000\001"; (* One entry *) + output_string outch "\000\000\000\009"; (* Finder info *) + output_string outch "\000\000\000\038"; (* offset *) + output_string outch "\000\000\000\032"; (* length *) + output_string outch (insertInfo (emptyFinderInfo ()) finfo); + close_out outch) + (fun () -> close_out_noerr outch) + end + end) + +let ressUnchanged info info' t0 dataUnchanged = + match info, info' with + NoRess, NoRess -> + true + | HfsRess len, HfsRess len' -> + dataUnchanged && len = len' + | AppleDoubleRess (ino, mt, ct, _, _), + AppleDoubleRess (ino', mt', ct', _, _) -> + ino = ino' && mt = mt' && ct = ct' && + if Some mt' <> t0 then + true + else begin + begin try + Unix.sleep 1 + with Unix.Unix_error _ -> () end; + false + end + | _ -> + false + +(****) + +let name1 = Name.fromString "..namedfork" +let name2 = Name.fromString "rsrc" +let ressPath p = Path.child (Path.child p name1) name2 + +let stamp info = + match info.ressInfo with + NoRess -> + NoRess + | (HfsRess len) as s -> + s + | AppleDoubleRess (inode, mtime, ctime, len, _) -> + AppleDoubleRess (inode, mtime, ctime, len, ()) + +let ressFingerprint fspath path info = + match info.ressInfo with + NoRess -> + Fingerprint.dummy + | HfsRess _ -> + Fingerprint.file fspath (ressPath path) + | AppleDoubleRess (_, _, _, len, (path, offset)) -> + Fingerprint.subfile path offset len + +let ressLength ress = + match ress with + NoRess -> Uutil.Filesize.zero + | HfsRess len -> len + | AppleDoubleRess (_, _, _, len, _) -> len + +let ressDummy = NoRess + +(****) + +let openRessIn fspath path = + Util.convertUnixErrorsToTransient "reading resource fork" (fun () -> + try + Unix.in_channel_of_descr + (Unix.openfile + (Fspath.concatToString fspath (ressPath path)) + [Unix.O_RDONLY] 0o444) + with Unix.Unix_error ((Unix.ENOENT | Unix.ENOTDIR), _, _) -> + let (doublePath, inch, entries) = openDouble fspath path in + try + let (rsrcOffset, rsrcLength) = Safelist.assoc `RSRC entries in + protect (fun () -> LargeFile.seek_in inch rsrcOffset) + (fun () -> close_in_noerr inch); + inch + with Not_found -> + close_in_noerr inch; + raise (Util.Transient "No resource fork found")) + +let openRessOut fspath path length = + Util.convertUnixErrorsToTransient "writing resource fork" (fun () -> + try + Unix.out_channel_of_descr + (Unix.openfile + (Fspath.concatToString fspath (ressPath path)) + [Unix.O_WRONLY;Unix.O_TRUNC] 0o600) + with Unix.Unix_error ((Unix.ENOENT | Unix.ENOTDIR), _, _) -> + let path = appleDoubleFile fspath path in + let outch = + open_out_gen + [Open_wronly; Open_creat; Open_excl; Open_binary] 0o600 path + in + protect (fun () -> + output_string outch doubleMagic; + output_string outch doubleVersion; + output_string outch doubleFiller; + output_string outch "\000\002"; (* Two entries *) + output_string outch "\000\000\000\009"; (* Finder info *) + output_string outch "\000\000\000\050"; (* offset *) + output_string outch "\000\000\000\032"; (* length *) + output_string outch "\000\000\000\002"; (* Resource fork *) + output_string outch "\000\000\000\082"; (* offset *) + output_string outch (setInt4 (Uutil.Filesize.toInt64 length)); + (* length *) + output_string outch (emptyFinderInfo ()); + flush outch) + (fun () -> close_out_noerr outch); + outch) Deleted: branches/2.32/src/osx.mli =================================================================== --- trunk/src/osx.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/osx.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,32 +0,0 @@ -(* Unison file synchronizer: src/osx.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -val init : bool -> unit -val isMacOSX : bool - -val rsrc : bool Prefs.t - -type 'a ressInfo -type ressStamp = unit ressInfo -type info = - { ressInfo : (string * int64) ressInfo; - finfo : string } - -val getFileInfos : Fspath.t -> Path.local -> [> `DIRECTORY | `FILE ] -> info -val setFileInfos : Fspath.t -> Path.local -> string -> unit - -val ressUnchanged : - 'a ressInfo -> 'b ressInfo -> float option -> bool -> bool - -val ressFingerprint : Fspath.t -> Path.local -> info -> Fingerprint.t -val ressLength : 'a ressInfo -> Uutil.Filesize.t - -val ressDummy : ressStamp -val ressStampToString : ressStamp -> string - -val stamp : info -> ressStamp - -val appleDoubleFile : Fspath.t -> Path.local -> string - -val openRessIn : Fspath.t -> Path.local -> in_channel -val openRessOut : Fspath.t -> Path.local -> Uutil.Filesize.t -> out_channel Copied: branches/2.32/src/osx.mli (from rev 320, trunk/src/osx.mli) =================================================================== --- branches/2.32/src/osx.mli (rev 0) +++ branches/2.32/src/osx.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,32 @@ +(* Unison file synchronizer: src/osx.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +val init : bool -> unit +val isMacOSX : bool + +val rsrc : bool Prefs.t + +type 'a ressInfo +type ressStamp = unit ressInfo +type info = + { ressInfo : (string * int64) ressInfo; + finfo : string } + +val getFileInfos : Fspath.t -> Path.local -> [> `DIRECTORY | `FILE ] -> info +val setFileInfos : Fspath.t -> Path.local -> string -> unit + +val ressUnchanged : + 'a ressInfo -> 'b ressInfo -> float option -> bool -> bool + +val ressFingerprint : Fspath.t -> Path.local -> info -> Fingerprint.t +val ressLength : 'a ressInfo -> Uutil.Filesize.t + +val ressDummy : ressStamp +val ressStampToString : ressStamp -> string + +val stamp : info -> ressStamp + +val appleDoubleFile : Fspath.t -> Path.local -> string + +val openRessIn : Fspath.t -> Path.local -> in_channel +val openRessOut : Fspath.t -> Path.local -> Uutil.Filesize.t -> out_channel Deleted: branches/2.32/src/path.ml =================================================================== --- trunk/src/path.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/path.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,196 +0,0 @@ -(* Unison file synchronizer: src/path.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* Defines an abstract type of relative pathnames *) - -type 'a path = string -type t = string -type local = string - -let pathSeparatorChar = '/' -let pathSeparatorString = "/" - -let concat p p' = - let l = String.length p in - if l = 0 then p' else - let l' = String.length p' in - if l' = 0 then p else - let p'' = String.create (l + l' + 1) in - String.blit p 0 p'' 0 l; - p''.[l] <- pathSeparatorChar; - String.blit p' 0 p'' (l + 1) l'; - p'' - -let empty = "" - -let isEmpty p = String.length p = 0 - -let length p = - let l = ref 0 in - for i = 0 to String.length p - 1 do - if p.[i] = pathSeparatorChar then incr l - done; - !l - -(* Add a name to the end of a path *) -let rcons n path = concat (Name.toString n) path - -let toStringList p = Str.split (Str.regexp pathSeparatorString) p - -(* Give a left-to-right list of names in the path *) -let toNames p = Safelist.map Name.fromString (toStringList p) - -let child path name = concat path (Name.toString name) - -let parent path = - try - let i = String.rindex path pathSeparatorChar in - String.sub path 0 i - with Not_found -> - empty - -let finalName path = - try - let i = String.rindex path pathSeparatorChar + 1 in - Some (Name.fromString (String.sub path i (String.length path - i))) - with Not_found -> - if isEmpty path then - None - else - Some (Name.fromString path) - -(* pathDeconstruct : path -> (name * path) option *) -let deconstruct path = - try - let i = String.index path pathSeparatorChar in - Some (Name.fromString (String.sub path 0 i), - String.sub path (i + 1) (String.length path - i - 1)) - with Not_found -> - if isEmpty path then - None - else - Some (Name.fromString path, empty) - -let deconstructRev path = - try - let i = String.rindex path pathSeparatorChar in - Some (Name.fromString - (String.sub path (i + 1) (String.length path - i - 1)), - String.sub path 0 i) - with Not_found -> - if path = "" then - None - else - Some (Name.fromString path, empty) - -let winAbspathRx = Rx.rx "([a-zA-Z]:)?(/|\\\\).*" -let unixAbspathRx = Rx.rx "/.*" -let is_absolute s = - if Util.osType=`Win32 then Rx.match_string winAbspathRx s - else Rx.match_string unixAbspathRx s - -(* Function string2path: string -> path - - THIS IS THE CRITICAL FUNCTION. - - Problem: What to do on argument "" ? - What we do: we raise Invalid_argument. - - Problem: double slash within the argument, e.g., "foo//bar". - What we do: we raise Invalid_argument. - - Problem: What if string2path is applied to an absolute path? We - want to disallow this, but, relative is relative. E.g., on Unix it - makes sense to have a directory with subdirectory "c:". Then, it - makes sense to synchronize on the path "c:". But this will go - badly if the Unix system synchronizes with a Windows system. - What we do: we check whether a path is relative using local - conventions, and raise Invalid_argument if not. If we synchronize - with a system with other conventions, then problems must be caught - elsewhere. E.g., the system should refuse to create a directory - "c:" on a Windows machine. - - Problem: spaces in the argument, e.g., " ". Still not sure what to - do here. Is it possible to create a file with this name in Unix or - Windows? - - Problem: trailing slashes, e.g., "foo/bar/". Shells with - command-line completion may produce these routinely. - What we do: we remove them. Moreover, we remove as many as - necessary, e.g., "foo/bar///" becomes "foo/bar". This may be - counter to conventions of some shells/os's, where "foo/bar///" - might mean "/". - - Examples: - loop "hello/there" -> ["hello"; "there"] - loop "/hello/there" -> [""; "hello"; "there"] - loop "" -> [""] - loop "/" -> [""; ""] - loop "//" -> [""; ""; ""] - loop "c:/" ->["c:"; ""] - loop "c:/foo" -> ["c:"; "foo"] -*) -let fromString str = - let str = if Util.osType = `Win32 then Fileutil.backslashes2forwardslashes str else str in - if is_absolute str then - raise (Util.Transient - (Printf.sprintf "The path '%s' is not a relative path" str)); - let str = Fileutil.removeTrailingSlashes str in - if str = "" then empty else - let rec loop p str = - try - let pos = String.index str pathSeparatorChar in - let name1 = String.sub str 0 pos in - let str_res = - String.sub str (pos + 1) (String.length str - pos - 1) in - if pos = 0 then begin - loop p str_res - end else - loop (child p (Name.fromString name1)) str_res - with - Not_found -> child p (Name.fromString str) - | Invalid_argument _ -> - raise(Invalid_argument "Path.fromString") in - loop empty str - -let toString path = path - -let compare p1 p2 = - if Case.insensitive () then Util.nocase_cmp p1 p2 else compare p1 p2 - -let toDebugString path = String.concat " / " (toStringList path) - -let addSuffixToFinalName path suffix = path ^ suffix - -let addPrefixToFinalName path prefix = - try - let i = String.rindex path pathSeparatorChar + 1 in - let l = String.length path in - let l' = String.length prefix in - let p = String.create (l + l') in - String.blit path 0 p 0 i; - String.blit prefix 0 p i l'; - String.blit path i p (i + l') (l - i); - p - with Not_found -> - assert (not (isEmpty path)); - prefix ^ path - -let hash p = Hashtbl.hash p - -(* Pref controlling whether symlinks are followed. *) -let follow = Pred.create "follow" - ("Including the preference \\texttt{-follow \\ARG{pathspec}} causes Unison to \ - treat symbolic links matching \\ARG{pathspec} as `invisible' and \ - behave as if the object pointed to by the link had appeared literally \ - at this position in the replica. See \ - \\sectionref{symlinks}{Symbolic Links} for more details. \ - The syntax of \\ARG{pathspec>} is \ - described in \\sectionref{pathspec}{Path Specification}.") - -let followLink path = - (Util.osType = `Unix || Util.isCygwin) - && Pred.test follow (toString path) - -let magic p = p -let magic' p = p Copied: branches/2.32/src/path.ml (from rev 320, trunk/src/path.ml) =================================================================== --- branches/2.32/src/path.ml (rev 0) +++ branches/2.32/src/path.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,211 @@ +(* Unison file synchronizer: src/path.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +(* Defines an abstract type of relative pathnames *) + +type 'a path = string +type t = string +type local = string + +let pathSeparatorChar = '/' +let pathSeparatorString = "/" + +let concat p p' = + let l = String.length p in + if l = 0 then p' else + let l' = String.length p' in + if l' = 0 then p else + let p'' = String.create (l + l' + 1) in + String.blit p 0 p'' 0 l; + p''.[l] <- pathSeparatorChar; + String.blit p' 0 p'' (l + 1) l'; + p'' + +let empty = "" + +let isEmpty p = String.length p = 0 + +let length p = + let l = ref 0 in + for i = 0 to String.length p - 1 do + if p.[i] = pathSeparatorChar then incr l + done; + !l + +(* Add a name to the end of a path *) +let rcons n path = concat (Name.toString n) path + +let toStringList p = Str.split (Str.regexp pathSeparatorString) p + +(* Give a left-to-right list of names in the path *) +let toNames p = Safelist.map Name.fromString (toStringList p) + +let child path name = concat path (Name.toString name) + +let parent path = + try + let i = String.rindex path pathSeparatorChar in + String.sub path 0 i + with Not_found -> + empty + +let finalName path = + try + let i = String.rindex path pathSeparatorChar + 1 in + Some (Name.fromString (String.sub path i (String.length path - i))) + with Not_found -> + if isEmpty path then + None + else + Some (Name.fromString path) + +(* pathDeconstruct : path -> (name * path) option *) +let deconstruct path = + try + let i = String.index path pathSeparatorChar in + Some (Name.fromString (String.sub path 0 i), + String.sub path (i + 1) (String.length path - i - 1)) + with Not_found -> + if isEmpty path then + None + else + Some (Name.fromString path, empty) + +let deconstructRev path = + try + let i = String.rindex path pathSeparatorChar in + Some (Name.fromString + (String.sub path (i + 1) (String.length path - i - 1)), + String.sub path 0 i) + with Not_found -> + if path = "" then + None + else + Some (Name.fromString path, empty) + +let winAbspathRx = Rx.rx "([a-zA-Z]:)?(/|\\\\).*" +let unixAbspathRx = Rx.rx "/.*" +let is_absolute s = + if Util.osType=`Win32 then Rx.match_string winAbspathRx s + else Rx.match_string unixAbspathRx s + +(* Function string2path: string -> path + + THIS IS THE CRITICAL FUNCTION. + + Problem: What to do on argument "" ? + What we do: we raise Invalid_argument. + + Problem: double slash within the argument, e.g., "foo//bar". + What we do: we raise Invalid_argument. + + Problem: What if string2path is applied to an absolute path? We + want to disallow this, but, relative is relative. E.g., on Unix it + makes sense to have a directory with subdirectory "c:". Then, it + makes sense to synchronize on the path "c:". But this will go + badly if the Unix system synchronizes with a Windows system. + What we do: we check whether a path is relative using local + conventions, and raise Invalid_argument if not. If we synchronize + with a system with other conventions, then problems must be caught + elsewhere. E.g., the system should refuse to create a directory + "c:" on a Windows machine. + + Problem: spaces in the argument, e.g., " ". Still not sure what to + do here. Is it possible to create a file with this name in Unix or + Windows? + + Problem: trailing slashes, e.g., "foo/bar/". Shells with + command-line completion may produce these routinely. + What we do: we remove them. Moreover, we remove as many as + necessary, e.g., "foo/bar///" becomes "foo/bar". This may be + counter to conventions of some shells/os's, where "foo/bar///" + might mean "/". + + Examples: + loop "hello/there" -> ["hello"; "there"] + loop "/hello/there" -> [""; "hello"; "there"] + loop "" -> [""] + loop "/" -> [""; ""] + loop "//" -> [""; ""; ""] + loop "c:/" ->["c:"; ""] + loop "c:/foo" -> ["c:"; "foo"] +*) +let fromString str = + let str = if Util.osType = `Win32 then Fileutil.backslashes2forwardslashes str else str in + if is_absolute str then + raise (Util.Transient + (Printf.sprintf "The path '%s' is not a relative path" str)); + let str = Fileutil.removeTrailingSlashes str in + if str = "" then empty else + let rec loop p str = + try + let pos = String.index str pathSeparatorChar in + let name1 = String.sub str 0 pos in + let str_res = + String.sub str (pos + 1) (String.length str - pos - 1) in + if pos = 0 then begin + loop p str_res + end else + loop (child p (Name.fromString name1)) str_res + with + Not_found -> child p (Name.fromString str) + | Invalid_argument _ -> + raise(Invalid_argument "Path.fromString") in + loop empty str + +let toString path = path + +let compare p1 p2 = + if Case.insensitive () then Util.nocase_cmp p1 p2 else compare p1 p2 + +let toDebugString path = String.concat " / " (toStringList path) + +let addSuffixToFinalName path suffix = path ^ suffix + +let addPrefixToFinalName path prefix = + try + let i = String.rindex path pathSeparatorChar + 1 in + let l = String.length path in + let l' = String.length prefix in + let p = String.create (l + l') in + String.blit path 0 p 0 i; + String.blit prefix 0 p i l'; + String.blit path i p (i + l') (l - i); + p + with Not_found -> + assert (not (isEmpty path)); + prefix ^ path + +let hash p = Hashtbl.hash p + +(* Pref controlling whether symlinks are followed. *) +let follow = Pred.create "follow" + ("Including the preference \\texttt{-follow \\ARG{pathspec}} causes Unison to \ + treat symbolic links matching \\ARG{pathspec} as `invisible' and \ + behave as if the object pointed to by the link had appeared literally \ + at this position in the replica. See \ + \\sectionref{symlinks}{Symbolic Links} for more details. \ + The syntax of \\ARG{pathspec>} is \ + described in \\sectionref{pathspec}{Path Specification}.") + +let followLink path = + (Util.osType = `Unix || Util.isCygwin) + && Pred.test follow (toString path) + +let magic p = p +let magic' p = p Deleted: branches/2.32/src/path.mli =================================================================== --- trunk/src/path.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/path.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,39 +0,0 @@ -(* Unison file synchronizer: src/path.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* Abstract type of relative pathnames *) -type 'a path - -(* Pathname valid on both replicas (case insensitive in case - insensitive mode) *) -type t = [`Global] path - -(* Pathname specialized to a replica (case sensitive on a case - sensitive filesystem) *) -type local = [`Local] path - -val empty : 'a path -val length : t -> int -val isEmpty : local -> bool - -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 deconstructRev : local -> (Name.t * local) option - -val fromString : string -> 'a path -val toNames : t -> Name.t list -val toString : 'a path -> string -val toDebugString : local -> string - -val addSuffixToFinalName : local -> string -> local -val addPrefixToFinalName : local -> string -> local - -val compare : t -> t -> int -val hash : local -> int - -val followLink : local -> bool - -val magic : t -> local -val magic' : local -> t Copied: branches/2.32/src/path.mli (from rev 320, trunk/src/path.mli) =================================================================== --- branches/2.32/src/path.mli (rev 0) +++ branches/2.32/src/path.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,39 @@ +(* Unison file synchronizer: src/path.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +(* Abstract type of relative pathnames *) +type 'a path + +(* Pathname valid on both replicas (case insensitive in case + insensitive mode) *) +type t = [`Global] path + +(* Pathname specialized to a replica (case sensitive on a case + sensitive filesystem) *) +type local = [`Local] path + +val empty : 'a path +val length : t -> int +val isEmpty : local -> bool + +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 deconstructRev : local -> (Name.t * local) option + +val fromString : string -> 'a path +val toNames : t -> Name.t list +val toString : 'a path -> string +val toDebugString : local -> string + +val addSuffixToFinalName : local -> string -> local +val addPrefixToFinalName : local -> string -> local + +val compare : t -> t -> int +val hash : local -> int + +val followLink : local -> bool + +val magic : t -> local +val magic' : local -> t Deleted: branches/2.32/src/pixmaps.ml =================================================================== --- trunk/src/pixmaps.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/pixmaps.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,819 +0,0 @@ -(* Unison file synchronizer: src/pixmaps.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -let copyAB color = [| -(* width height num_colors chars_per_pixel *) -" 28 14 2 1"; -(* colors *) -". c None"; -"# c #" ^ color; -(* pixels *) -"............................"; -"............................"; -"............................"; -"......................#....."; -".....................###...."; -"......................####.."; -"..##########################"; -"..##########################"; -"......................####.."; -".....................###...."; -"......................#....."; -"............................"; -"............................"; -"............................" -|] - -let copyBA color = [| -(* width height num_colors chars_per_pixel *) -" 28 14 2 1"; -(* colors *) -". c None"; -"# c #" ^ color; -(* pixels *) -"............................"; -"............................"; -"............................"; -".....#......................"; -"....###....................."; -"..####......................"; -"##########################.."; -"##########################.."; -"..####......................"; -"....###....................."; -".....#......................"; -"............................"; -"............................"; -"............................" -|] - -let mergeLogo color = [| -(* width height num_colors chars_per_pixel *) -" 28 14 2 1"; -(* colors *) -". c None"; -"# c #" ^ color; -(* pixels *) -"............................"; -"............................"; -".........##......##........."; -".........###....###........."; -".........####..####........."; -".........##.####.##........."; -".........##..##..##........."; -".........##......##........."; -".........##......##........."; -".........##......##........."; -".........##......##........."; -".........##......##........."; -"............................"; -"............................" -|] - -let ignore color = [| -(* width height num_colors chars_per_pixel *) -" 20 14 2 1"; -(* colors *) -" c None"; -"* c #" ^ color; -(* pixels *) -" "; -" ***** "; -" ** ** "; -" ** ** "; -" ** "; -" ** "; -" ** "; -" ** "; -" ** "; -" "; -" "; -" ** "; -" ** "; -" " -|] - -let success = [| -(* width height num_colors chars_per_pixel *) -" 20 14 2 1"; -(* colors *) -" c None"; -"* c #00dd00"; -(* pixels *) -" "; -" "; -" *** "; -" ****** "; -" ***** * "; -" **** "; -" *** *** "; -" *** ** "; -" ****** "; -" *** "; -" ** "; -" ** "; -" * "; -" " -|] - -let failure = [| -(* width height num_colors chars_per_pixel *) -" 20 14 2 1"; -(* colors *) -" c None"; -"* c #ff0000"; -(* pixels *) -" * * "; -" *** ** "; -" *** *** "; -" ** ** "; -" ** ** "; -" ***** "; -" **** "; -" *** "; -" ***** "; -" ** ** "; -" ** ** "; -" ** *** "; -" *** ** "; -" *** " -|] - - -(***********************************************************************) -(* Some alternative arrow shapes (not currently used)... *) -(***********************************************************************) - -let copyAB_asym = [| -(* width height num_colors chars_per_pixel *) -" 28 14 2 1"; -(* colors *) -". c None"; -"# c #3cf834"; -(* pixels *) -"............................"; -"............................"; -"............................"; -".......................#...."; -"......................###..."; -".......................####."; -"..##########################"; -"..##########################"; -".........................##."; -".......................####."; -"......................###..."; -"............................"; -"............................"; -"............................" -|] - -let copyABblack_asym = [| -(* width height num_colors chars_per_pixel *) -" 28 14 2 1"; -(* colors *) -". c None"; -"# c #000000"; -(* pixels *) -"............................"; -"............................"; -"............................"; -".......................#...."; -"......................###..."; -".......................####."; -"..##########################"; -"..##########################"; -".........................##."; -".......................####."; -"......................###..."; -"............................"; -"............................"; -"............................" -|] - -let copyBA_asym = [| -(* width height num_colors chars_per_pixel *) -" 28 14 2 1"; -(* colors *) -". c None"; -"# c #3cf834"; -(* pixels *) -"............................"; -"............................"; -"............................"; -".....#......................"; -"....###....................."; -"..####......................"; -"##########################.."; -"##########################.."; -"..##........................"; -"..####......................"; -"....###....................."; -"............................"; -"............................"; -"............................" -|] - -let copyBAblack_asym = [| -(* width height num_colors chars_per_pixel *) -" 28 14 2 1"; -(* colors *) -". c None"; -"# c #000000"; -(* pixels *) -"............................"; -"............................"; -"............................"; -".....#......................"; -"....###....................."; -"..####......................"; -"##########################.."; -"##########################.."; -"..##........................"; -"..####......................"; -"....###....................."; -"............................"; -"............................"; -"............................" -|] - -(***********************************************************************) -(* Unison icon *) -(***********************************************************************) - -let icon_data = -"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\001\019\020\006\134\ - \000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\ - \019\020\006\134\000\000\000\001\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\00022\016\152\159¢4ô\ - 12\016\153\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\00022\016\156\ - \159¢4ô12\016\148\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000/0\015w¯²9ñúþRÿ\ - ¯²:ñ00\016x\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\00000\016|²µ;ò\ - úþRÿ«®8ï//\015s\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - *+\014V\145\1470èúþRÿúþRÿ\ - úþRÿ\145\1470è**\014V\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000+,\014Z\149\1511êúþRÿ\ - úþRÿúþRÿ\141\143.ç()\013Q\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\030\031\n6\ - rt%àúþRÿúþRÿúþRÿ\ - úþRÿúþRÿsu&á\030\030\n6\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \"#\011:vx'âúþRÿúþRÿ\ - úþRÿúþRÿúþRÿop$ß\ - \029\029\t2\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\015\015\005\030XZ\029Ø\ - ùýRÿúþRÿúþRÿúþRÿ\ - úþRÿúþRÿùýRÿYZ\029Ø\ - \015\015\005\030\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\014\014\004 \ - \\]\030ÚùýRÿúþRÿúþRÿ\ - úþRÿúþRÿúþRÿøüQÿ\ - VW\028×\008\008\003\027\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\014FG\023Îó÷Pÿ\ - úþRÿúþRÿúþRÿúþRÿ\ - úþRÿúþRÿúþRÿó÷Pÿ\ - GH\023Î\000\000\000\014\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\015IJ\024Ð\ - ôøPÿúþRÿúþRÿúþRÿ\ - úþRÿúþRÿúþRÿúýRÿ\ - òõNÿEF\022Ì\000\000\000\012\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\005;<\019¿èëLÿúþRÿ\ - úþRÿúþRÿúþRÿúþRÿ\ - úþRÿúþRÿúþRÿúþRÿ\ - èìLÿ;<\019¿\000\000\000\005\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\006<=\019ÁêëLÿ\ - úüQÿúûQÿúûQÿúûPÿ\ - úúPÿúúPÿùùPÿùùPÿ\ - ùøPÿåäIÿ99\018½\000\000\000\004\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - 45\017ªÖÚGüúþRÿúþRÿ\ - úþRÿúþRÿúþRÿúþRÿ\ - úþRÿúþRÿúþRÿúþRÿ\ - úþRÿ×ÛGü45\017ª\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\00155\017­Ù×FüúøPÿ\ - ú÷Pÿù÷OÿùöOÿùöOÿ\ - ùõOÿùõOÿùõOÿùôNÿ\ - ùôNÿùóNÿÔÏBü42\016§\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\020\020\006\133\ - IJ\024ê~\128)ä~\128)äÆÉA÷\ - úýRÿúýRÿúüQÿúüQÿ\ - úûQÿúûQÿúûQÿ¸¸<ô\ - ~~(ä}}(äII\023ê\020\020\006\134\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \020\020\006\138KI\023ê}{'ä}z'ä\ - ÇÃ?øùòNÿùòMÿùòMÿ\ - ùñMÿùñMÿøðMÿøðMÿ\ - ¯¨6ò}x&ä}x&äFC\021ë\ - \020\019\006\129\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014\ - \000\000\000\015\000\000\000\015\000\000\000\028}}(ã\ - úùPÿúøPÿúøOÿú÷Oÿ\ - ú÷OÿùöOÿùöOÿdb ×\ - \000\000\000\015\000\000\000\015\000\000\000\015\000\000\000\014\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\014\000\000\000\015\000\000\000\015\000\000\000 \ - \131}(åùîLÿùíKÿùíKÿ\ - ùìKÿøìKÿøëKÿøëKÿ\ - ^Y\028Ð\000\000\000\015\000\000\000\015\000\000\000\015\ - \000\000\000\013\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\014}z'ã\ - ùôNÿùóNÿùóMÿùòMÿ\ - ùòMÿøòMÿøñMÿdb\031×\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ - \130{'åøéJÿøéIÿøèIÿ\ - øèIÿ÷èIÿ÷çIÿ÷çIÿ\ - _Y\028Ð\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\014}x'ã\ - ùðMÿùïMÿùïLÿùîLÿ\ - ùîLÿøíLÿøíLÿd_\031×\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ - \130x&åøåIÿøäHÿøäHÿ\ - øãHÿ÷ãHÿ÷âHÿ÷âHÿ\ - _W\027Ð\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\014|v&ã\ - øëKÿøêKÿøêJÿøéJÿ\ - øéJÿ÷èJÿ÷èJÿd]\030×\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ - \130v%å÷àGÿ÷ßFÿ÷ßFÿ\ - ÷ÞFÿöÞFÿöÝFÿöÝFÿ\ - _U\027Ð\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\014|t%ã\ - øçIÿøæIÿøæHÿøåHÿ\ - øåHÿ÷äHÿ÷äHÿd\\\029×\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ - \130s$å÷ÜEÿ÷ÛDÿ÷ÛDÿ\ - ÷ÚDÿöÚDÿöÙDÿöÙDÿ\ - _T\026Ð\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\014|q$ã\ - ÷âGÿ÷áGÿ÷áFÿ÷àFÿ\ - ÷àFÿößFÿößFÿdZ\028×\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ - \129q#åö×CÿöÖBÿöÖBÿ\ - öÕBÿõÕBÿõÔBÿõÔBÿ\ - ^R\025Ð\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\014|o#ã\ - ÷ÞFÿ÷ÝFÿ÷ÝEÿ÷ÜEÿ\ - ÷ÜEÿöÛEÿöÛEÿdX\028×\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ - \129o#åöÓBÿöÒAÿöÒAÿ\ - öÑAÿõÑAÿõÐAÿõÐAÿ\ - ^P\025Ð\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\014{m\"ã\ - öÙDÿöØDÿöØCÿö×Cÿ\ - ö×CÿõÖCÿõÖCÿcV\027×\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ - \129l\"åõÎ@ÿõÍ?ÿõÍ?ÿ\ - õÌ?ÿôÌ?ÿôË?ÿôË?ÿ\ - ^N\024Ð\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\014{j!ã\ - öÔBÿöÓBÿöÓAÿöÒAÿ\ - öÒAÿõÒAÿõÑAÿcU\026×\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ - \129j!åõÉ>ÿõÉ=ÿõÈ=ÿ\ - õÈ=ÿôÈ=ÿôÇ=ÿôÇ=ÿ\ - ^L\023Ð\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\014{h ã\ - öÐ@ÿõÏ@ÿõÏ?ÿõÎ?ÿ\ - õÎ?ÿõÍ?ÿõÍ?ÿcR\026×\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ - \128g\031åôÅ<ÿôÄ;ÿôÄ;ÿ\ - ôÃ;ÿôÃ;ÿôÂ;ÿôÂ;ÿ\ - ^K\022Ð\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\014{f ã\ - õË?ÿõÊ>ÿõÊ>ÿõÉ>ÿ\ - õÉ>ÿôÈ>ÿôÈ=ÿcP\025×\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ - \128e\030åôÀ:ÿô¿:ÿô¿9ÿ\ - ô¾9ÿó¾9ÿó½9ÿó½9ÿ\ - ^I\022Ð\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\014{d\031ã\ - õÇ=ÿôÆ=ÿôÆ<ÿôÅ<ÿ\ - ôÅ<ÿôÄ<ÿôÄ<ÿcO\024×\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ - \128c\030åó¼9ÿó»8ÿó»8ÿ\ - óº8ÿóº8ÿó¹8ÿó¹8ÿ\ - ^G\021Ð\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\014za\030ã\ - ôÂ;ÿôÁ;ÿôÁ:ÿôÀ:ÿ\ - ôÀ:ÿó¿:ÿó¿:ÿbM\024×\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ - \128`\029åó·7ÿó¶6ÿó¶6ÿ\ - óµ6ÿòµ6ÿò´6ÿò´6ÿ\ - ]E\020Ð\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\014z_\029ã\ - ô½9ÿó¼9ÿó¼8ÿó»8ÿ\ - ó»8ÿó»8ÿóº8ÿbL\023×\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ - \127^\028åò²5ÿò²4ÿò±4ÿ\ - ò±4ÿò±4ÿò°4ÿò°4ÿ\ - ]C\020Ð\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\014z]\028ã\ - ó¹7ÿó¸7ÿó¸6ÿó·6ÿ\ - ó·6ÿò¶6ÿò¶6ÿbJ\022×\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ - \127[\027åò®3ÿò­2ÿò­2ÿ\ - ò¬2ÿñ¬2ÿñ«2ÿñ«2ÿ\ - ]B\019Ð\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\014zZ\027ã\ - ó´6ÿò³6ÿò³5ÿò²5ÿ\ - ò²5ÿò±5ÿò±5ÿbH\022×\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ - ~Y\026åñ©2ÿñ¨1ÿñ¨1ÿ\ - ñ§1ÿñ§1ÿñ¦1ÿñ¦1ÿ\ - ]@\018Ð\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\014yX\026ã\ - ò°4ÿò¯4ÿò¯3ÿò®3ÿ\ - ò®3ÿñ­3ÿñ­3ÿbF\021×\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ - ~W\025åñ¥0ÿñ¤/ÿñ¤/ÿ\ - ñ£/ÿð£/ÿð¢/ÿð¢/ÿ\ - \\>\018Ð\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\014yV\025ã\ - ò«2ÿòª2ÿòª1ÿò©1ÿ\ - ò©1ÿñ¨1ÿñ¨1ÿbD\020×\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ - ~T\024åñ .ÿñ\159-ÿñ\159-ÿ\ - ñ\158-ÿð\158-ÿð\157-ÿð\157-ÿ\ - \\<\017Ð\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\014yT\024ã\ - ñ§0ÿñ¦0ÿñ¦/ÿñ¥/ÿ\ - ñ¥/ÿð¤/ÿð¤/ÿaB\019×\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ - ~R\023åð\156,ÿð\155+ÿð\155+ÿ\ - ð\154+ÿï\154+ÿï\153+ÿï\153+ÿ\ - \\;\016Ð\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\012uO\023ã\ - ñ¢/ÿñ¡.ÿð¡.ÿð .ÿ\ - ð .ÿð\159.ÿð\159-ÿb@\018×\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ - }O\022åï\151*ÿï\150*ÿï\150*ÿ\ - ï\149*ÿï\149)ÿï\148)ÿï\147)ÿ\ - [7\016Î\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\003jE\020à\ - ð\157-ÿð\156,ÿð\156,ÿð\155,ÿ\ - ð\155,ÿð\154,ÿð\154,ÿb?\018Ù\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\027\ - \134R\023éï\144'ÿî\143'ÿî\142'ÿ\ - î\141&ÿî\140&ÿî\140&ÿî\139%ÿ\ - W3\014Ê\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000d@\018Ü\ - ð\152+ÿð\152+ÿï\152*ÿï\151*ÿ\ - ï\151*ÿï\150*ÿï\150*ÿd>\017Û\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000)\ - \151V\023ðî\135$ÿí\134$ÿí\133#ÿ\ - í\132#ÿí\131#ÿí\130\"ÿí\129\"ÿ\ - U.\012Ç\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000a<\017×\ - ï\147)ÿï\146)ÿï\145(ÿï\144(ÿ\ - ï\144(ÿï\143'ÿï\142'ÿd<\016Ý\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\0008\ - ¨Y\023ùí} ÿí| ÿí{ ÿ\ - í{\031ÿíz\031ÿíy\031ÿíx\030ÿ\ - R)\nÃ\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000^7\015Ó\ - î\138%ÿî\137%ÿî\136$ÿî\135$ÿ\ - î\134$ÿî\133#ÿî\132#ÿh:\015à\ - \000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\016\008\002L\ - ·Z\023ÿìs\028ÿìs\028ÿìr\028ÿ\ - ìq\027ÿìp\027ÿìo\027ÿìn\026ÿ\ - O$\tÀ\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000Z1\013Î\ - í\129!ÿí\128!ÿí\127 ÿí~ ÿ\ - í} ÿí|\031ÿí{\031ÿ\129C\017ç\ - \000\000\000\023\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\"\016\004d\ - ÄY\021ÿëj\024ÿëj\024ÿëi\024ÿ\ - ëh\023ÿëg\023ÿëf\023ÿëe\022ÿ\ - K \007¼\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000M'\n¿\ - ìw\030ÿìv\030ÿìu\029ÿìt\029ÿ\ - ìs\029ÿìr\028ÿìq\028ÿ\158L\019õ\ - \000\000\0002\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000*\018\004z\ - ÑW\020ÿê`\021ÿê`\021ÿê_\021ÿ\ - ê^\020ÿê]\020ÿê\\\020ÿê[\019ÿ\ - >\024\005¯\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000;\028\007¬\ - ën\026ÿëm\026ÿël\025ÿëk\025ÿ\ - ëj\025ÿëi\024ÿëh\024ÿÜa\022ÿ\ - 3\022\005\158\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000/\018\004£\ - âU\017ÿéW\017ÿéW\017ÿéV\017ÿ\ - éU\016ÿéT\016ÿéS\016ÿãP\015ÿ\ - /\016\003\153\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000-\020\004\139\ - Ú]\021ÿêc\022ÿêb\021ÿêa\021ÿ\ - êa\021ÿê`\020ÿê_\020ÿê^\020ÿ\ - ]%\008Û\000\000\000\014\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\006X\030\005Õ\ - èO\014ÿèN\013ÿèM\013ÿèL\013ÿ\ - èL\012ÿèK\012ÿèJ\012ÿÆ>\tÿ\ - %\012\002l\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\017\007\001N\ - ²F\015ýéZ\019ÿéY\018ÿéX\018ÿ\ - éW\018ÿéV\017ÿéU\017ÿéU\017ÿ\ - ÙN\015ÿ9\020\004Ê\000\000\000\016\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\002&\012\002­É=\nü\ - çE\011ÿçD\nÿçD\nÿçC\nÿ\ - çB\tÿçA\tÿç@\tÿ\155*\005õ\ - \004\001\0005\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\ - _!\006ÙèQ\015ÿèP\014ÿèO\014ÿ\ - èN\014ÿèM\013ÿèL\013ÿèL\013ÿ\ - èK\012ÿÝF\011ÿ<\019\003Í\016\005\001X\ - \000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \008\002\000\0261\013\002ÁÅ5\006üæ=\007ÿ\ - æ<\007ÿæ;\006ÿæ;\006ÿæ:\006ÿ\ - æ9\005ÿæ8\005ÿæ7\005ÿO\019\001Ï\ - \000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - 2\016\002¥ÜD\nÿçF\011ÿçE\nÿ\ - çE\nÿçD\tÿçC\tÿçB\tÿ\ - çA\008ÿç@\008ÿç?\008ÿ±0\005û\ - 5\014\002Ô6\014\002².\012\001\157(\n\001w\ - \030\007\001^-\011\001\142.\011\001®N\019\002³\ - \139!\002ôà5\004ÿæ5\004ÿæ4\003ÿ\ - æ3\003ÿæ2\002ÿå1\002ÿå0\002ÿ\ - å0\001ÿå/\001ÿÔ+\001ÿ/\t\000\148\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \t\002\000\024X\024\003Úç=\007ÿç<\006ÿ\ - ç;\006ÿç:\006ÿç9\005ÿç9\005ÿ\ - æ8\005ÿæ7\004ÿæ6\004ÿæ5\004ÿ\ - æ4\003ÿæ3\003ÿå2\003ÿË+\002ÿ\ - »'\002ÿÙ-\002ÿå/\001ÿå.\001ÿ\ - å-\001ÿå,\000ÿå+\000ÿå+\000ÿ\ - å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ - å+\000ÿå+\000ÿT\016\000Û\000\000\000\020\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000%\008\001U\153#\002ìæ3\003ÿ\ - æ2\003ÿæ1\002ÿæ0\002ÿå/\001ÿ\ - å/\001ÿå.\001ÿå-\000ÿå+\000ÿ\ - å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ - å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ - å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ - å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ - å+\000ÿ\145\027\000ì%\007\000U\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\0003\n\000p\128\024\000ç\ - å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ - å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ - å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ - å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ - å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ - å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ - \152\029\000ñ6\n\000y\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\030\006\000J\ - j\020\000ÛÞ*\000ÿå+\000ÿå+\000ÿ\ - å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ - å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ - å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ - å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ - å+\000ÿå+\000ÿã+\000ÿx\022\000Ý\ - &\007\000_\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\0211\t\000 k\020\000à×(\000ÿ\ - å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ - å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ - å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ - å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ - Û)\000ÿw\022\000æ7\n\000°\017\003\000$\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\n4\n\000\147\ - G\013\000¿_\018\000Ý£\031\000ùË&\000ÿ\ - ä+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ - å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ - Ô(\000ÿ±!\000ýo\021\000ãO\015\000È\ - 9\011\000¦\000\000\000\018\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\002\003\001\000<)\008\000z\ - -\t\000\1502\t\000¤:\011\000¬B\012\000´\ - H\014\000º@\012\000²9\011\000ª.\t\000£\ - ,\008\000\136\004\001\000L\000\000\000\007\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ - \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000" Copied: branches/2.32/src/pixmaps.ml (from rev 320, trunk/src/pixmaps.ml) =================================================================== --- branches/2.32/src/pixmaps.ml (rev 0) +++ branches/2.32/src/pixmaps.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,834 @@ +(* Unison file synchronizer: src/pixmaps.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +let copyAB color = [| +(* width height num_colors chars_per_pixel *) +" 28 14 2 1"; +(* colors *) +". c None"; +"# c #" ^ color; +(* pixels *) +"............................"; +"............................"; +"............................"; +"......................#....."; +".....................###...."; +"......................####.."; +"..##########################"; +"..##########################"; +"......................####.."; +".....................###...."; +"......................#....."; +"............................"; +"............................"; +"............................" +|] + +let copyBA color = [| +(* width height num_colors chars_per_pixel *) +" 28 14 2 1"; +(* colors *) +". c None"; +"# c #" ^ color; +(* pixels *) +"............................"; +"............................"; +"............................"; +".....#......................"; +"....###....................."; +"..####......................"; +"##########################.."; +"##########################.."; +"..####......................"; +"....###....................."; +".....#......................"; +"............................"; +"............................"; +"............................" +|] + +let mergeLogo color = [| +(* width height num_colors chars_per_pixel *) +" 28 14 2 1"; +(* colors *) +". c None"; +"# c #" ^ color; +(* pixels *) +"............................"; +"............................"; +".........##......##........."; +".........###....###........."; +".........####..####........."; +".........##.####.##........."; +".........##..##..##........."; +".........##......##........."; +".........##......##........."; +".........##......##........."; +".........##......##........."; +".........##......##........."; +"............................"; +"............................" +|] + +let ignore color = [| +(* width height num_colors chars_per_pixel *) +" 20 14 2 1"; +(* colors *) +" c None"; +"* c #" ^ color; +(* pixels *) +" "; +" ***** "; +" ** ** "; +" ** ** "; +" ** "; +" ** "; +" ** "; +" ** "; +" ** "; +" "; +" "; +" ** "; +" ** "; +" " +|] + +let success = [| +(* width height num_colors chars_per_pixel *) +" 20 14 2 1"; +(* colors *) +" c None"; +"* c #00dd00"; +(* pixels *) +" "; +" "; +" *** "; +" ****** "; +" ***** * "; +" **** "; +" *** *** "; +" *** ** "; +" ****** "; +" *** "; +" ** "; +" ** "; +" * "; +" " +|] + +let failure = [| +(* width height num_colors chars_per_pixel *) +" 20 14 2 1"; +(* colors *) +" c None"; +"* c #ff0000"; +(* pixels *) +" * * "; +" *** ** "; +" *** *** "; +" ** ** "; +" ** ** "; +" ***** "; +" **** "; +" *** "; +" ***** "; +" ** ** "; +" ** ** "; +" ** *** "; +" *** ** "; +" *** " +|] + + +(***********************************************************************) +(* Some alternative arrow shapes (not currently used)... *) +(***********************************************************************) + +let copyAB_asym = [| +(* width height num_colors chars_per_pixel *) +" 28 14 2 1"; +(* colors *) +". c None"; +"# c #3cf834"; +(* pixels *) +"............................"; +"............................"; +"............................"; +".......................#...."; +"......................###..."; +".......................####."; +"..##########################"; +"..##########################"; +".........................##."; +".......................####."; +"......................###..."; +"............................"; +"............................"; +"............................" +|] + +let copyABblack_asym = [| +(* width height num_colors chars_per_pixel *) +" 28 14 2 1"; +(* colors *) +". c None"; +"# c #000000"; +(* pixels *) +"............................"; +"............................"; +"............................"; +".......................#...."; +"......................###..."; +".......................####."; +"..##########################"; +"..##########################"; +".........................##."; +".......................####."; +"......................###..."; +"............................"; +"............................"; +"............................" +|] + +let copyBA_asym = [| +(* width height num_colors chars_per_pixel *) +" 28 14 2 1"; +(* colors *) +". c None"; +"# c #3cf834"; +(* pixels *) +"............................"; +"............................"; +"............................"; +".....#......................"; +"....###....................."; +"..####......................"; +"##########################.."; +"##########################.."; +"..##........................"; +"..####......................"; +"....###....................."; +"............................"; +"............................"; +"............................" +|] + +let copyBAblack_asym = [| +(* width height num_colors chars_per_pixel *) +" 28 14 2 1"; +(* colors *) +". c None"; +"# c #000000"; +(* pixels *) +"............................"; +"............................"; +"............................"; +".....#......................"; +"....###....................."; +"..####......................"; +"##########################.."; +"##########################.."; +"..##........................"; +"..####......................"; +"....###....................."; +"............................"; +"............................"; +"............................" +|] + +(***********************************************************************) +(* Unison icon *) +(***********************************************************************) + +let icon_data = +"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\001\019\020\006\134\ + \000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\ + \019\020\006\134\000\000\000\001\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\00022\016\152\159¢4ô\ + 12\016\153\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\00022\016\156\ + \159¢4ô12\016\148\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000/0\015w¯²9ñúþRÿ\ + ¯²:ñ00\016x\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\00000\016|²µ;ò\ + úþRÿ«®8ï//\015s\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + *+\014V\145\1470èúþRÿúþRÿ\ + úþRÿ\145\1470è**\014V\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000+,\014Z\149\1511êúþRÿ\ + úþRÿúþRÿ\141\143.ç()\013Q\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\030\031\n6\ + rt%àúþRÿúþRÿúþRÿ\ + úþRÿúþRÿsu&á\030\030\n6\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \"#\011:vx'âúþRÿúþRÿ\ + úþRÿúþRÿúþRÿop$ß\ + \029\029\t2\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\015\015\005\030XZ\029Ø\ + ùýRÿúþRÿúþRÿúþRÿ\ + úþRÿúþRÿùýRÿYZ\029Ø\ + \015\015\005\030\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\014\014\004 \ + \\]\030ÚùýRÿúþRÿúþRÿ\ + úþRÿúþRÿúþRÿøüQÿ\ + VW\028×\008\008\003\027\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\014FG\023Îó÷Pÿ\ + úþRÿúþRÿúþRÿúþRÿ\ + úþRÿúþRÿúþRÿó÷Pÿ\ + GH\023Î\000\000\000\014\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\015IJ\024Ð\ + ôøPÿúþRÿúþRÿúþRÿ\ + úþRÿúþRÿúþRÿúýRÿ\ + òõNÿEF\022Ì\000\000\000\012\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\005;<\019¿èëLÿúþRÿ\ + úþRÿúþRÿúþRÿúþRÿ\ + úþRÿúþRÿúþRÿúþRÿ\ + èìLÿ;<\019¿\000\000\000\005\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\006<=\019ÁêëLÿ\ + úüQÿúûQÿúûQÿúûPÿ\ + úúPÿúúPÿùùPÿùùPÿ\ + ùøPÿåäIÿ99\018½\000\000\000\004\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + 45\017ªÖÚGüúþRÿúþRÿ\ + úþRÿúþRÿúþRÿúþRÿ\ + úþRÿúþRÿúþRÿúþRÿ\ + úþRÿ×ÛGü45\017ª\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\00155\017­Ù×FüúøPÿ\ + ú÷Pÿù÷OÿùöOÿùöOÿ\ + ùõOÿùõOÿùõOÿùôNÿ\ + ùôNÿùóNÿÔÏBü42\016§\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\020\020\006\133\ + IJ\024ê~\128)ä~\128)äÆÉA÷\ + úýRÿúýRÿúüQÿúüQÿ\ + úûQÿúûQÿúûQÿ¸¸<ô\ + ~~(ä}}(äII\023ê\020\020\006\134\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \020\020\006\138KI\023ê}{'ä}z'ä\ + ÇÃ?øùòNÿùòMÿùòMÿ\ + ùñMÿùñMÿøðMÿøðMÿ\ + ¯¨6ò}x&ä}x&äFC\021ë\ + \020\019\006\129\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014\ + \000\000\000\015\000\000\000\015\000\000\000\028}}(ã\ + úùPÿúøPÿúøOÿú÷Oÿ\ + ú÷OÿùöOÿùöOÿdb ×\ + \000\000\000\015\000\000\000\015\000\000\000\015\000\000\000\014\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\014\000\000\000\015\000\000\000\015\000\000\000 \ + \131}(åùîLÿùíKÿùíKÿ\ + ùìKÿøìKÿøëKÿøëKÿ\ + ^Y\028Ð\000\000\000\015\000\000\000\015\000\000\000\015\ + \000\000\000\013\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\014}z'ã\ + ùôNÿùóNÿùóMÿùòMÿ\ + ùòMÿøòMÿøñMÿdb\031×\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ + \130{'åøéJÿøéIÿøèIÿ\ + øèIÿ÷èIÿ÷çIÿ÷çIÿ\ + _Y\028Ð\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\014}x'ã\ + ùðMÿùïMÿùïLÿùîLÿ\ + ùîLÿøíLÿøíLÿd_\031×\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ + \130x&åøåIÿøäHÿøäHÿ\ + øãHÿ÷ãHÿ÷âHÿ÷âHÿ\ + _W\027Ð\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\014|v&ã\ + øëKÿøêKÿøêJÿøéJÿ\ + øéJÿ÷èJÿ÷èJÿd]\030×\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ + \130v%å÷àGÿ÷ßFÿ÷ßFÿ\ + ÷ÞFÿöÞFÿöÝFÿöÝFÿ\ + _U\027Ð\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\014|t%ã\ + øçIÿøæIÿøæHÿøåHÿ\ + øåHÿ÷äHÿ÷äHÿd\\\029×\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ + \130s$å÷ÜEÿ÷ÛDÿ÷ÛDÿ\ + ÷ÚDÿöÚDÿöÙDÿöÙDÿ\ + _T\026Ð\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\014|q$ã\ + ÷âGÿ÷áGÿ÷áFÿ÷àFÿ\ + ÷àFÿößFÿößFÿdZ\028×\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ + \129q#åö×CÿöÖBÿöÖBÿ\ + öÕBÿõÕBÿõÔBÿõÔBÿ\ + ^R\025Ð\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\014|o#ã\ + ÷ÞFÿ÷ÝFÿ÷ÝEÿ÷ÜEÿ\ + ÷ÜEÿöÛEÿöÛEÿdX\028×\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ + \129o#åöÓBÿöÒAÿöÒAÿ\ + öÑAÿõÑAÿõÐAÿõÐAÿ\ + ^P\025Ð\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\014{m\"ã\ + öÙDÿöØDÿöØCÿö×Cÿ\ + ö×CÿõÖCÿõÖCÿcV\027×\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ + \129l\"åõÎ@ÿõÍ?ÿõÍ?ÿ\ + õÌ?ÿôÌ?ÿôË?ÿôË?ÿ\ + ^N\024Ð\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\014{j!ã\ + öÔBÿöÓBÿöÓAÿöÒAÿ\ + öÒAÿõÒAÿõÑAÿcU\026×\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ + \129j!åõÉ>ÿõÉ=ÿõÈ=ÿ\ + õÈ=ÿôÈ=ÿôÇ=ÿôÇ=ÿ\ + ^L\023Ð\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\014{h ã\ + öÐ@ÿõÏ@ÿõÏ?ÿõÎ?ÿ\ + õÎ?ÿõÍ?ÿõÍ?ÿcR\026×\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ + \128g\031åôÅ<ÿôÄ;ÿôÄ;ÿ\ + ôÃ;ÿôÃ;ÿôÂ;ÿôÂ;ÿ\ + ^K\022Ð\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\014{f ã\ + õË?ÿõÊ>ÿõÊ>ÿõÉ>ÿ\ + õÉ>ÿôÈ>ÿôÈ=ÿcP\025×\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ + \128e\030åôÀ:ÿô¿:ÿô¿9ÿ\ + ô¾9ÿó¾9ÿó½9ÿó½9ÿ\ + ^I\022Ð\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\014{d\031ã\ + õÇ=ÿôÆ=ÿôÆ<ÿôÅ<ÿ\ + ôÅ<ÿôÄ<ÿôÄ<ÿcO\024×\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ + \128c\030åó¼9ÿó»8ÿó»8ÿ\ + óº8ÿóº8ÿó¹8ÿó¹8ÿ\ + ^G\021Ð\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\014za\030ã\ + ôÂ;ÿôÁ;ÿôÁ:ÿôÀ:ÿ\ + ôÀ:ÿó¿:ÿó¿:ÿbM\024×\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ + \128`\029åó·7ÿó¶6ÿó¶6ÿ\ + óµ6ÿòµ6ÿò´6ÿò´6ÿ\ + ]E\020Ð\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\014z_\029ã\ + ô½9ÿó¼9ÿó¼8ÿó»8ÿ\ + ó»8ÿó»8ÿóº8ÿbL\023×\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ + \127^\028åò²5ÿò²4ÿò±4ÿ\ + ò±4ÿò±4ÿò°4ÿò°4ÿ\ + ]C\020Ð\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\014z]\028ã\ + ó¹7ÿó¸7ÿó¸6ÿó·6ÿ\ + ó·6ÿò¶6ÿò¶6ÿbJ\022×\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ + \127[\027åò®3ÿò­2ÿò­2ÿ\ + ò¬2ÿñ¬2ÿñ«2ÿñ«2ÿ\ + ]B\019Ð\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\014zZ\027ã\ + ó´6ÿò³6ÿò³5ÿò²5ÿ\ + ò²5ÿò±5ÿò±5ÿbH\022×\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ + ~Y\026åñ©2ÿñ¨1ÿñ¨1ÿ\ + ñ§1ÿñ§1ÿñ¦1ÿñ¦1ÿ\ + ]@\018Ð\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\014yX\026ã\ + ò°4ÿò¯4ÿò¯3ÿò®3ÿ\ + ò®3ÿñ­3ÿñ­3ÿbF\021×\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ + ~W\025åñ¥0ÿñ¤/ÿñ¤/ÿ\ + ñ£/ÿð£/ÿð¢/ÿð¢/ÿ\ + \\>\018Ð\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\014yV\025ã\ + ò«2ÿòª2ÿòª1ÿò©1ÿ\ + ò©1ÿñ¨1ÿñ¨1ÿbD\020×\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ + ~T\024åñ .ÿñ\159-ÿñ\159-ÿ\ + ñ\158-ÿð\158-ÿð\157-ÿð\157-ÿ\ + \\<\017Ð\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\014yT\024ã\ + ñ§0ÿñ¦0ÿñ¦/ÿñ¥/ÿ\ + ñ¥/ÿð¤/ÿð¤/ÿaB\019×\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ + ~R\023åð\156,ÿð\155+ÿð\155+ÿ\ + ð\154+ÿï\154+ÿï\153+ÿï\153+ÿ\ + \\;\016Ð\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\012uO\023ã\ + ñ¢/ÿñ¡.ÿð¡.ÿð .ÿ\ + ð .ÿð\159.ÿð\159-ÿb@\018×\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\ + }O\022åï\151*ÿï\150*ÿï\150*ÿ\ + ï\149*ÿï\149)ÿï\148)ÿï\147)ÿ\ + [7\016Î\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\003jE\020à\ + ð\157-ÿð\156,ÿð\156,ÿð\155,ÿ\ + ð\155,ÿð\154,ÿð\154,ÿb?\018Ù\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\027\ + \134R\023éï\144'ÿî\143'ÿî\142'ÿ\ + î\141&ÿî\140&ÿî\140&ÿî\139%ÿ\ + W3\014Ê\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000d@\018Ü\ + ð\152+ÿð\152+ÿï\152*ÿï\151*ÿ\ + ï\151*ÿï\150*ÿï\150*ÿd>\017Û\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000)\ + \151V\023ðî\135$ÿí\134$ÿí\133#ÿ\ + í\132#ÿí\131#ÿí\130\"ÿí\129\"ÿ\ + U.\012Ç\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000a<\017×\ + ï\147)ÿï\146)ÿï\145(ÿï\144(ÿ\ + ï\144(ÿï\143'ÿï\142'ÿd<\016Ý\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\0008\ + ¨Y\023ùí} ÿí| ÿí{ ÿ\ + í{\031ÿíz\031ÿíy\031ÿíx\030ÿ\ + R)\nÃ\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000^7\015Ó\ + î\138%ÿî\137%ÿî\136$ÿî\135$ÿ\ + î\134$ÿî\133#ÿî\132#ÿh:\015à\ + \000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\016\008\002L\ + ·Z\023ÿìs\028ÿìs\028ÿìr\028ÿ\ + ìq\027ÿìp\027ÿìo\027ÿìn\026ÿ\ + O$\tÀ\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000Z1\013Î\ + í\129!ÿí\128!ÿí\127 ÿí~ ÿ\ + í} ÿí|\031ÿí{\031ÿ\129C\017ç\ + \000\000\000\023\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\"\016\004d\ + ÄY\021ÿëj\024ÿëj\024ÿëi\024ÿ\ + ëh\023ÿëg\023ÿëf\023ÿëe\022ÿ\ + K \007¼\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000M'\n¿\ + ìw\030ÿìv\030ÿìu\029ÿìt\029ÿ\ + ìs\029ÿìr\028ÿìq\028ÿ\158L\019õ\ + \000\000\0002\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000*\018\004z\ + ÑW\020ÿê`\021ÿê`\021ÿê_\021ÿ\ + ê^\020ÿê]\020ÿê\\\020ÿê[\019ÿ\ + >\024\005¯\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000;\028\007¬\ + ën\026ÿëm\026ÿël\025ÿëk\025ÿ\ + ëj\025ÿëi\024ÿëh\024ÿÜa\022ÿ\ + 3\022\005\158\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000/\018\004£\ + âU\017ÿéW\017ÿéW\017ÿéV\017ÿ\ + éU\016ÿéT\016ÿéS\016ÿãP\015ÿ\ + /\016\003\153\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000-\020\004\139\ + Ú]\021ÿêc\022ÿêb\021ÿêa\021ÿ\ + êa\021ÿê`\020ÿê_\020ÿê^\020ÿ\ + ]%\008Û\000\000\000\014\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\006X\030\005Õ\ + èO\014ÿèN\013ÿèM\013ÿèL\013ÿ\ + èL\012ÿèK\012ÿèJ\012ÿÆ>\tÿ\ + %\012\002l\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\017\007\001N\ + ²F\015ýéZ\019ÿéY\018ÿéX\018ÿ\ + éW\018ÿéV\017ÿéU\017ÿéU\017ÿ\ + ÙN\015ÿ9\020\004Ê\000\000\000\016\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\002&\012\002­É=\nü\ + çE\011ÿçD\nÿçD\nÿçC\nÿ\ + çB\tÿçA\tÿç@\tÿ\155*\005õ\ + \004\001\0005\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\ + _!\006ÙèQ\015ÿèP\014ÿèO\014ÿ\ + èN\014ÿèM\013ÿèL\013ÿèL\013ÿ\ + èK\012ÿÝF\011ÿ<\019\003Í\016\005\001X\ + \000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \008\002\000\0261\013\002ÁÅ5\006üæ=\007ÿ\ + æ<\007ÿæ;\006ÿæ;\006ÿæ:\006ÿ\ + æ9\005ÿæ8\005ÿæ7\005ÿO\019\001Ï\ + \000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + 2\016\002¥ÜD\nÿçF\011ÿçE\nÿ\ + çE\nÿçD\tÿçC\tÿçB\tÿ\ + çA\008ÿç@\008ÿç?\008ÿ±0\005û\ + 5\014\002Ô6\014\002².\012\001\157(\n\001w\ + \030\007\001^-\011\001\142.\011\001®N\019\002³\ + \139!\002ôà5\004ÿæ5\004ÿæ4\003ÿ\ + æ3\003ÿæ2\002ÿå1\002ÿå0\002ÿ\ + å0\001ÿå/\001ÿÔ+\001ÿ/\t\000\148\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \t\002\000\024X\024\003Úç=\007ÿç<\006ÿ\ + ç;\006ÿç:\006ÿç9\005ÿç9\005ÿ\ + æ8\005ÿæ7\004ÿæ6\004ÿæ5\004ÿ\ + æ4\003ÿæ3\003ÿå2\003ÿË+\002ÿ\ + »'\002ÿÙ-\002ÿå/\001ÿå.\001ÿ\ + å-\001ÿå,\000ÿå+\000ÿå+\000ÿ\ + å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ + å+\000ÿå+\000ÿT\016\000Û\000\000\000\020\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000%\008\001U\153#\002ìæ3\003ÿ\ + æ2\003ÿæ1\002ÿæ0\002ÿå/\001ÿ\ + å/\001ÿå.\001ÿå-\000ÿå+\000ÿ\ + å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ + å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ + å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ + å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ + å+\000ÿ\145\027\000ì%\007\000U\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\0003\n\000p\128\024\000ç\ + å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ + å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ + å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ + å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ + å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ + å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ + \152\029\000ñ6\n\000y\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\030\006\000J\ + j\020\000ÛÞ*\000ÿå+\000ÿå+\000ÿ\ + å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ + å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ + å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ + å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ + å+\000ÿå+\000ÿã+\000ÿx\022\000Ý\ + &\007\000_\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\0211\t\000 k\020\000à×(\000ÿ\ + å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ + å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ + å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ + å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ + Û)\000ÿw\022\000æ7\n\000°\017\003\000$\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\n4\n\000\147\ + G\013\000¿_\018\000Ý£\031\000ùË&\000ÿ\ + ä+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ + å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\ + Ô(\000ÿ±!\000ýo\021\000ãO\015\000È\ + 9\011\000¦\000\000\000\018\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\002\003\001\000<)\008\000z\ + -\t\000\1502\t\000¤:\011\000¬B\012\000´\ + H\014\000º@\012\000²9\011\000ª.\t\000£\ + ,\008\000\136\004\001\000L\000\000\000\007\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000" Deleted: branches/2.32/src/pred.ml =================================================================== --- trunk/src/pred.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/pred.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,142 +0,0 @@ -(* Unison file synchronizer: src/pred.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -let debug = Util.debug "pred" - -(********************************************************************) -(* TYPES *) -(********************************************************************) - -type t = - { pref: string list Prefs.t; - name: string; (* XXX better to get it from Prefs! *) - mutable default: string list; - mutable last_pref : string list; - mutable last_def : string list; - mutable last_mode : bool; - mutable compiled: Rx.t; - mutable associated_strings : (Rx.t * string) list; - } - -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 - -(* [select str [(p1, f1), ..., (pN, fN)] fO]: (roughly) *) -(* match str with *) -(* p1 p' -> f1 p' *) -(* ... *) -(* pN p' -> fN p' *) -(* otherwise -> fO str *) -let rec select str l f = - match l with - [] -> f str - | (pref, g)::r -> - if Util.startswith str pref then - let l = String.length pref in - g (Util.trimWhitespace (String.sub str l (String.length str - l))) - else - select str r f - -let mapSeparator = "->" - -(* Compile a pattern (in string form) to a regular expression *) -let compile_pattern clause = - let (p,v) = - match Util.splitIntoWordsByString clause mapSeparator with - [p] -> (p,None) - | [p;v] -> (p, Some (Util.trimWhitespace v)) - | [] -> raise (Prefs.IllegalValue "Empty pattern") - | _ -> raise (Prefs.IllegalValue ("Malformed pattern: " - ^ "\"" ^ clause ^ "\"\n" - ^ "Only one instance of " ^ mapSeparator ^ " allowed.")) in - let compiled = - begin try - select p - [("Name ", fun str -> Rx.seq [Rx.rx "(.*/)?"; Rx.globx str]); - ("Path ", fun str -> - if str<>"" && str.[0] = '/' then - raise (Prefs.IllegalValue - ("Malformed pattern: " - ^ "\"" ^ p ^ "\"\n" - ^ "'Path' patterns may not begin with a slash; " - ^ "only relative paths are allowed.")); - Rx.globx str); - ("Regex ", Rx.rx)] - (fun str -> raise (Prefs.IllegalValue (error_msg p))) - with - Rx.Parse_error | Rx.Not_supported -> - raise (Prefs.IllegalValue ("Malformed pattern \"" ^ p ^ "\".")) - end in - (compiled, v) - -let create name ?(advanced=false) fulldoc = - let pref = - Prefs.create name [] - ((if advanced then "!" else "") - ^ "add a pattern to the " ^ name ^ " list") - fulldoc - (fun oldList string -> - ignore (compile_pattern string); (* Check well-formedness *) - string :: oldList) - (fun l -> l) in - {pref = pref; name = name; - last_pref = []; default = []; last_def = []; last_mode = false; - compiled = Rx.empty; associated_strings = []} - -let addDefaultPatterns p pats = - p.default <- Safelist.append pats p.default - -let alias p n = Prefs.alias p.pref n - -let recompile mode p = - let pref = Prefs.read p.pref in - let compiledList = Safelist.map compile_pattern (Safelist.append p.default pref) in - let compiled = Rx.alt (Safelist.map fst compiledList) in - let strings = Safelist.filterMap - (fun (rx,vo) -> - match vo with - None -> None - | Some v -> Some (rx,v)) - compiledList in - p.compiled <- if mode then Rx.case_insensitive compiled else compiled; - p.associated_strings <- strings; - p.last_pref <- pref; - p.last_def <- p.default; - p.last_mode <- mode - -let recompile_if_needed p = - let mode = Case.insensitive () in - if - p.last_mode <> mode || - p.last_pref != Prefs.read p.pref || - p.last_def != p.default - then - recompile mode p - -(********************************************************************) -(* IMPORT / EXPORT *) -(********************************************************************) - -let intern p regexpStringList = Prefs.set p.pref regexpStringList - -let extern p = Prefs.read p.pref - -let extern_associated_strings p = - recompile_if_needed p; - Safelist.map snd p.associated_strings - -(********************************************************************) -(* TESTING *) -(********************************************************************) - -let test p s = - recompile_if_needed p; - let res = Rx.match_string p.compiled (Case.normalize s) in - debug (fun() -> Util.msg "%s '%s' = %b\n" p.name s res); - res - -let assoc p s = - recompile_if_needed p; - snd (Safelist.find (fun (rx,v) -> Rx.match_string rx s) p.associated_strings) Copied: branches/2.32/src/pred.ml (from rev 320, trunk/src/pred.ml) =================================================================== --- branches/2.32/src/pred.ml (rev 0) +++ branches/2.32/src/pred.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,157 @@ +(* Unison file synchronizer: src/pred.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +let debug = Util.debug "pred" + +(********************************************************************) +(* TYPES *) +(********************************************************************) + +type t = + { pref: string list Prefs.t; + name: string; (* XXX better to get it from Prefs! *) + mutable default: string list; + mutable last_pref : string list; + mutable last_def : string list; + mutable last_mode : bool; + mutable compiled: Rx.t; + mutable associated_strings : (Rx.t * string) list; + } + +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 + +(* [select str [(p1, f1), ..., (pN, fN)] fO]: (roughly) *) +(* match str with *) +(* p1 p' -> f1 p' *) +(* ... *) +(* pN p' -> fN p' *) +(* otherwise -> fO str *) +let rec select str l f = + match l with + [] -> f str + | (pref, g)::r -> + if Util.startswith str pref then + let l = String.length pref in + g (Util.trimWhitespace (String.sub str l (String.length str - l))) + else + select str r f + +let mapSeparator = "->" + +(* Compile a pattern (in string form) to a regular expression *) +let compile_pattern clause = + let (p,v) = + match Util.splitIntoWordsByString clause mapSeparator with + [p] -> (p,None) + | [p;v] -> (p, Some (Util.trimWhitespace v)) + | [] -> raise (Prefs.IllegalValue "Empty pattern") + | _ -> raise (Prefs.IllegalValue ("Malformed pattern: " + ^ "\"" ^ clause ^ "\"\n" + ^ "Only one instance of " ^ mapSeparator ^ " allowed.")) in + let compiled = + begin try + select p + [("Name ", fun str -> Rx.seq [Rx.rx "(.*/)?"; Rx.globx str]); + ("Path ", fun str -> + if str<>"" && str.[0] = '/' then + raise (Prefs.IllegalValue + ("Malformed pattern: " + ^ "\"" ^ p ^ "\"\n" + ^ "'Path' patterns may not begin with a slash; " + ^ "only relative paths are allowed.")); + Rx.globx str); + ("Regex ", Rx.rx)] + (fun str -> raise (Prefs.IllegalValue (error_msg p))) + with + Rx.Parse_error | Rx.Not_supported -> + raise (Prefs.IllegalValue ("Malformed pattern \"" ^ p ^ "\".")) + end in + (compiled, v) + +let create name ?(advanced=false) fulldoc = + let pref = + Prefs.create name [] + ((if advanced then "!" else "") + ^ "add a pattern to the " ^ name ^ " list") + fulldoc + (fun oldList string -> + ignore (compile_pattern string); (* Check well-formedness *) + string :: oldList) + (fun l -> l) in + {pref = pref; name = name; + last_pref = []; default = []; last_def = []; last_mode = false; + compiled = Rx.empty; associated_strings = []} + +let addDefaultPatterns p pats = + p.default <- Safelist.append pats p.default + +let alias p n = Prefs.alias p.pref n + +let recompile mode p = + let pref = Prefs.read p.pref in + let compiledList = Safelist.map compile_pattern (Safelist.append p.default pref) in + let compiled = Rx.alt (Safelist.map fst compiledList) in + let strings = Safelist.filterMap + (fun (rx,vo) -> + match vo with + None -> None + | Some v -> Some (rx,v)) + compiledList in + p.compiled <- if mode then Rx.case_insensitive compiled else compiled; + p.associated_strings <- strings; + p.last_pref <- pref; + p.last_def <- p.default; + p.last_mode <- mode + +let recompile_if_needed p = + let mode = Case.insensitive () in + if + p.last_mode <> mode || + p.last_pref != Prefs.read p.pref || + p.last_def != p.default + then + recompile mode p + +(********************************************************************) +(* IMPORT / EXPORT *) +(********************************************************************) + +let intern p regexpStringList = Prefs.set p.pref regexpStringList + +let extern p = Prefs.read p.pref + +let extern_associated_strings p = + recompile_if_needed p; + Safelist.map snd p.associated_strings + +(********************************************************************) +(* TESTING *) +(********************************************************************) + +let test p s = + recompile_if_needed p; + let res = Rx.match_string p.compiled (Case.normalize s) in + debug (fun() -> Util.msg "%s '%s' = %b\n" p.name s res); + res + +let assoc p s = + recompile_if_needed p; + snd (Safelist.find (fun (rx,v) -> Rx.match_string rx s) p.associated_strings) Deleted: branches/2.32/src/pred.mli =================================================================== --- trunk/src/pred.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/pred.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,60 +0,0 @@ -(* Unison file synchronizer: src/pred.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* Predicates over paths. - - General description: - - A predicate is determined by a list of default patterns and a list of - current patterns. These patterns can be modified by - [addDefaultPatterns] and [intern]. Function [test p s] tests whether - string [s] satisfies predicate [p], i.e., it matches a pattern of [p]. - - For efficiency, the list of patterns are compiled into a regular - expression. Function [test] compares the current value of default - patterns and current patterns against the save ones (recorded in - last_pref/last_def) to determine whether recompilation is necessary. - - Each pattern has the form - [ -> ] - The associated string is ignored by [test] but can be looked up by [assoc]. - - Three forms of / are recognized: - "Name ": ..../ (using globx) - "Path ": , not starting with "/" (using globx) - "Regex ": (using rx) -*) - - -type t - -(* Create a new predicate and register it with the preference module. The first - arg is the name of the predicate; the second is full (latex) documentation. *) -val create : string -> ?advanced:bool -> string -> t - -(* Check whether a given path matches one of the default or current patterns *) -val test : t -> string -> bool - -(* Return the associated string for the first matching pattern. Raise Not_found - if no pattern with an associated string matches. *) -val assoc : t -> string -> string - -(* Add list of default patterns to the existing list. (These patterns are - remembered even when the associated preference is cleared). *) -val addDefaultPatterns : t -> string list -> unit - -(* Install a new list of patterns, overriding the current list *) -val intern : t -> string list -> unit - -(* Return the current list of patterns *) -val extern : t -> string list - -(* Return the current list of associated strings *) -val extern_associated_strings : t -> string list - -(* Create an alternate name for a predicate (the new name will not appear - in usage messages or generated documentation) *) -val alias : t (* existing predicate *) - -> string (* new name *) - -> unit - Copied: branches/2.32/src/pred.mli (from rev 320, trunk/src/pred.mli) =================================================================== --- branches/2.32/src/pred.mli (rev 0) +++ branches/2.32/src/pred.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,60 @@ +(* Unison file synchronizer: src/pred.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +(* Predicates over paths. + + General description: + + A predicate is determined by a list of default patterns and a list of + current patterns. These patterns can be modified by + [addDefaultPatterns] and [intern]. Function [test p s] tests whether + string [s] satisfies predicate [p], i.e., it matches a pattern of [p]. + + For efficiency, the list of patterns are compiled into a regular + expression. Function [test] compares the current value of default + patterns and current patterns against the save ones (recorded in + last_pref/last_def) to determine whether recompilation is necessary. + + Each pattern has the form + [ -> ] + The associated string is ignored by [test] but can be looked up by [assoc]. + + Three forms of / are recognized: + "Name ": ..../ (using globx) + "Path ": , not starting with "/" (using globx) + "Regex ": (using rx) +*) + + +type t + +(* Create a new predicate and register it with the preference module. The first + arg is the name of the predicate; the second is full (latex) documentation. *) +val create : string -> ?advanced:bool -> string -> t + +(* Check whether a given path matches one of the default or current patterns *) +val test : t -> string -> bool + +(* Return the associated string for the first matching pattern. Raise Not_found + if no pattern with an associated string matches. *) +val assoc : t -> string -> string + +(* Add list of default patterns to the existing list. (These patterns are + remembered even when the associated preference is cleared). *) +val addDefaultPatterns : t -> string list -> unit + +(* Install a new list of patterns, overriding the current list *) +val intern : t -> string list -> unit + +(* Return the current list of patterns *) +val extern : t -> string list + +(* Return the current list of associated strings *) +val extern_associated_strings : t -> string list + +(* Create an alternate name for a predicate (the new name will not appear + in usage messages or generated documentation) *) +val alias : t (* existing predicate *) + -> string (* new name *) + -> unit + Deleted: branches/2.32/src/props.ml =================================================================== --- trunk/src/props.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/props.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,755 +0,0 @@ -(* Unison file synchronizer: src/props.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -let debug = Util.debug "props" - -module type S = sig - type t - val dummy : t - val hash : t -> int -> int - val similar : t -> t -> bool - val override : t -> t -> t - val strip : t -> t - val diff : t -> t -> t - val toString : t -> string - val syncedPartsToString : t -> string - val set : Fspath.t -> Path.local -> [`Set | `Update] -> t -> unit - val get : Unix.LargeFile.stats -> Osx.info -> t - val init : bool -> unit -end - -(* Nb: the syncedPartsToString call is only used for archive dumping, for *) -(* debugging purposes. It could be deleted without losing functionality. *) - -(**** Permissions ****) - -module Perm : sig - include S - val fileDefault : t - val fileSafe : t - val dirDefault : t - val extract : t -> int - val check : Fspath.t -> Path.local -> Unix.LargeFile.stats -> t -> unit -end = struct - -(* We introduce a type, Perm.t, that holds a file's permissions along with *) -(* the operating system where the file resides. Different operating systems *) -(* have different permission systems, so we have to take the OS into account *) -(* when comparing and setting permissions. We also need an "impossible" *) -(* permission that to take care of a tricky special case in update *) -(* detection. It can be that the archive contains a directory that has *) -(* never been synchronized, although some of its children have been. In *) -(* this case, the directory's permissions have never been synchronized and *) -(* might be different on the two replicas. We use NullPerm for the *) -(* permissions of such an archive entry, and ensure (in similarPerms) that *) -(* NullPerm is never similar to any real permission. *) - -(* NOTE: IF YOU CHANGE TYPE "PERM", THE ARCHIVE FORMAT CHANGES; INCREMENT *) -(* "UPDATE.ARCHIVEFORMAT" *) -type t = int * int - -(* This allows us to export NullPerm while keeping the type perm abstract *) -let dummy = (0, 0) - -let extract = fst - -let unix_mask = - 0o7777 (* All bits *) -let wind_mask = - 0o200 (* -w------- : only the write bit can be changed in Windows *) - -let permMask = - Prefs.createInt "perms" - (0o777 (* rwxrwxrwx *) + 0o1000 (* Sticky bit *)) - "part of the permissions which is synchronized" - "The integer value of this preference is a mask indicating which \ - permission bits should be synchronized. It is set by default to \ - $0o1777$: all bits but the set-uid and set-gid bits are \ - synchronised (synchronizing theses latter bits can be a security \ - hazard). If you want to synchronize all bits, you can set the \ - value of this preference to $-1$." - -(* Os-specific local conventions on file permissions *) -let (fileDefault, dirDefault, fileSafe, dirSafe) = - match Util.osType with - `Win32 -> - debug - (fun() -> - Util.msg "Using windows defaults for file permissions"); - ((0o600, -1), (* rw------- *) - (0o700, -1), (* rwx------ *) - (0o600, -1), (* rw------- *) - (0o700, -1)) (* rwx------ *) - | `Unix -> - let umask = - let u = Unix.umask 0 in - ignore (Unix.umask u); - debug - (fun() -> - Util.msg "Umask: %s" (Printf.sprintf "%o" u)); - (fun fp -> (lnot u) land fp) in - ((umask 0o666, -1), (* rw-rw-rw- *) - (umask 0o777, -1), (* rwxrwxrwx *) - (umask 0o600, -1), (* rw------- *) - (umask 0o700, -1)) (* rwx------ *) - -let hash (p, m) h = Uutil.hash2 (p land m) (Uutil.hash2 m h) - -let perm2fileperm (p, m) = p -let fileperm2perm p = (p, Prefs.read permMask) - -(* Are two perms similar (for update detection and recon) *) -let similar (p1, m1) (p2, m2) = - let m = Prefs.read permMask in - m1 land m = m && m2 land m = m && - p1 land m = p2 land m - -(* overrideCommonPermsIn p1 p2 : gives the perm that would result from *) -(* propagating p2 to p1. We expect the following invariants: similarPerms *) -(* (overrideCommonPermsIn p1 p2) p2 (whenever similarPerms p2 p2) and *) -(* hashPerm (overrideCommonPermsIn p1 p2) = hashPerm p2 *) -let override (p1, m1) (p2, m2) = - let m = Prefs.read permMask land m2 in - ((p1 land (lnot m)) lor (p2 land m), m) - -let strip (p, m) = (p, m land (Prefs.read permMask)) - -let diff (p, m) (p', m') = (p', (p lxor p') land m land m') - -let toString = - function - (_, 0) -> "unknown permissions" - | (fp, _) when Prefs.read permMask = wind_mask -> - if fp land wind_mask <> 0 then "read-write" else "read-only" - | (fp, _) -> - let m = Prefs.read permMask in - let bit mb unknown off on = - if mb land m = 0 then - unknown - else if fp land mb <> 0 then - on - else - off - in - bit 0o1000 "" "" "t" ^ - bit 0o0400 "?" "-" "r" ^ - bit 0o0200 "?" "-" "w" ^ - bit 0o0100 "?" "-" "x" ^ - bit 0o0040 "?" "-" "r" ^ - bit 0o0020 "?" "-" "w" ^ - bit 0o0010 "?" "-" "x" ^ - bit 0o0004 "?" "-" "r" ^ - bit 0o0002 "?" "-" "w" ^ - bit 0o0001 "?" "-" "x" - -let syncedPartsToString = - function - (_, 0) -> "unknown permissions" - | (fp, m) -> - let bit mb unknown off on = - if mb land m = 0 then - unknown - else if fp land mb <> 0 then - on - else - off - in - bit 0o1000 "" "" "t" ^ - bit 0o0400 "?" "-" "r" ^ - bit 0o0200 "?" "-" "w" ^ - bit 0o0100 "?" "-" "x" ^ - bit 0o0040 "?" "-" "r" ^ - bit 0o0020 "?" "-" "w" ^ - bit 0o0010 "?" "-" "x" ^ - bit 0o0004 "?" "-" "r" ^ - bit 0o0002 "?" "-" "w" ^ - bit 0o0001 "?" "-" "x" - -let dontChmod = - Prefs.createBool "dontchmod" - false - "!When set, never use the chmod system call" - ("By default, Unison uses the 'chmod' system call to set the permission bits" - ^ " of files after it has copied them. But in some circumstances (and under " - ^ " some operating systems), the chmod call always fails. Setting this " - ^ " preference completely prevents Unison from ever calling chmod.") - -let set fspath path kind (fp, mask) = - (* BCP: removed "|| kind <> `Update" on 10/2005, but reinserted it on 11/2008. - I'd removed it to make Dale Worley happy -- he wanted a way to make sure that - Unison would never call chmod, and setting prefs to 0 seemed like a reasonable - way to do this. But in fact it caused new files to be created with wrong prefs. - *) - if (mask <> 0 || kind = `Set) && (not (Prefs.read dontChmod)) then - Util.convertUnixErrorsToTransient - "setting permissions" - (fun () -> - let abspath = Fspath.concatToString fspath path in - debug - (fun() -> - Util.msg "Setting permissions for %s to %s (%s)\n" - abspath (toString (fileperm2perm fp)) - (Printf.sprintf "%o/%o" fp mask)); - Unix.chmod abspath fp) - -let get stats _ = (stats.Unix.LargeFile.st_perm, Prefs.read permMask) - -let check fspath path stats (fp, mask) = - let fp' = stats.Unix.LargeFile.st_perm in - if fp land mask <> fp' land mask then - raise - (Util.Transient - (Format.sprintf - "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 \ - (or to 0 if you don't need to synchronize permissions)." - (Fspath.concatToString fspath path) - (syncedPartsToString (fp, mask)) - (syncedPartsToString (fp', mask)) - (mask land (lnot (fp lxor fp'))))) - -let init someHostIsRunningWindows = - let mask = if someHostIsRunningWindows then wind_mask else unix_mask in - let oldMask = Prefs.read permMask in - let newMask = oldMask land mask in - debug - (fun() -> - Util.msg "Setting permission mask to %s (%s and %s)\n" - (Printf.sprintf "%o" newMask) - (Printf.sprintf "%o" oldMask) - (Printf.sprintf "%o" mask)); - Prefs.set permMask newMask - -end - -(* ------------------------------------------------------------------------- *) -(* User and group ids *) -(* ------------------------------------------------------------------------- *) - -let numericIds = - Prefs.createBool "numericids" false - "!don't map uid/gid values by user/group names" - "When this flag is set to \\verb|true|, groups and users are \ - synchronized numerically, rather than by name. \n\ - \n\ - The special uid 0 and the special group 0 are never mapped via \ - user/group names even if this preference is not set." - -(* For backward compatibility *) -let _ = Prefs.alias numericIds "numericIds" - -module Id (M : sig - val sync : bool Prefs.t - val kind : string - val to_num : string -> int - val toString : int -> string - val syncedPartsToString : int -> string - val set : string -> int -> unit - val get : Unix.LargeFile.stats -> int -end) : S = struct - -type t = - IdIgnored - | IdNamed of string - | IdNumeric of int - -let dummy = IdIgnored - -let hash id h = - Uutil.hash2 - (match id with - IdIgnored -> -1 - | IdNumeric i -> i - | IdNamed nm -> Hashtbl.hash nm) - h - -let similar id id' = - not (Prefs.read M.sync) - || - (id <> IdIgnored && id' <> IdIgnored && id = id') - -let override id id' = id' - -let strip id = if Prefs.read M.sync then id else IdIgnored - -let diff id id' = if similar id id' then IdIgnored else id' - -let toString id = - match id with - IdIgnored -> "" - | IdNumeric i -> " " ^ M.kind ^ "=" ^ string_of_int i - | IdNamed n -> " " ^ M.kind ^ "=" ^ n - -let syncedPartsToString = toString - -let tbl = Hashtbl.create 17 - -let extern id = - match id with - IdIgnored -> -1 - | IdNumeric i -> i - | IdNamed nm -> - try - Hashtbl.find tbl nm - with Not_found -> - let id = - try M.to_num nm with Not_found -> - raise (Util.Transient ("No " ^ M.kind ^ " " ^ nm)) - in - if id = 0 then - raise (Util.Transient - (Printf.sprintf "Trying to map the non-root %s %s to %s 0" - M.kind nm M.kind)); - Hashtbl.add tbl nm id; - id - -let set fspath path kind id = - match extern id with - -1 -> - () - | id -> - Util.convertUnixErrorsToTransient - "setting file ownership" - (fun () -> - let abspath = Fspath.concatToString fspath path in - M.set abspath id) - -let tbl = Hashtbl.create 17 - -let get stats _ = - if not (Prefs.read M.sync) then IdIgnored else - let id = M.get stats in - if id = 0 || Prefs.read numericIds then IdNumeric id else - try - Hashtbl.find tbl id - with Not_found -> - let id' = try IdNamed (M.toString id) with Not_found -> IdNumeric id in - Hashtbl.add tbl id id'; - id' - -let init someHostIsRunningWindows = - if someHostIsRunningWindows then - Prefs.set M.sync false; - -end - -module Uid = Id (struct - -let sync = - Prefs.createBool "owner" - false "synchronize owner" - ("When this flag is set to \\verb|true|, the owner attributes " - ^ "of the files are synchronized. " - ^ "Whether the owner names or the owner identifiers are synchronized" - ^ "depends on the preference \texttt{numerids}.") - -let kind = "user" - -let to_num nm = (Unix.getpwnam nm).Unix.pw_uid -let toString id = (Unix.getpwuid id).Unix.pw_name -let syncedPartsToString = toString - -let set path id = Unix.chown path id (-1) -let get stats = stats.Unix.LargeFile.st_uid - -end) - -module Gid = Id (struct - -let sync = - Prefs.createBool "group" - false "synchronize group attributes" - ("When this flag is set to \\verb|true|, the group attributes " - ^ "of the files are synchronized. " - ^ "Whether the group names or the group identifiers are synchronized" - ^ "depends on the preference \\texttt{numerids}.") - -let kind = "group" - -let to_num nm = (Unix.getgrnam nm).Unix.gr_gid -let toString id = (Unix.getgrgid id).Unix.gr_name -let syncedPartsToString = toString - -let set path id = Unix.chown path (-1) id -let get stats = stats.Unix.LargeFile.st_gid - -end) - -(* ------------------------------------------------------------------------- *) -(* Modification time *) -(* ------------------------------------------------------------------------- *) - -module Time : sig - include S - val same : t -> t -> bool - val extract : t -> float - val sync : bool Prefs.t - val replace : t -> float -> t - val check : Fspath.t -> Path.local -> Unix.LargeFile.stats -> t -> unit -end = struct - -let sync = - Prefs.createBool "times" - false "synchronize modification times" - "When this flag is set to \\verb|true|, \ - file modification times (but not directory modtimes) are propagated." - -type t = Synced of float | NotSynced of float - -let dummy = NotSynced 0. - -let extract t = match t with Synced v -> v | NotSynced v -> v - -let minus_two = Int64.of_int (-2) -let approximate t = Int64.logand (Int64.of_float t) minus_two - -let oneHour = Int64.of_int 3600 -let minusOneHour = Int64.neg oneHour -let moduloOneHour t = - let v = Int64.rem t oneHour in - if v >= Int64.zero then v else Int64.add v oneHour - -let hash t h = - Uutil.hash2 - (match t with - Synced f -> Hashtbl.hash (moduloOneHour (approximate f)) - | NotSynced _ -> 0) - h - -let similar t t' = - not (Prefs.read sync) - || - match t, t' with - Synced v, Synced v' -> - let delta = Int64.sub (approximate v) (approximate v') in - delta = Int64.zero || delta = oneHour || delta = minusOneHour - | NotSynced _, NotSynced _ -> - true - | _ -> - false - -(* Accept one hour differences and one second differences *) -let possible_deltas = - [ -3601L; 3601L; -3600L; 3600L; -3599L; 3599L; -1L; 1L; 0L ] - -(* FIX: this is the right similar function (dates are approximated - on FAT filesystems upward under Windows, downward under Linux). - The hash function needs to be updated as well *) -let similar_correct t t' = - not (Prefs.read sync) - || - match t, t' with - Synced v, Synced v' -> - List.mem (Int64.sub (Int64.of_float v) (Int64.of_float v')) - possible_deltas - | NotSynced _, NotSynced _ -> - true - | _ -> - false - -let override t t' = - match t, t' with - _, Synced _ -> t' - | Synced v, _ -> NotSynced v - | _ -> t - -let replace t v = - match t with - Synced _ -> t - | NotSynced _ -> NotSynced v - -let strip t = - match t with - Synced v when not (Prefs.read sync) -> NotSynced v - | _ -> t - -let diff t t' = if similar t t' then NotSynced (extract t') else t' - -let toString t = Util.time2string (extract t) - -let syncedPartsToString t = match t with - Synced _ -> toString t -| NotSynced _ -> "" - -let iCanWrite p = - try - Unix.access p [Unix.W_OK]; - true - with - Unix.Unix_error _ -> false - -(* FIX: Probably there should be a check here that prevents us from ever *) -(* setting a file's modtime into the future. *) -let set fspath path kind t = - match t with - Synced v -> - Util.convertUnixErrorsToTransient - "setting modification time" - (fun () -> - let abspath = Fspath.concatToString fspath path in - if Util.osType = `Win32 && not (iCanWrite abspath) then - begin - (* Nb. This workaround was proposed by Dmitry Bely, to - work around the fact that Unix.utimes fails on readonly - files under windows. I'm [bcp] a little bit uncomfortable - with it for two reasons: (1) if we crash in the middle, - the permissions might be left in a bad state, and (2) I - don't understand the Win32 permissions model enough to - know whether it will always work -- e.g., what if the - UID of the unison process is not the same as that of the - file itself (under Unix, this case would fail, but we - certainly don't want to make it WORLD-writable, even - briefly!). *) - let oldPerms = - (Unix.LargeFile.lstat abspath).Unix.LargeFile.st_perm in - Util.finalize - (fun()-> - Unix.chmod abspath 0o600; - Unix.utimes abspath v v) - (fun()-> Unix.chmod abspath oldPerms) - end - else if false then begin - (* A special hack for Rasmus, who has a special situation that - requires the utimes-setting program to run 'setuid root' - (and we do not want all of Unison to run setuid, so we just - spin off an external utility to do it). *) - let time = Unix.localtime v in - let tstr = Printf.sprintf - "%4d%02d%02d%02d%02d.%02d" - (time.Unix.tm_year + 1900) - (time.Unix.tm_mon + 1) - time.Unix.tm_mday - time.Unix.tm_hour - time.Unix.tm_min - time.Unix.tm_sec in - let cmd = "/usr/local/bin/sudo -u root /usr/bin/touch -m -a -t " - ^ tstr ^ " '" ^ abspath ^ "'" in - Util.msg "Running external program to set utimes:\n %s\n" cmd; - let (r,_) = External.runExternalProgram cmd in - if r<>(Unix.WEXITED 0) then raise (Util.Transient "External time-setting command failed") - end else - Unix.utimes abspath v v) - | _ -> - () - -let get stats _ = - let v = stats.Unix.LargeFile.st_mtime in - if stats.Unix.LargeFile.st_kind = Unix.S_REG && Prefs.read sync then - Synced v - else - NotSynced v - -let check fspath path stats t = - match t with - NotSynced _ -> - () - | Synced v -> - let t' = Synced (stats.Unix.LargeFile.st_mtime) in - if not (similar_correct t t') then - raise - (Util.Transient - (Format.sprintf - "Failed to set modification time of file %s to %s: \ - the time was set to %s instead" - (Fspath.concatToString fspath path) - (syncedPartsToString t) - (syncedPartsToString t'))) - -(* When modification time are synchronized, we cannot update the - archive when they are changed due to daylight saving time. Thus, - we have to compare then using "similar". *) -let same p p' = - match p, p' with - Synced _, Synced _ -> - similar p p' - | _ -> - let delta = extract p -. extract p' in - delta = 0. || delta = 3600. || delta = -3600. - -let init _ = () - -end - -(* ------------------------------------------------------------------------- *) -(* Type and creator *) -(* ------------------------------------------------------------------------- *) - -module TypeCreator : S = struct - -type t = string option - -let dummy = None - -let hash t h = Uutil.hash2 (Hashtbl.hash t) h - -let similar t t' = - not (Prefs.read Osx.rsrc) || t = t' - -let override t t' = t' - -let strip t = t - -let diff t t' = if similar t t' then None else t' - -let zeroes = "\000\000\000\000\000\000\000\000" - -let toString t = - match t with - Some s when s.[0] = 'F' && String.sub (s ^ zeroes) 1 8 <> zeroes -> - let s = s ^ zeroes in - " " ^ String.escaped (String.sub s 1 4) ^ - " " ^ String.escaped (String.sub s 5 4) - | _ -> - "" - -let syncedPartsToString = toString - -let set fspath path kind t = - match t with - None -> () - | Some t -> Osx.setFileInfos fspath path t - -let get stats info = - if - Prefs.read Osx.rsrc && - (stats.Unix.LargeFile.st_kind = Unix.S_REG || - stats.Unix.LargeFile.st_kind = Unix.S_DIR) - then - Some info.Osx.finfo - else - None - -let init _ = () - -end - -(* ------------------------------------------------------------------------- *) -(* Properties *) -(* ------------------------------------------------------------------------- *) - -type t = - { perm : Perm.t; - uid : Uid.t; - gid : Gid.t; - time : Time.t; - typeCreator : TypeCreator.t; - length : Uutil.Filesize.t } - -let template perm = - { perm = perm; uid = Uid.dummy; gid = Gid.dummy; - time = Time.dummy; typeCreator = TypeCreator.dummy; - length = Uutil.Filesize.dummy } - -let dummy = template Perm.dummy - -let hash p h = - Perm.hash p.perm - (Uid.hash p.uid - (Gid.hash p.gid - (Time.hash p.time - (TypeCreator.hash p.typeCreator h)))) - -let similar p p' = - Perm.similar p.perm p'.perm - && - Uid.similar p.uid p'.uid - && - Gid.similar p.gid p'.gid - && - Time.similar p.time p'.time - && - TypeCreator.similar p.typeCreator p'.typeCreator - -let override p p' = - { perm = Perm.override p.perm p'.perm; - uid = Uid.override p.uid p'.uid; - gid = Gid.override p.gid p'.gid; - time = Time.override p.time p'.time; - typeCreator = TypeCreator.override p.typeCreator p'.typeCreator; - length = p'.length } - -let strip p = - { perm = Perm.strip p.perm; - uid = Uid.strip p.uid; - gid = Gid.strip p.gid; - time = Time.strip p.time; - typeCreator = TypeCreator.strip p.typeCreator; - length = p.length } - -let toString p = - Printf.sprintf - "modified on %s size %-9.f %s%s%s%s" - (Time.toString p.time) - (Uutil.Filesize.toFloat p.length) - (Perm.toString p.perm) - (Uid.toString p.uid) - (Gid.toString p.gid) - (TypeCreator.toString p.typeCreator) - -let syncedPartsToString p = - let tm = Time.syncedPartsToString p.time in - Printf.sprintf - "%s%s size %-9.f %s%s%s%s" - (if tm = "" then "" else "modified at ") - tm - (Uutil.Filesize.toFloat p.length) - (Perm.syncedPartsToString p.perm) - (Uid.syncedPartsToString p.uid) - (Gid.syncedPartsToString p.gid) - (TypeCreator.syncedPartsToString p.typeCreator) - -let diff p p' = - { perm = Perm.diff p.perm p'.perm; - uid = Uid.diff p.uid p'.uid; - gid = Gid.diff p.gid p'.gid; - time = Time.diff p.time p'.time; - typeCreator = TypeCreator.diff p.typeCreator p'.typeCreator; - length = p'.length } - -let get stats infos = - { perm = Perm.get stats infos; - uid = Uid.get stats infos; - gid = Gid.get stats infos; - time = Time.get stats infos; - typeCreator = TypeCreator.get stats infos; - length = - if stats.Unix.LargeFile.st_kind = Unix.S_REG then - Uutil.Filesize.fromStats stats - else - Uutil.Filesize.zero } - -let set fspath path kind p = - Uid.set fspath path kind p.uid; - Gid.set fspath path kind p.gid; - TypeCreator.set fspath path kind p.typeCreator; - Time.set fspath path kind p.time; - Perm.set fspath path kind p.perm - -(* Paranoid checks *) -let check fspath path stats p = - Time.check fspath path stats p.time; - Perm.check fspath path stats p.perm - -let init someHostIsRunningWindows = - Perm.init someHostIsRunningWindows; - Uid.init someHostIsRunningWindows; - Gid.init someHostIsRunningWindows; - Time.init someHostIsRunningWindows; - TypeCreator.init someHostIsRunningWindows - -let fileDefault = template Perm.fileDefault -let fileSafe = template Perm.fileSafe -let dirDefault = template Perm.dirDefault - -let same_time p p' = Time.same p.time p'.time -let length p = p.length -let setLength p l = {p with length=l} - -let time p = Time.extract p.time -let setTime p t = {p with time = Time.replace p.time t} - -let perms p = Perm.extract p.perm - -let syncModtimes = Time.sync Copied: branches/2.32/src/props.ml (from rev 320, trunk/src/props.ml) =================================================================== --- branches/2.32/src/props.ml (rev 0) +++ branches/2.32/src/props.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,770 @@ +(* Unison file synchronizer: src/props.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +let debug = Util.debug "props" + +module type S = sig + type t + val dummy : t + val hash : t -> int -> int + val similar : t -> t -> bool + val override : t -> t -> t + val strip : t -> t + val diff : t -> t -> t + val toString : t -> string + val syncedPartsToString : t -> string + val set : Fspath.t -> Path.local -> [`Set | `Update] -> t -> unit + val get : Unix.LargeFile.stats -> Osx.info -> t + val init : bool -> unit +end + +(* Nb: the syncedPartsToString call is only used for archive dumping, for *) +(* debugging purposes. It could be deleted without losing functionality. *) + +(**** Permissions ****) + +module Perm : sig + include S + val fileDefault : t + val fileSafe : t + val dirDefault : t + val extract : t -> int + val check : Fspath.t -> Path.local -> Unix.LargeFile.stats -> t -> unit +end = struct + +(* We introduce a type, Perm.t, that holds a file's permissions along with *) +(* the operating system where the file resides. Different operating systems *) +(* have different permission systems, so we have to take the OS into account *) +(* when comparing and setting permissions. We also need an "impossible" *) +(* permission that to take care of a tricky special case in update *) +(* detection. It can be that the archive contains a directory that has *) +(* never been synchronized, although some of its children have been. In *) +(* this case, the directory's permissions have never been synchronized and *) +(* might be different on the two replicas. We use NullPerm for the *) +(* permissions of such an archive entry, and ensure (in similarPerms) that *) +(* NullPerm is never similar to any real permission. *) + +(* NOTE: IF YOU CHANGE TYPE "PERM", THE ARCHIVE FORMAT CHANGES; INCREMENT *) +(* "UPDATE.ARCHIVEFORMAT" *) +type t = int * int + +(* This allows us to export NullPerm while keeping the type perm abstract *) +let dummy = (0, 0) + +let extract = fst + +let unix_mask = + 0o7777 (* All bits *) +let wind_mask = + 0o200 (* -w------- : only the write bit can be changed in Windows *) + +let permMask = + Prefs.createInt "perms" + (0o777 (* rwxrwxrwx *) + 0o1000 (* Sticky bit *)) + "part of the permissions which is synchronized" + "The integer value of this preference is a mask indicating which \ + permission bits should be synchronized. It is set by default to \ + $0o1777$: all bits but the set-uid and set-gid bits are \ + synchronised (synchronizing theses latter bits can be a security \ + hazard). If you want to synchronize all bits, you can set the \ + value of this preference to $-1$." + +(* Os-specific local conventions on file permissions *) +let (fileDefault, dirDefault, fileSafe, dirSafe) = + match Util.osType with + `Win32 -> + debug + (fun() -> + Util.msg "Using windows defaults for file permissions"); + ((0o600, -1), (* rw------- *) + (0o700, -1), (* rwx------ *) + (0o600, -1), (* rw------- *) + (0o700, -1)) (* rwx------ *) + | `Unix -> + let umask = + let u = Unix.umask 0 in + ignore (Unix.umask u); + debug + (fun() -> + Util.msg "Umask: %s" (Printf.sprintf "%o" u)); + (fun fp -> (lnot u) land fp) in + ((umask 0o666, -1), (* rw-rw-rw- *) + (umask 0o777, -1), (* rwxrwxrwx *) + (umask 0o600, -1), (* rw------- *) + (umask 0o700, -1)) (* rwx------ *) + +let hash (p, m) h = Uutil.hash2 (p land m) (Uutil.hash2 m h) + +let perm2fileperm (p, m) = p +let fileperm2perm p = (p, Prefs.read permMask) + +(* Are two perms similar (for update detection and recon) *) +let similar (p1, m1) (p2, m2) = + let m = Prefs.read permMask in + m1 land m = m && m2 land m = m && + p1 land m = p2 land m + +(* overrideCommonPermsIn p1 p2 : gives the perm that would result from *) +(* propagating p2 to p1. We expect the following invariants: similarPerms *) +(* (overrideCommonPermsIn p1 p2) p2 (whenever similarPerms p2 p2) and *) +(* hashPerm (overrideCommonPermsIn p1 p2) = hashPerm p2 *) +let override (p1, m1) (p2, m2) = + let m = Prefs.read permMask land m2 in + ((p1 land (lnot m)) lor (p2 land m), m) + +let strip (p, m) = (p, m land (Prefs.read permMask)) + +let diff (p, m) (p', m') = (p', (p lxor p') land m land m') + +let toString = + function + (_, 0) -> "unknown permissions" + | (fp, _) when Prefs.read permMask = wind_mask -> + if fp land wind_mask <> 0 then "read-write" else "read-only" + | (fp, _) -> + let m = Prefs.read permMask in + let bit mb unknown off on = + if mb land m = 0 then + unknown + else if fp land mb <> 0 then + on + else + off + in + bit 0o1000 "" "" "t" ^ + bit 0o0400 "?" "-" "r" ^ + bit 0o0200 "?" "-" "w" ^ + bit 0o0100 "?" "-" "x" ^ + bit 0o0040 "?" "-" "r" ^ + bit 0o0020 "?" "-" "w" ^ + bit 0o0010 "?" "-" "x" ^ + bit 0o0004 "?" "-" "r" ^ + bit 0o0002 "?" "-" "w" ^ + bit 0o0001 "?" "-" "x" + +let syncedPartsToString = + function + (_, 0) -> "unknown permissions" + | (fp, m) -> + let bit mb unknown off on = + if mb land m = 0 then + unknown + else if fp land mb <> 0 then + on + else + off + in + bit 0o1000 "" "" "t" ^ + bit 0o0400 "?" "-" "r" ^ + bit 0o0200 "?" "-" "w" ^ + bit 0o0100 "?" "-" "x" ^ + bit 0o0040 "?" "-" "r" ^ + bit 0o0020 "?" "-" "w" ^ + bit 0o0010 "?" "-" "x" ^ + bit 0o0004 "?" "-" "r" ^ + bit 0o0002 "?" "-" "w" ^ + bit 0o0001 "?" "-" "x" + +let dontChmod = + Prefs.createBool "dontchmod" + false + "!When set, never use the chmod system call" + ("By default, Unison uses the 'chmod' system call to set the permission bits" + ^ " of files after it has copied them. But in some circumstances (and under " + ^ " some operating systems), the chmod call always fails. Setting this " + ^ " preference completely prevents Unison from ever calling chmod.") + +let set fspath path kind (fp, mask) = + (* BCP: removed "|| kind <> `Update" on 10/2005, but reinserted it on 11/2008. + I'd removed it to make Dale Worley happy -- he wanted a way to make sure that + Unison would never call chmod, and setting prefs to 0 seemed like a reasonable + way to do this. But in fact it caused new files to be created with wrong prefs. + *) + if (mask <> 0 || kind = `Set) && (not (Prefs.read dontChmod)) then + Util.convertUnixErrorsToTransient + "setting permissions" + (fun () -> + let abspath = Fspath.concatToString fspath path in + debug + (fun() -> + Util.msg "Setting permissions for %s to %s (%s)\n" + abspath (toString (fileperm2perm fp)) + (Printf.sprintf "%o/%o" fp mask)); + Unix.chmod abspath fp) + +let get stats _ = (stats.Unix.LargeFile.st_perm, Prefs.read permMask) + +let check fspath path stats (fp, mask) = + let fp' = stats.Unix.LargeFile.st_perm in + if fp land mask <> fp' land mask then + raise + (Util.Transient + (Format.sprintf + "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 \ + (or to 0 if you don't need to synchronize permissions)." + (Fspath.concatToString fspath path) + (syncedPartsToString (fp, mask)) + (syncedPartsToString (fp', mask)) + (mask land (lnot (fp lxor fp'))))) + +let init someHostIsRunningWindows = + let mask = if someHostIsRunningWindows then wind_mask else unix_mask in + let oldMask = Prefs.read permMask in + let newMask = oldMask land mask in + debug + (fun() -> + Util.msg "Setting permission mask to %s (%s and %s)\n" + (Printf.sprintf "%o" newMask) + (Printf.sprintf "%o" oldMask) + (Printf.sprintf "%o" mask)); + Prefs.set permMask newMask + +end + +(* ------------------------------------------------------------------------- *) +(* User and group ids *) +(* ------------------------------------------------------------------------- *) + +let numericIds = + Prefs.createBool "numericids" false + "!don't map uid/gid values by user/group names" + "When this flag is set to \\verb|true|, groups and users are \ + synchronized numerically, rather than by name. \n\ + \n\ + The special uid 0 and the special group 0 are never mapped via \ + user/group names even if this preference is not set." + +(* For backward compatibility *) +let _ = Prefs.alias numericIds "numericIds" + +module Id (M : sig + val sync : bool Prefs.t + val kind : string + val to_num : string -> int + val toString : int -> string + val syncedPartsToString : int -> string + val set : string -> int -> unit + val get : Unix.LargeFile.stats -> int +end) : S = struct + +type t = + IdIgnored + | IdNamed of string + | IdNumeric of int + +let dummy = IdIgnored + +let hash id h = + Uutil.hash2 + (match id with + IdIgnored -> -1 + | IdNumeric i -> i + | IdNamed nm -> Hashtbl.hash nm) + h + +let similar id id' = + not (Prefs.read M.sync) + || + (id <> IdIgnored && id' <> IdIgnored && id = id') + +let override id id' = id' + +let strip id = if Prefs.read M.sync then id else IdIgnored + +let diff id id' = if similar id id' then IdIgnored else id' + +let toString id = + match id with + IdIgnored -> "" + | IdNumeric i -> " " ^ M.kind ^ "=" ^ string_of_int i + | IdNamed n -> " " ^ M.kind ^ "=" ^ n + +let syncedPartsToString = toString + +let tbl = Hashtbl.create 17 + +let extern id = + match id with + IdIgnored -> -1 + | IdNumeric i -> i + | IdNamed nm -> + try + Hashtbl.find tbl nm + with Not_found -> + let id = + try M.to_num nm with Not_found -> + raise (Util.Transient ("No " ^ M.kind ^ " " ^ nm)) + in + if id = 0 then + raise (Util.Transient + (Printf.sprintf "Trying to map the non-root %s %s to %s 0" + M.kind nm M.kind)); + Hashtbl.add tbl nm id; + id + +let set fspath path kind id = + match extern id with + -1 -> + () + | id -> + Util.convertUnixErrorsToTransient + "setting file ownership" + (fun () -> + let abspath = Fspath.concatToString fspath path in + M.set abspath id) + +let tbl = Hashtbl.create 17 + +let get stats _ = + if not (Prefs.read M.sync) then IdIgnored else + let id = M.get stats in + if id = 0 || Prefs.read numericIds then IdNumeric id else + try + Hashtbl.find tbl id + with Not_found -> + let id' = try IdNamed (M.toString id) with Not_found -> IdNumeric id in + Hashtbl.add tbl id id'; + id' + +let init someHostIsRunningWindows = + if someHostIsRunningWindows then + Prefs.set M.sync false; + +end + +module Uid = Id (struct + +let sync = + Prefs.createBool "owner" + false "synchronize owner" + ("When this flag is set to \\verb|true|, the owner attributes " + ^ "of the files are synchronized. " + ^ "Whether the owner names or the owner identifiers are synchronized" + ^ "depends on the preference \texttt{numerids}.") + +let kind = "user" + +let to_num nm = (Unix.getpwnam nm).Unix.pw_uid +let toString id = (Unix.getpwuid id).Unix.pw_name +let syncedPartsToString = toString + +let set path id = Unix.chown path id (-1) +let get stats = stats.Unix.LargeFile.st_uid + +end) + +module Gid = Id (struct + +let sync = + Prefs.createBool "group" + false "synchronize group attributes" + ("When this flag is set to \\verb|true|, the group attributes " + ^ "of the files are synchronized. " + ^ "Whether the group names or the group identifiers are synchronized" + ^ "depends on the preference \\texttt{numerids}.") + +let kind = "group" + +let to_num nm = (Unix.getgrnam nm).Unix.gr_gid +let toString id = (Unix.getgrgid id).Unix.gr_name +let syncedPartsToString = toString + +let set path id = Unix.chown path (-1) id +let get stats = stats.Unix.LargeFile.st_gid + +end) + +(* ------------------------------------------------------------------------- *) +(* Modification time *) +(* ------------------------------------------------------------------------- *) + +module Time : sig + include S + val same : t -> t -> bool + val extract : t -> float + val sync : bool Prefs.t + val replace : t -> float -> t + val check : Fspath.t -> Path.local -> Unix.LargeFile.stats -> t -> unit +end = struct + +let sync = + Prefs.createBool "times" + false "synchronize modification times" + "When this flag is set to \\verb|true|, \ + file modification times (but not directory modtimes) are propagated." + +type t = Synced of float | NotSynced of float + +let dummy = NotSynced 0. + +let extract t = match t with Synced v -> v | NotSynced v -> v + +let minus_two = Int64.of_int (-2) +let approximate t = Int64.logand (Int64.of_float t) minus_two + +let oneHour = Int64.of_int 3600 +let minusOneHour = Int64.neg oneHour +let moduloOneHour t = + let v = Int64.rem t oneHour in + if v >= Int64.zero then v else Int64.add v oneHour + +let hash t h = + Uutil.hash2 + (match t with + Synced f -> Hashtbl.hash (moduloOneHour (approximate f)) + | NotSynced _ -> 0) + h + +let similar t t' = + not (Prefs.read sync) + || + match t, t' with + Synced v, Synced v' -> + let delta = Int64.sub (approximate v) (approximate v') in + delta = Int64.zero || delta = oneHour || delta = minusOneHour + | NotSynced _, NotSynced _ -> + true + | _ -> + false + +(* Accept one hour differences and one second differences *) +let possible_deltas = + [ -3601L; 3601L; -3600L; 3600L; -3599L; 3599L; -1L; 1L; 0L ] + +(* FIX: this is the right similar function (dates are approximated + on FAT filesystems upward under Windows, downward under Linux). + The hash function needs to be updated as well *) +let similar_correct t t' = + not (Prefs.read sync) + || + match t, t' with + Synced v, Synced v' -> + List.mem (Int64.sub (Int64.of_float v) (Int64.of_float v')) + possible_deltas + | NotSynced _, NotSynced _ -> + true + | _ -> + false + +let override t t' = + match t, t' with + _, Synced _ -> t' + | Synced v, _ -> NotSynced v + | _ -> t + +let replace t v = + match t with + Synced _ -> t + | NotSynced _ -> NotSynced v + +let strip t = + match t with + Synced v when not (Prefs.read sync) -> NotSynced v + | _ -> t + +let diff t t' = if similar t t' then NotSynced (extract t') else t' + +let toString t = Util.time2string (extract t) + +let syncedPartsToString t = match t with + Synced _ -> toString t +| NotSynced _ -> "" + +let iCanWrite p = + try + Unix.access p [Unix.W_OK]; + true + with + Unix.Unix_error _ -> false + +(* FIX: Probably there should be a check here that prevents us from ever *) +(* setting a file's modtime into the future. *) +let set fspath path kind t = + match t with + Synced v -> + Util.convertUnixErrorsToTransient + "setting modification time" + (fun () -> + let abspath = Fspath.concatToString fspath path in + if Util.osType = `Win32 && not (iCanWrite abspath) then + begin + (* Nb. This workaround was proposed by Dmitry Bely, to + work around the fact that Unix.utimes fails on readonly + files under windows. I'm [bcp] a little bit uncomfortable + with it for two reasons: (1) if we crash in the middle, + the permissions might be left in a bad state, and (2) I + don't understand the Win32 permissions model enough to + know whether it will always work -- e.g., what if the + UID of the unison process is not the same as that of the + file itself (under Unix, this case would fail, but we + certainly don't want to make it WORLD-writable, even + briefly!). *) + let oldPerms = + (Unix.LargeFile.lstat abspath).Unix.LargeFile.st_perm in + Util.finalize + (fun()-> + Unix.chmod abspath 0o600; + Unix.utimes abspath v v) + (fun()-> Unix.chmod abspath oldPerms) + end + else if false then begin + (* A special hack for Rasmus, who has a special situation that + requires the utimes-setting program to run 'setuid root' + (and we do not want all of Unison to run setuid, so we just + spin off an external utility to do it). *) + let time = Unix.localtime v in + let tstr = Printf.sprintf + "%4d%02d%02d%02d%02d.%02d" + (time.Unix.tm_year + 1900) + (time.Unix.tm_mon + 1) + time.Unix.tm_mday + time.Unix.tm_hour + time.Unix.tm_min + time.Unix.tm_sec in + let cmd = "/usr/local/bin/sudo -u root /usr/bin/touch -m -a -t " + ^ tstr ^ " '" ^ abspath ^ "'" in + Util.msg "Running external program to set utimes:\n %s\n" cmd; + let (r,_) = External.runExternalProgram cmd in + if r<>(Unix.WEXITED 0) then raise (Util.Transient "External time-setting command failed") + end else + Unix.utimes abspath v v) + | _ -> + () + +let get stats _ = + let v = stats.Unix.LargeFile.st_mtime in + if stats.Unix.LargeFile.st_kind = Unix.S_REG && Prefs.read sync then + Synced v + else + NotSynced v + +let check fspath path stats t = + match t with + NotSynced _ -> + () + | Synced v -> + let t' = Synced (stats.Unix.LargeFile.st_mtime) in + if not (similar_correct t t') then + raise + (Util.Transient + (Format.sprintf + "Failed to set modification time of file %s to %s: \ + the time was set to %s instead" + (Fspath.concatToString fspath path) + (syncedPartsToString t) + (syncedPartsToString t'))) + +(* When modification time are synchronized, we cannot update the + archive when they are changed due to daylight saving time. Thus, + we have to compare then using "similar". *) +let same p p' = + match p, p' with + Synced _, Synced _ -> + similar p p' + | _ -> + let delta = extract p -. extract p' in + delta = 0. || delta = 3600. || delta = -3600. + +let init _ = () + +end + +(* ------------------------------------------------------------------------- *) +(* Type and creator *) +(* ------------------------------------------------------------------------- *) + +module TypeCreator : S = struct + +type t = string option + +let dummy = None + +let hash t h = Uutil.hash2 (Hashtbl.hash t) h + +let similar t t' = + not (Prefs.read Osx.rsrc) || t = t' + +let override t t' = t' + +let strip t = t + +let diff t t' = if similar t t' then None else t' + +let zeroes = "\000\000\000\000\000\000\000\000" + +let toString t = + match t with + Some s when s.[0] = 'F' && String.sub (s ^ zeroes) 1 8 <> zeroes -> + let s = s ^ zeroes in + " " ^ String.escaped (String.sub s 1 4) ^ + " " ^ String.escaped (String.sub s 5 4) + | _ -> + "" + +let syncedPartsToString = toString + +let set fspath path kind t = + match t with + None -> () + | Some t -> Osx.setFileInfos fspath path t + +let get stats info = + if + Prefs.read Osx.rsrc && + (stats.Unix.LargeFile.st_kind = Unix.S_REG || + stats.Unix.LargeFile.st_kind = Unix.S_DIR) + then + Some info.Osx.finfo + else + None + +let init _ = () + +end + +(* ------------------------------------------------------------------------- *) +(* Properties *) +(* ------------------------------------------------------------------------- *) + +type t = + { perm : Perm.t; + uid : Uid.t; + gid : Gid.t; + time : Time.t; + typeCreator : TypeCreator.t; + length : Uutil.Filesize.t } + +let template perm = + { perm = perm; uid = Uid.dummy; gid = Gid.dummy; + time = Time.dummy; typeCreator = TypeCreator.dummy; + length = Uutil.Filesize.dummy } + +let dummy = template Perm.dummy + +let hash p h = + Perm.hash p.perm + (Uid.hash p.uid + (Gid.hash p.gid + (Time.hash p.time + (TypeCreator.hash p.typeCreator h)))) + +let similar p p' = + Perm.similar p.perm p'.perm + && + Uid.similar p.uid p'.uid + && + Gid.similar p.gid p'.gid + && + Time.similar p.time p'.time + && + TypeCreator.similar p.typeCreator p'.typeCreator + +let override p p' = + { perm = Perm.override p.perm p'.perm; + uid = Uid.override p.uid p'.uid; + gid = Gid.override p.gid p'.gid; + time = Time.override p.time p'.time; + typeCreator = TypeCreator.override p.typeCreator p'.typeCreator; + length = p'.length } + +let strip p = + { perm = Perm.strip p.perm; + uid = Uid.strip p.uid; + gid = Gid.strip p.gid; + time = Time.strip p.time; + typeCreator = TypeCreator.strip p.typeCreator; + length = p.length } + +let toString p = + Printf.sprintf + "modified on %s size %-9.f %s%s%s%s" + (Time.toString p.time) + (Uutil.Filesize.toFloat p.length) + (Perm.toString p.perm) + (Uid.toString p.uid) + (Gid.toString p.gid) + (TypeCreator.toString p.typeCreator) + +let syncedPartsToString p = + let tm = Time.syncedPartsToString p.time in + Printf.sprintf + "%s%s size %-9.f %s%s%s%s" + (if tm = "" then "" else "modified at ") + tm + (Uutil.Filesize.toFloat p.length) + (Perm.syncedPartsToString p.perm) + (Uid.syncedPartsToString p.uid) + (Gid.syncedPartsToString p.gid) + (TypeCreator.syncedPartsToString p.typeCreator) + +let diff p p' = + { perm = Perm.diff p.perm p'.perm; + uid = Uid.diff p.uid p'.uid; + gid = Gid.diff p.gid p'.gid; + time = Time.diff p.time p'.time; + typeCreator = TypeCreator.diff p.typeCreator p'.typeCreator; + length = p'.length } + +let get stats infos = + { perm = Perm.get stats infos; + uid = Uid.get stats infos; + gid = Gid.get stats infos; + time = Time.get stats infos; + typeCreator = TypeCreator.get stats infos; + length = + if stats.Unix.LargeFile.st_kind = Unix.S_REG then + Uutil.Filesize.fromStats stats + else + Uutil.Filesize.zero } + +let set fspath path kind p = + Uid.set fspath path kind p.uid; + Gid.set fspath path kind p.gid; + TypeCreator.set fspath path kind p.typeCreator; + Time.set fspath path kind p.time; + Perm.set fspath path kind p.perm + +(* Paranoid checks *) +let check fspath path stats p = + Time.check fspath path stats p.time; + Perm.check fspath path stats p.perm + +let init someHostIsRunningWindows = + Perm.init someHostIsRunningWindows; + Uid.init someHostIsRunningWindows; + Gid.init someHostIsRunningWindows; + Time.init someHostIsRunningWindows; + TypeCreator.init someHostIsRunningWindows + +let fileDefault = template Perm.fileDefault +let fileSafe = template Perm.fileSafe +let dirDefault = template Perm.dirDefault + +let same_time p p' = Time.same p.time p'.time +let length p = p.length +let setLength p l = {p with length=l} + +let time p = Time.extract p.time +let setTime p t = {p with time = Time.replace p.time t} + +let perms p = Perm.extract p.perm + +let syncModtimes = Time.sync Deleted: branches/2.32/src/props.mli =================================================================== --- trunk/src/props.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/props.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,31 +0,0 @@ -(* Unison file synchronizer: src/props.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* File properties: time, permission, length, etc. *) - -type t -val dummy : t -val hash : t -> int -> int -val similar : t -> t -> bool -val override : t -> t -> t -val strip : t -> t -val diff : t -> t -> t -val toString : t -> string -val syncedPartsToString : t -> string -val set : Fspath.t -> Path.local -> [`Set | `Update] -> t -> unit -val get : Unix.LargeFile.stats -> Osx.info -> t -val check : Fspath.t -> Path.local -> Unix.LargeFile.stats -> t -> unit -val init : bool -> unit - -val same_time : t -> t -> bool -val length : t -> Uutil.Filesize.t -val setLength : t -> Uutil.Filesize.t -> t -val time : t -> float -val setTime : t -> float -> t -val perms : t -> int - -val fileDefault : t -val fileSafe : t -val dirDefault : t - -val syncModtimes : bool Prefs.t Copied: branches/2.32/src/props.mli (from rev 320, trunk/src/props.mli) =================================================================== --- branches/2.32/src/props.mli (rev 0) +++ branches/2.32/src/props.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,31 @@ +(* Unison file synchronizer: src/props.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +(* File properties: time, permission, length, etc. *) + +type t +val dummy : t +val hash : t -> int -> int +val similar : t -> t -> bool +val override : t -> t -> t +val strip : t -> t +val diff : t -> t -> t +val toString : t -> string +val syncedPartsToString : t -> string +val set : Fspath.t -> Path.local -> [`Set | `Update] -> t -> unit +val get : Unix.LargeFile.stats -> Osx.info -> t +val check : Fspath.t -> Path.local -> Unix.LargeFile.stats -> t -> unit +val init : bool -> unit + +val same_time : t -> t -> bool +val length : t -> Uutil.Filesize.t +val setLength : t -> Uutil.Filesize.t -> t +val time : t -> float +val setTime : t -> float -> t +val perms : t -> int + +val fileDefault : t +val fileSafe : t +val dirDefault : t + +val syncModtimes : bool Prefs.t Deleted: branches/2.32/src/recon.ml =================================================================== --- trunk/src/recon.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/recon.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,512 +0,0 @@ -(* Unison file synchronizer: src/recon.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -open Common - -(* ------------------------------------------------------------------------- *) -(* Handling of prefer/force *) -(* ------------------------------------------------------------------------- *) -let debug = Trace.debug "recon" - -let setDirection ri dir force = - match ri.replicas with - Different(rc1,rc2,d,default) when force=`Force || default=Conflict -> - if dir=`Replica1ToReplica2 then - d := Replica1ToReplica2 - else if dir=`Replica2ToReplica1 then - d := Replica2ToReplica1 - else if dir=`Merge then - if Globals.shouldMerge ri.path then d := Merge else () - else (* dir = `Older or dir = `Newer *) - let (_,s1,p1,_) = rc1 in - let (_,s2,p2,_) = rc2 in - if s1<>`Deleted && s2<>`Deleted then begin - let comp = (Props.time p1) -. (Props.time p2) in - let comp = if dir=`Newer then -. comp else comp in - if comp = 0.0 then - () - else if comp<0.0 then - d := Replica1ToReplica2 - else - d := Replica2ToReplica1 - end else if s1=`Deleted && dir=`Newer then begin - d := Replica2ToReplica1 - end else if s2=`Deleted && dir=`Newer then begin - d := Replica1ToReplica2 - end - | _ -> - () - -let revertToDefaultDirection ri = - match ri.replicas with - Different(_,_,d,default) -> - d := default - | _ -> - () - -(* Find out which direction we need to propagate changes if we want to *) -(* consider the given root to be the "truth" *) -(* -- *) -(* root := "older" | "newer" | *) -(* return value := 'Older | 'Newer | 'Replica1ToReplica2 | *) -(* 'Replica2ToReplica1 *) -(* -- *) -let root2direction root = - if root="older" then `Older - else if root="newer" then `Newer - else - let roots = Safelist.rev (Globals.rawRoots()) in - let r1 = Safelist.nth roots 0 in - let r2 = Safelist.nth roots 1 in - debug (fun() -> - Printf.eprintf "root2direction called to choose %s from %s and %s\n" - root r1 r2); - if r1 = root then `Replica1ToReplica2 else - if r2 = root then `Replica2ToReplica1 else - raise (Util.Fatal (Printf.sprintf - "%s (given as argument to 'prefer' or 'force' preference)\nis not one of \ - the current roots:\n %s\n %s" root r1 r2)) - -let forceRoot: string Prefs.t = - Prefs.createString "force" "" - "force changes from this replica to the other" - ("Including the preference \\texttt{-force \\ARG{root}} causes Unison to " - ^ "resolve all differences (even non-conflicting changes) in favor of " - ^ "\\ARG{root}. " - ^ "This effectively changes Unison from a synchronizer into a mirroring " - ^ "utility. \n\n" - ^ "You can also specify \\verb|-force newer| (or \\verb|-force older|) " - ^ "to force Unison to choose the file with the later (earlier) " - ^ "modtime. In this case, the \\verb|-times| preference must also " - ^ "be enabled.\n\n" - ^ "This preference is overridden by the \\verb|forcepartial| preference.\n\n" - ^ "This preference should be used only if you are {\\em sure} you " - ^ "know what you are doing!") - -let forceRootPartial: Pred.t = - Pred.create "forcepartial" ~advanced:true - ("Including the preference \\texttt{forcepartial \\ARG{PATHSPEC} -> \\ARG{root}} causes Unison to " - ^ "resolve all differences (even non-conflicting changes) in favor of " - ^ "\\ARG{root} for the files in \\ARG{PATHSPEC} (see \\sectionref{pathspec}{Path Specification} " - ^ "for more information). " - ^ "This effectively changes Unison from a synchronizer into a mirroring " - ^ "utility. \n\n" - ^ "You can also specify \\verb|forcepartial PATHSPEC -> newer| " - ^ "(or \\verb|forcepartial PATHSPEC older|) " - ^ "to force Unison to choose the file with the later (earlier) " - ^ "modtime. In this case, the \\verb|-times| preference must also " - ^ "be enabled.\n\n" - ^ "This preference should be used only if you are {\\em sure} you " - ^ "know what you are doing!") - -let preferRoot: string Prefs.t = - Prefs.createString "prefer" "" - "choose this replica's version for conflicting changes" - ("Including the preference \\texttt{-prefer \\ARG{root}} causes Unison always to " - ^ "resolve conflicts in favor of \\ARG{root}, rather than asking for " - ^ "guidance from the user. (The syntax of \\ARG{root} is the same as " - ^ "for the \\verb|root| preference, plus the special values " - ^ "\\verb|newer| and \\verb|older|.) \n\n" - ^ "This preference is overridden by the \\verb|preferpartial| preference.\n\n" - ^ "This preference should be used only if you are {\\em sure} you " - ^ "know what you are doing!") - -let preferRootPartial: Pred.t = - Pred.create "preferpartial" ~advanced:true - ("Including the preference \\texttt{preferpartial \\ARG{PATHSPEC} -> \\ARG{root}} " - ^ "causes Unison always to " - ^ "resolve conflicts in favor of \\ARG{root}, rather than asking for " - ^ "guidance from the user, for the files in \\ARG{PATHSPEC} (see " - ^ "\\sectionref{pathspec}{Path Specification} " - ^ "for more information). (The syntax of \\ARG{root} is the same as " - ^ "for the \\verb|root| preference, plus the special values " - ^ "\\verb|newer| and \\verb|older|.) \n\n" - ^ "This preference should be used only if you are {\\em sure} you " - ^ "know what you are doing!") - -(* [lookupPreferredRoot (): string * [`Force | `Prefer]] checks validity of *) -(* preferences "force"/"preference", returns a pair (root, force) *) -let lookupPreferredRoot () = - if Prefs.read forceRoot <> "" then - (Prefs.read forceRoot, `Force) - else if Prefs.read preferRoot <> "" then - (Prefs.read preferRoot, `Prefer) - else - ("",`Prefer) - -(* [lookupPreferredRootPartial: Path.t -> string * [`Force | `Prefer]] checks validity of *) -(* preferences "forcepartial", returns a pair (root, force) *) -let lookupPreferredRootPartial p = - let s = Path.toString p in - if Pred.test forceRootPartial s then - (Pred.assoc forceRootPartial s, `Force) - else if Pred.test preferRootPartial s then - (Pred.assoc preferRootPartial s, `Prefer) - else - ("",`Prefer) - -(* Use the current values of the '-prefer ' and '-force ' *) -(* preferences to override the reconciler's choices *) -let overrideReconcilerChoices ris = - let (root,force) = lookupPreferredRoot() in - if root<>"" then begin - let dir = root2direction root in - Safelist.iter (fun ri -> setDirection ri dir force) ris - end; - Safelist.iter (fun ri -> - let (rootp,forcep) = lookupPreferredRootPartial ri.path in - if rootp<>"" then begin - let dir = root2direction rootp in - setDirection ri dir forcep - end) ris - -(* Look up the preferred root and verify that it is OK (this is called at *) -(* the beginning of the run, so that we don't have to wait to hear about *) -(* errors *) -(* This should also check for the partial version, but this needs a way to *) -(* extract the associated values from a Pred.t *) -let checkThatPreferredRootIsValid () = - let test_root predname = function - | "" -> () - | ("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'" - predname r)) - | r -> ignore (root2direction r) in - let (root,pred) = lookupPreferredRoot() in - if root<>"" then test_root (match pred with `Force -> "force" | `Prefer -> "prefer") root; - Safelist.iter (test_root "forcepartial") (Pred.extern_associated_strings forceRootPartial); - Safelist.iter (test_root "preferpartial") (Pred.extern_associated_strings preferRootPartial) - -(* ------------------------------------------------------------------------- *) -(* Main Reconciliation stuff *) -(* ------------------------------------------------------------------------- *) - -exception UpdateError of string - -let rec checkForError ui = - match ui with - NoUpdates -> - () - | Error err -> - raise (UpdateError err) - | Updates (uc, _) -> - match uc with - Dir (_, children, _, _) -> - Safelist.iter (fun (_, uiSub) -> checkForError uiSub) children - | Absent | File _ | Symlink _ -> - () - -(* lifting errors in individual updates to replica problems *) -let propagateErrors (rplc: Common.replicas): Common.replicas = - match rplc with - Problem _ -> - rplc - | Different ((_, _, _, ui1), (_, _, _, ui2), _, _) -> - try - checkForError ui1; - try - checkForError ui2; - rplc - with UpdateError err -> - Problem ("[root 2]: " ^ err) - with UpdateError err -> - Problem ("[root 1]: " ^ err) - -type singleUpdate = Rep1Updated | Rep2Updated - -let update2replicaContent (conflict: bool) ui ucNew oldType: - Common.replicaContent = - match ucNew with - Absent -> - (`ABSENT, `Deleted, Props.dummy, ui) - | File (desc, ContentsSame) -> - (`FILE, `PropsChanged, desc, ui) - | File (desc, _) when oldType <> `FILE -> - (`FILE, `Created, desc, ui) - | File (desc, ContentsUpdated _) -> - (`FILE, `Modified, desc, ui) - | Symlink l when oldType <> `SYMLINK -> - (`SYMLINK, `Created, Props.dummy, ui) - | Symlink l -> - (`SYMLINK, `Modified, Props.dummy, ui) - | Dir (desc, _, _, _) when oldType <> `DIRECTORY -> - (`DIRECTORY, `Created, desc, ui) - | Dir (desc, _, PropsUpdated, _) -> - (`DIRECTORY, `PropsChanged, desc, ui) - | Dir (desc, _, PropsSame, _) when conflict -> - (* Special case: the directory contents has been modified and the *) - (* directory is in conflict. (We don't want to display a conflict *) - (* between an unchanged directory and a file, for instance: this would *) - (* be rather puzzling to the user) *) - (`DIRECTORY, `Modified, desc, ui) - | Dir (desc, _, PropsSame, _) -> - (`DIRECTORY, `Unchanged, desc, ui) - -let oldType (prev: Common.prevState): Fileinfo.typ = - match prev with - Previous (typ, _, _, _) -> typ - | New -> `ABSENT - -let oldDesc (prev: Common.prevState): Props.t = - match prev with - Previous (_, desc, _, _) -> desc - | New -> Props.dummy - -(* [describeUpdate ui] returns the replica contents for both the case of *) -(* updating and the case of non-updatingd *) -let describeUpdate ui - : Common.replicaContent * Common.replicaContent = - match ui with - Updates (ucNewStatus, prev) -> - let typ = oldType prev in - (update2replicaContent false ui ucNewStatus typ, - (typ, `Unchanged, oldDesc prev, NoUpdates)) - | _ -> assert false - -(* Computes the reconItems when only one side has been updated. (We split *) -(* this out into a separate function to avoid duplicating all the symmetric *) -(* cases.) *) -let rec reconcileNoConflict ui whatIsUpdated - (result: (Name.t, Common.replicas) Tree.u) - : (Name.t, Common.replicas) Tree.u = - let different() = - let rcUpdated, rcNotUpdated = describeUpdate ui in - match whatIsUpdated with - Rep2Updated -> - Different(rcNotUpdated, rcUpdated, - ref Replica2ToReplica1, Replica2ToReplica1) - | Rep1Updated -> - Different(rcUpdated, rcNotUpdated, - ref Replica1ToReplica2, Replica1ToReplica2) in - match ui with - | NoUpdates -> result - | Error err -> - Tree.add result (Problem err) - | Updates (Dir (desc, children, permchg, _), - Previous(`DIRECTORY, _, _, _)) -> - let r = - if permchg = PropsSame then result else Tree.add result (different ()) - in - Safelist.fold_left - (fun result (theName, uiChild) -> - Tree.leave - (reconcileNoConflict - uiChild whatIsUpdated (Tree.enter result theName))) - r children - | Updates _ -> - Tree.add result (propagateErrors (different ())) - -(* [combineChildrn children1 children2] combines two name-sorted lists of *) -(* type [(Name.t * Common.updateItem) list] to a single list of type *) -(* [(Name.t * Common.updateItem * Common.updateItem] *) -let combineChildren children1 children2 = - (* NOTE: This function assumes children1 and children2 are sorted. *) - let rec loop r children1 children2 = - match children1,children2 with - [],_ -> - Safelist.rev_append r - (Safelist.map - (fun (name,ui) -> (name,NoUpdates,ui)) children2) - | _,[] -> - Safelist.rev_append r - (Safelist.map - (fun (name,ui) -> (name,ui,NoUpdates)) children1) - | (name1,ui1)::rem1, (name2,ui2)::rem2 -> - let dif = Name.compare name1 name2 in - if dif = 0 then - loop ((name1,ui1,ui2)::r) rem1 rem2 - else if dif < 0 then - loop ((name1,ui1,NoUpdates)::r) rem1 children2 - else - loop ((name2,NoUpdates,ui2)::r) children1 rem2 - in - loop [] children1 children2 - -(* File are marked equal in groups of 5000 to lower memory consumption *) -let add_equal (counter, archiveUpdated) equal v = - let eq = Tree.add equal v in - incr counter; - archiveUpdated := true; - if !counter = 5000 then begin - counter := 0; - let (t, eq) = Tree.slice eq in (* take a snapshot of the tree *) - Update.markEqual t; (* work on it *) - eq (* and return the leftover spine *) - end else - eq - -(* The main reconciliation function: takes a path and two updateItem *) -(* structures and returns a list of reconItems containing suggestions for *) -(* propagating changes to make the two replicas equal. *) -(* -- *) -(* It uses two accumulators: *) -(* equals: (Name.t, Common.updateContent * Common.updateContent) *) -(* Tree.u *) -(* unequals: (Name.t, Common.replicas) Tree.u *) -(* -- *) -let rec reconcile path ui1 ui2 counter equals unequals = - let different uc1 uc2 oldType equals unequals = - (equals, - Tree.add unequals - (propagateErrors - (Different(update2replicaContent true ui1 uc1 oldType, - update2replicaContent true ui2 uc2 oldType, - ref Conflict, - Conflict)))) in - let toBeMerged uc1 uc2 oldType equals unequals = - (equals, - Tree.add unequals - (propagateErrors - (Different(update2replicaContent true ui1 uc1 oldType, - update2replicaContent true ui2 uc2 oldType, - ref Merge, - Merge)))) in - match (ui1, ui2) with - (Error s, _) -> - (equals, Tree.add unequals (Problem s)) - | (_, Error s) -> - (equals, Tree.add unequals (Problem s)) - | (NoUpdates, _) -> - (equals, reconcileNoConflict ui2 Rep2Updated unequals) - | (_, NoUpdates) -> - (equals, reconcileNoConflict ui1 Rep1Updated unequals) - | (Updates (Absent, _), Updates (Absent, _)) -> - (add_equal counter equals (Absent, Absent), unequals) - | (Updates (Dir (desc1, children1, propsChanged1, _) as uc1, prevState1), - Updates (Dir (desc2, children2, propsChanged2, _) as uc2, prevState2)) -> - (* See if the directory itself should have a reconItem *) - let dirResult = - if propsChanged1 = PropsSame && propsChanged2 = PropsSame then - (equals, unequals) - else if Props.similar desc1 desc2 then - let uc1 = Dir (desc1, [], PropsSame, false) in - let uc2 = Dir (desc2, [], PropsSame, false) in - (add_equal counter equals (uc1, uc2), unequals) - else - let action = - if propsChanged1 = PropsSame then Replica2ToReplica1 - else if propsChanged2 = PropsSame then Replica1ToReplica2 - else Conflict in - (equals, - Tree.add unequals - (Different - (update2replicaContent false ui1 uc1 `DIRECTORY, - update2replicaContent false ui2 uc2 `DIRECTORY, - ref action, action))) - in - (* Apply reconcile on children. *) - Safelist.fold_left - (fun (equals, unequals) (name,ui1,ui2) -> - let (eq, uneq) = - reconcile (Path.child path name) ui1 ui2 counter - (Tree.enter equals name) (Tree.enter unequals name) - in - (Tree.leave eq, Tree.leave uneq)) - dirResult - (combineChildren children1 children2) - | (Updates (File (desc1,contentsChanged1) as uc1, prev), - Updates (File (desc2,contentsChanged2) as uc2, _)) -> - begin match contentsChanged1, contentsChanged2 with - ContentsUpdated (dig1, _, ress1), ContentsUpdated (dig2, _, ress2) - when dig1 = dig2 -> - if Props.similar desc1 desc2 then - (add_equal counter equals (uc1, uc2), unequals) - else -(* Special case: when both sides are modified files but their contents turn *) -(* out to be the same, we want to display them as 'perms' rather than 'new' *) -(* on both sides, to avoid confusing the user. (The Transfer module also *) -(* expect this.) *) - let uc1' = File(desc1,ContentsSame) in - let uc2' = File(desc2,ContentsSame) in - different uc1' uc2' (oldType prev) equals unequals - | ContentsSame, ContentsSame when Props.similar desc1 desc2 -> - (add_equal counter equals (uc1, uc2), unequals) - | ContentsUpdated _, ContentsUpdated _ - when Globals.shouldMerge path -> - toBeMerged uc1 uc2 (oldType prev) equals unequals - | _ -> - different uc1 uc2 (oldType prev) equals unequals - end - | (Updates (Symlink(l1) as uc1, prev), - Updates (Symlink(l2) as uc2, _)) -> - if l1 = l2 then - (add_equal counter equals (uc1, uc2), unequals) - else - different uc1 uc2 (oldType prev) equals unequals - | (Updates (uc1, prev), Updates (uc2, _)) -> - different uc1 uc2 (oldType prev) equals unequals - -(* Sorts the paths so that they will be displayed in order *) -let sortPaths pathUpdatesList = - Sort.list - (fun (p1, _) (p2, _) -> Path.compare p1 p2 <= 0) - pathUpdatesList - -let rec enterPath p t = - match Path.deconstruct p with - None -> t - | Some (nm, p') -> enterPath p' (Tree.enter t nm) - -let rec leavePath p t = - match Path.deconstruct p with - None -> t - | Some (nm, p') -> leavePath p' (Tree.leave t) - -(* A path is dangerous if one replica has been emptied but not the other *) -let dangerousPath u1 u2 = - let emptied u = - match u with - Updates (Absent, _) -> true - | Updates (Dir (_, _, _, empty), _) -> empty - | _ -> false - in - emptied u1 <> emptied u2 - -(* The second component of the return value is true if there is at least one *) -(* file that is updated in the same way on both roots *) -let reconcileList (pathUpdatesList: (Path.t * Common.updateItem list) list) - : Common.reconItem list * bool * Path.t list = - let counter = ref 0 in - let archiveUpdated = ref false in - let (equals, unequals, dangerous) = - Safelist.fold_left - (fun (equals, unequals, dangerous) (path,updatesList) -> - match updatesList with - [ui1; ui2] -> - let (equals, unequals) = - reconcile path ui1 ui2 (counter, archiveUpdated) - (enterPath path equals) (enterPath path unequals) - in - (leavePath path equals, leavePath path unequals, - if dangerousPath ui1 ui2 then path :: dangerous else dangerous) - | _ -> - assert false) - (Tree.start, Tree.start, []) pathUpdatesList in - let unequals = Tree.finish unequals in - debug (fun() -> Util.msg "reconcile: %d results\n" (Tree.size unequals)); - let equals = Tree.finish equals in - Update.markEqual equals; - (* Commit archive updates done up to now *) - if !archiveUpdated then Update.commitUpdates (); - let result = Tree.flatten unequals Path.empty Path.child [] in - let unsorted = - Safelist.map (fun (p, rplc) -> {path = p; replicas = rplc}) result in - let sorted = Sortri.sortReconItems unsorted in - overrideReconcilerChoices sorted; - (sorted, not (Tree.is_empty equals), dangerous) - -(* This is the main function: it takes a list of updateItem lists and, - according to the roots and paths of synchronization, builds the - corresponding reconItem list. A second component indicates whether there - is any file updated in the same way on both sides. *) -let reconcileAll (ONEPERPATH(updatesListList)) = - Trace.status "Reconciling changes"; - debug (fun() -> Util.msg "reconcileAll\n"); - let pathList = Prefs.read Globals.paths in - let pathUpdatesList = - sortPaths (Safelist.combine pathList updatesListList) in - reconcileList pathUpdatesList - -let reconcileTwo p ui ui' = reconcileList [(p, [ui; ui'])] Copied: branches/2.32/src/recon.ml (from rev 320, trunk/src/recon.ml) =================================================================== --- branches/2.32/src/recon.ml (rev 0) +++ branches/2.32/src/recon.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,527 @@ +(* Unison file synchronizer: src/recon.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +open Common + +(* ------------------------------------------------------------------------- *) +(* Handling of prefer/force *) +(* ------------------------------------------------------------------------- *) +let debug = Trace.debug "recon" + +let setDirection ri dir force = + match ri.replicas with + Different(rc1,rc2,d,default) when force=`Force || default=Conflict -> + if dir=`Replica1ToReplica2 then + d := Replica1ToReplica2 + else if dir=`Replica2ToReplica1 then + d := Replica2ToReplica1 + else if dir=`Merge then + if Globals.shouldMerge ri.path then d := Merge else () + else (* dir = `Older or dir = `Newer *) + let (_,s1,p1,_) = rc1 in + let (_,s2,p2,_) = rc2 in + if s1<>`Deleted && s2<>`Deleted then begin + let comp = (Props.time p1) -. (Props.time p2) in + let comp = if dir=`Newer then -. comp else comp in + if comp = 0.0 then + () + else if comp<0.0 then + d := Replica1ToReplica2 + else + d := Replica2ToReplica1 + end else if s1=`Deleted && dir=`Newer then begin + d := Replica2ToReplica1 + end else if s2=`Deleted && dir=`Newer then begin + d := Replica1ToReplica2 + end + | _ -> + () + +let revertToDefaultDirection ri = + match ri.replicas with + Different(_,_,d,default) -> + d := default + | _ -> + () + +(* Find out which direction we need to propagate changes if we want to *) +(* consider the given root to be the "truth" *) +(* -- *) +(* root := "older" | "newer" | *) +(* return value := 'Older | 'Newer | 'Replica1ToReplica2 | *) +(* 'Replica2ToReplica1 *) +(* -- *) +let root2direction root = + if root="older" then `Older + else if root="newer" then `Newer + else + let roots = Safelist.rev (Globals.rawRoots()) in + let r1 = Safelist.nth roots 0 in + let r2 = Safelist.nth roots 1 in + debug (fun() -> + Printf.eprintf "root2direction called to choose %s from %s and %s\n" + root r1 r2); + if r1 = root then `Replica1ToReplica2 else + if r2 = root then `Replica2ToReplica1 else + raise (Util.Fatal (Printf.sprintf + "%s (given as argument to 'prefer' or 'force' preference)\nis not one of \ + the current roots:\n %s\n %s" root r1 r2)) + +let forceRoot: string Prefs.t = + Prefs.createString "force" "" + "force changes from this replica to the other" + ("Including the preference \\texttt{-force \\ARG{root}} causes Unison to " + ^ "resolve all differences (even non-conflicting changes) in favor of " + ^ "\\ARG{root}. " + ^ "This effectively changes Unison from a synchronizer into a mirroring " + ^ "utility. \n\n" + ^ "You can also specify \\verb|-force newer| (or \\verb|-force older|) " + ^ "to force Unison to choose the file with the later (earlier) " + ^ "modtime. In this case, the \\verb|-times| preference must also " + ^ "be enabled.\n\n" + ^ "This preference is overridden by the \\verb|forcepartial| preference.\n\n" + ^ "This preference should be used only if you are {\\em sure} you " + ^ "know what you are doing!") + +let forceRootPartial: Pred.t = + Pred.create "forcepartial" ~advanced:true + ("Including the preference \\texttt{forcepartial \\ARG{PATHSPEC} -> \\ARG{root}} causes Unison to " + ^ "resolve all differences (even non-conflicting changes) in favor of " + ^ "\\ARG{root} for the files in \\ARG{PATHSPEC} (see \\sectionref{pathspec}{Path Specification} " + ^ "for more information). " + ^ "This effectively changes Unison from a synchronizer into a mirroring " + ^ "utility. \n\n" + ^ "You can also specify \\verb|forcepartial PATHSPEC -> newer| " + ^ "(or \\verb|forcepartial PATHSPEC older|) " + ^ "to force Unison to choose the file with the later (earlier) " + ^ "modtime. In this case, the \\verb|-times| preference must also " + ^ "be enabled.\n\n" + ^ "This preference should be used only if you are {\\em sure} you " + ^ "know what you are doing!") + +let preferRoot: string Prefs.t = + Prefs.createString "prefer" "" + "choose this replica's version for conflicting changes" + ("Including the preference \\texttt{-prefer \\ARG{root}} causes Unison always to " + ^ "resolve conflicts in favor of \\ARG{root}, rather than asking for " + ^ "guidance from the user. (The syntax of \\ARG{root} is the same as " + ^ "for the \\verb|root| preference, plus the special values " + ^ "\\verb|newer| and \\verb|older|.) \n\n" + ^ "This preference is overridden by the \\verb|preferpartial| preference.\n\n" + ^ "This preference should be used only if you are {\\em sure} you " + ^ "know what you are doing!") + +let preferRootPartial: Pred.t = + Pred.create "preferpartial" ~advanced:true + ("Including the preference \\texttt{preferpartial \\ARG{PATHSPEC} -> \\ARG{root}} " + ^ "causes Unison always to " + ^ "resolve conflicts in favor of \\ARG{root}, rather than asking for " + ^ "guidance from the user, for the files in \\ARG{PATHSPEC} (see " + ^ "\\sectionref{pathspec}{Path Specification} " + ^ "for more information). (The syntax of \\ARG{root} is the same as " + ^ "for the \\verb|root| preference, plus the special values " + ^ "\\verb|newer| and \\verb|older|.) \n\n" + ^ "This preference should be used only if you are {\\em sure} you " + ^ "know what you are doing!") + +(* [lookupPreferredRoot (): string * [`Force | `Prefer]] checks validity of *) +(* preferences "force"/"preference", returns a pair (root, force) *) +let lookupPreferredRoot () = + if Prefs.read forceRoot <> "" then + (Prefs.read forceRoot, `Force) + else if Prefs.read preferRoot <> "" then + (Prefs.read preferRoot, `Prefer) + else + ("",`Prefer) + +(* [lookupPreferredRootPartial: Path.t -> string * [`Force | `Prefer]] checks validity of *) +(* preferences "forcepartial", returns a pair (root, force) *) +let lookupPreferredRootPartial p = + let s = Path.toString p in + if Pred.test forceRootPartial s then + (Pred.assoc forceRootPartial s, `Force) + else if Pred.test preferRootPartial s then + (Pred.assoc preferRootPartial s, `Prefer) + else + ("",`Prefer) + +(* Use the current values of the '-prefer ' and '-force ' *) +(* preferences to override the reconciler's choices *) +let overrideReconcilerChoices ris = + let (root,force) = lookupPreferredRoot() in + if root<>"" then begin + let dir = root2direction root in + Safelist.iter (fun ri -> setDirection ri dir force) ris + end; + Safelist.iter (fun ri -> + let (rootp,forcep) = lookupPreferredRootPartial ri.path in + if rootp<>"" then begin + let dir = root2direction rootp in + setDirection ri dir forcep + end) ris + +(* Look up the preferred root and verify that it is OK (this is called at *) +(* the beginning of the run, so that we don't have to wait to hear about *) +(* errors *) +(* This should also check for the partial version, but this needs a way to *) +(* extract the associated values from a Pred.t *) +let checkThatPreferredRootIsValid () = + let test_root predname = function + | "" -> () + | ("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'" + predname r)) + | r -> ignore (root2direction r) in + let (root,pred) = lookupPreferredRoot() in + if root<>"" then test_root (match pred with `Force -> "force" | `Prefer -> "prefer") root; + Safelist.iter (test_root "forcepartial") (Pred.extern_associated_strings forceRootPartial); + Safelist.iter (test_root "preferpartial") (Pred.extern_associated_strings preferRootPartial) + +(* ------------------------------------------------------------------------- *) +(* Main Reconciliation stuff *) +(* ------------------------------------------------------------------------- *) + +exception UpdateError of string + +let rec checkForError ui = + match ui with + NoUpdates -> + () + | Error err -> + raise (UpdateError err) + | Updates (uc, _) -> + match uc with + Dir (_, children, _, _) -> + Safelist.iter (fun (_, uiSub) -> checkForError uiSub) children + | Absent | File _ | Symlink _ -> + () + +(* lifting errors in individual updates to replica problems *) +let propagateErrors (rplc: Common.replicas): Common.replicas = + match rplc with + Problem _ -> + rplc + | Different ((_, _, _, ui1), (_, _, _, ui2), _, _) -> + try + checkForError ui1; + try + checkForError ui2; + rplc + with UpdateError err -> + Problem ("[root 2]: " ^ err) + with UpdateError err -> + Problem ("[root 1]: " ^ err) + +type singleUpdate = Rep1Updated | Rep2Updated + +let update2replicaContent (conflict: bool) ui ucNew oldType: + Common.replicaContent = + match ucNew with + Absent -> + (`ABSENT, `Deleted, Props.dummy, ui) + | File (desc, ContentsSame) -> + (`FILE, `PropsChanged, desc, ui) + | File (desc, _) when oldType <> `FILE -> + (`FILE, `Created, desc, ui) + | File (desc, ContentsUpdated _) -> + (`FILE, `Modified, desc, ui) + | Symlink l when oldType <> `SYMLINK -> + (`SYMLINK, `Created, Props.dummy, ui) + | Symlink l -> + (`SYMLINK, `Modified, Props.dummy, ui) + | Dir (desc, _, _, _) when oldType <> `DIRECTORY -> + (`DIRECTORY, `Created, desc, ui) + | Dir (desc, _, PropsUpdated, _) -> + (`DIRECTORY, `PropsChanged, desc, ui) + | Dir (desc, _, PropsSame, _) when conflict -> + (* Special case: the directory contents has been modified and the *) + (* directory is in conflict. (We don't want to display a conflict *) + (* between an unchanged directory and a file, for instance: this would *) + (* be rather puzzling to the user) *) + (`DIRECTORY, `Modified, desc, ui) + | Dir (desc, _, PropsSame, _) -> + (`DIRECTORY, `Unchanged, desc, ui) + +let oldType (prev: Common.prevState): Fileinfo.typ = + match prev with + Previous (typ, _, _, _) -> typ + | New -> `ABSENT + +let oldDesc (prev: Common.prevState): Props.t = + match prev with + Previous (_, desc, _, _) -> desc + | New -> Props.dummy + +(* [describeUpdate ui] returns the replica contents for both the case of *) +(* updating and the case of non-updatingd *) +let describeUpdate ui + : Common.replicaContent * Common.replicaContent = + match ui with + Updates (ucNewStatus, prev) -> + let typ = oldType prev in + (update2replicaContent false ui ucNewStatus typ, + (typ, `Unchanged, oldDesc prev, NoUpdates)) + | _ -> assert false + +(* Computes the reconItems when only one side has been updated. (We split *) +(* this out into a separate function to avoid duplicating all the symmetric *) +(* cases.) *) +let rec reconcileNoConflict ui whatIsUpdated + (result: (Name.t, Common.replicas) Tree.u) + : (Name.t, Common.replicas) Tree.u = + let different() = + let rcUpdated, rcNotUpdated = describeUpdate ui in + match whatIsUpdated with + Rep2Updated -> + Different(rcNotUpdated, rcUpdated, + ref Replica2ToReplica1, Replica2ToReplica1) + | Rep1Updated -> + Different(rcUpdated, rcNotUpdated, + ref Replica1ToReplica2, Replica1ToReplica2) in + match ui with + | NoUpdates -> result + | Error err -> + Tree.add result (Problem err) + | Updates (Dir (desc, children, permchg, _), + Previous(`DIRECTORY, _, _, _)) -> + let r = + if permchg = PropsSame then result else Tree.add result (different ()) + in + Safelist.fold_left + (fun result (theName, uiChild) -> + Tree.leave + (reconcileNoConflict + uiChild whatIsUpdated (Tree.enter result theName))) + r children + | Updates _ -> + Tree.add result (propagateErrors (different ())) + +(* [combineChildrn children1 children2] combines two name-sorted lists of *) +(* type [(Name.t * Common.updateItem) list] to a single list of type *) +(* [(Name.t * Common.updateItem * Common.updateItem] *) +let combineChildren children1 children2 = + (* NOTE: This function assumes children1 and children2 are sorted. *) + let rec loop r children1 children2 = + match children1,children2 with + [],_ -> + Safelist.rev_append r + (Safelist.map + (fun (name,ui) -> (name,NoUpdates,ui)) children2) + | _,[] -> + Safelist.rev_append r + (Safelist.map + (fun (name,ui) -> (name,ui,NoUpdates)) children1) + | (name1,ui1)::rem1, (name2,ui2)::rem2 -> + let dif = Name.compare name1 name2 in + if dif = 0 then + loop ((name1,ui1,ui2)::r) rem1 rem2 + else if dif < 0 then + loop ((name1,ui1,NoUpdates)::r) rem1 children2 + else + loop ((name2,NoUpdates,ui2)::r) children1 rem2 + in + loop [] children1 children2 + +(* File are marked equal in groups of 5000 to lower memory consumption *) +let add_equal (counter, archiveUpdated) equal v = + let eq = Tree.add equal v in + incr counter; + archiveUpdated := true; + if !counter = 5000 then begin + counter := 0; + let (t, eq) = Tree.slice eq in (* take a snapshot of the tree *) + Update.markEqual t; (* work on it *) + eq (* and return the leftover spine *) + end else + eq + +(* The main reconciliation function: takes a path and two updateItem *) +(* structures and returns a list of reconItems containing suggestions for *) +(* propagating changes to make the two replicas equal. *) +(* -- *) +(* It uses two accumulators: *) +(* equals: (Name.t, Common.updateContent * Common.updateContent) *) +(* Tree.u *) +(* unequals: (Name.t, Common.replicas) Tree.u *) +(* -- *) +let rec reconcile path ui1 ui2 counter equals unequals = + let different uc1 uc2 oldType equals unequals = + (equals, + Tree.add unequals + (propagateErrors + (Different(update2replicaContent true ui1 uc1 oldType, + update2replicaContent true ui2 uc2 oldType, + ref Conflict, + Conflict)))) in + let toBeMerged uc1 uc2 oldType equals unequals = + (equals, + Tree.add unequals + (propagateErrors + (Different(update2replicaContent true ui1 uc1 oldType, + update2replicaContent true ui2 uc2 oldType, + ref Merge, + Merge)))) in + match (ui1, ui2) with + (Error s, _) -> + (equals, Tree.add unequals (Problem s)) + | (_, Error s) -> + (equals, Tree.add unequals (Problem s)) + | (NoUpdates, _) -> + (equals, reconcileNoConflict ui2 Rep2Updated unequals) + | (_, NoUpdates) -> + (equals, reconcileNoConflict ui1 Rep1Updated unequals) + | (Updates (Absent, _), Updates (Absent, _)) -> + (add_equal counter equals (Absent, Absent), unequals) + | (Updates (Dir (desc1, children1, propsChanged1, _) as uc1, prevState1), + Updates (Dir (desc2, children2, propsChanged2, _) as uc2, prevState2)) -> + (* See if the directory itself should have a reconItem *) + let dirResult = + if propsChanged1 = PropsSame && propsChanged2 = PropsSame then + (equals, unequals) + else if Props.similar desc1 desc2 then + let uc1 = Dir (desc1, [], PropsSame, false) in + let uc2 = Dir (desc2, [], PropsSame, false) in + (add_equal counter equals (uc1, uc2), unequals) + else + let action = + if propsChanged1 = PropsSame then Replica2ToReplica1 + else if propsChanged2 = PropsSame then Replica1ToReplica2 + else Conflict in + (equals, + Tree.add unequals + (Different + (update2replicaContent false ui1 uc1 `DIRECTORY, + update2replicaContent false ui2 uc2 `DIRECTORY, + ref action, action))) + in + (* Apply reconcile on children. *) + Safelist.fold_left + (fun (equals, unequals) (name,ui1,ui2) -> + let (eq, uneq) = + reconcile (Path.child path name) ui1 ui2 counter + (Tree.enter equals name) (Tree.enter unequals name) + in + (Tree.leave eq, Tree.leave uneq)) + dirResult + (combineChildren children1 children2) + | (Updates (File (desc1,contentsChanged1) as uc1, prev), + Updates (File (desc2,contentsChanged2) as uc2, _)) -> + begin match contentsChanged1, contentsChanged2 with + ContentsUpdated (dig1, _, ress1), ContentsUpdated (dig2, _, ress2) + when dig1 = dig2 -> + if Props.similar desc1 desc2 then + (add_equal counter equals (uc1, uc2), unequals) + else +(* Special case: when both sides are modified files but their contents turn *) +(* out to be the same, we want to display them as 'perms' rather than 'new' *) +(* on both sides, to avoid confusing the user. (The Transfer module also *) +(* expect this.) *) + let uc1' = File(desc1,ContentsSame) in + let uc2' = File(desc2,ContentsSame) in + different uc1' uc2' (oldType prev) equals unequals + | ContentsSame, ContentsSame when Props.similar desc1 desc2 -> + (add_equal counter equals (uc1, uc2), unequals) + | ContentsUpdated _, ContentsUpdated _ + when Globals.shouldMerge path -> + toBeMerged uc1 uc2 (oldType prev) equals unequals + | _ -> + different uc1 uc2 (oldType prev) equals unequals + end + | (Updates (Symlink(l1) as uc1, prev), + Updates (Symlink(l2) as uc2, _)) -> + if l1 = l2 then + (add_equal counter equals (uc1, uc2), unequals) + else + different uc1 uc2 (oldType prev) equals unequals + | (Updates (uc1, prev), Updates (uc2, _)) -> + different uc1 uc2 (oldType prev) equals unequals + +(* Sorts the paths so that they will be displayed in order *) +let sortPaths pathUpdatesList = + Sort.list + (fun (p1, _) (p2, _) -> Path.compare p1 p2 <= 0) + pathUpdatesList + +let rec enterPath p t = + match Path.deconstruct p with + None -> t + | Some (nm, p') -> enterPath p' (Tree.enter t nm) + +let rec leavePath p t = + match Path.deconstruct p with + None -> t + | Some (nm, p') -> leavePath p' (Tree.leave t) + +(* A path is dangerous if one replica has been emptied but not the other *) +let dangerousPath u1 u2 = + let emptied u = + match u with + Updates (Absent, _) -> true + | Updates (Dir (_, _, _, empty), _) -> empty + | _ -> false + in + emptied u1 <> emptied u2 + +(* The second component of the return value is true if there is at least one *) +(* file that is updated in the same way on both roots *) +let reconcileList (pathUpdatesList: (Path.t * Common.updateItem list) list) + : Common.reconItem list * bool * Path.t list = + let counter = ref 0 in + let archiveUpdated = ref false in + let (equals, unequals, dangerous) = + Safelist.fold_left + (fun (equals, unequals, dangerous) (path,updatesList) -> + match updatesList with + [ui1; ui2] -> + let (equals, unequals) = + reconcile path ui1 ui2 (counter, archiveUpdated) + (enterPath path equals) (enterPath path unequals) + in + (leavePath path equals, leavePath path unequals, + if dangerousPath ui1 ui2 then path :: dangerous else dangerous) + | _ -> + assert false) + (Tree.start, Tree.start, []) pathUpdatesList in + let unequals = Tree.finish unequals in + debug (fun() -> Util.msg "reconcile: %d results\n" (Tree.size unequals)); + let equals = Tree.finish equals in + Update.markEqual equals; + (* Commit archive updates done up to now *) + if !archiveUpdated then Update.commitUpdates (); + let result = Tree.flatten unequals Path.empty Path.child [] in + let unsorted = + Safelist.map (fun (p, rplc) -> {path = p; replicas = rplc}) result in + let sorted = Sortri.sortReconItems unsorted in + overrideReconcilerChoices sorted; + (sorted, not (Tree.is_empty equals), dangerous) + +(* This is the main function: it takes a list of updateItem lists and, + according to the roots and paths of synchronization, builds the + corresponding reconItem list. A second component indicates whether there + is any file updated in the same way on both sides. *) +let reconcileAll (ONEPERPATH(updatesListList)) = + Trace.status "Reconciling changes"; + debug (fun() -> Util.msg "reconcileAll\n"); + let pathList = Prefs.read Globals.paths in + let pathUpdatesList = + sortPaths (Safelist.combine pathList updatesListList) in + reconcileList pathUpdatesList + +let reconcileTwo p ui ui' = reconcileList [(p, [ui; ui'])] Deleted: branches/2.32/src/recon.mli =================================================================== --- trunk/src/recon.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/recon.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,34 +0,0 @@ -(* Unison file synchronizer: src/recon.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -val reconcileAll : - Common.updateItem list Common.oneperpath - (* one updateItem per replica, per path *) - -> Common.reconItem list (* List of updates that need propagated *) - * bool (* Any file updated equally on all roots*) - * Path.t list (* Paths which have been emptied on one side*) -(* --------------- *) - -val reconcileTwo : Path.t -> Common.updateItem -> Common.updateItem -> - Common.reconItem list * bool * Path.t list - - -(* Use the current values of the '-prefer ' and '-force ' *) -(* preferences to override the reconciler's choices *) -val overrideReconcilerChoices : Common.reconItem list -> unit - -(* If the given reconItem's default direction is Conflict (or the third *) -(* argument is `Force), then set it as specified by the second argument. *) -val setDirection : - Common.reconItem -> - [`Older | `Newer | `Merge | `Replica1ToReplica2 | `Replica2ToReplica1] -> - [`Force | `Prefer] -> - unit - -(* Set the given reconItem's direction back to the default *) -val revertToDefaultDirection : Common.reconItem -> unit - -(* Look up the preferred root and verify that it is OK (this is called at *) -(* the beginning of the run, before we do anything time consuming, so that *) -(* we don't have to wait to hear about errors *) -val checkThatPreferredRootIsValid : unit -> unit Copied: branches/2.32/src/recon.mli (from rev 320, trunk/src/recon.mli) =================================================================== --- branches/2.32/src/recon.mli (rev 0) +++ branches/2.32/src/recon.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,34 @@ +(* Unison file synchronizer: src/recon.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +val reconcileAll : + Common.updateItem list Common.oneperpath + (* one updateItem per replica, per path *) + -> Common.reconItem list (* List of updates that need propagated *) + * bool (* Any file updated equally on all roots*) + * Path.t list (* Paths which have been emptied on one side*) +(* --------------- *) + +val reconcileTwo : Path.t -> Common.updateItem -> Common.updateItem -> + Common.reconItem list * bool * Path.t list + + +(* Use the current values of the '-prefer ' and '-force ' *) +(* preferences to override the reconciler's choices *) +val overrideReconcilerChoices : Common.reconItem list -> unit + +(* If the given reconItem's default direction is Conflict (or the third *) +(* argument is `Force), then set it as specified by the second argument. *) +val setDirection : + Common.reconItem -> + [`Older | `Newer | `Merge | `Replica1ToReplica2 | `Replica2ToReplica1] -> + [`Force | `Prefer] -> + unit + +(* Set the given reconItem's direction back to the default *) +val revertToDefaultDirection : Common.reconItem -> unit + +(* Look up the preferred root and verify that it is OK (this is called at *) +(* the beginning of the run, before we do anything time consuming, so that *) +(* we don't have to wait to hear about errors *) +val checkThatPreferredRootIsValid : unit -> unit Deleted: branches/2.32/src/remote.ml =================================================================== --- trunk/src/remote.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/remote.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,1197 +0,0 @@ -(* Unison file synchronizer: src/remote.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* -XXX -- Check exception handling -- Use Lwt_unix.system for the merge function - (Unix.open_process_in for diff) -*) - -let (>>=) = Lwt.bind - -let debug = Trace.debug "remote" -let debugV = Trace.debug "remote+" -let debugE = Trace.debug "remote+" -let debugT = Trace.debug "remote+" - -(* BCP: The previous definitions of the last two were like this: - let debugE = Trace.debug "remote_emit" - let debugT = Trace.debug "thread" - But that resulted in huge amounts of output from '-debug all'. -*) - -let windowsHack = Sys.os_type <> "Unix" - -(****) - -let encodeInt m = - let int_buf = String.create 4 in - String.set int_buf 0 (Char.chr ( m land 0xff)); - String.set int_buf 1 (Char.chr ((m lsr 8) land 0xff)); - String.set int_buf 2 (Char.chr ((m lsr 16) land 0xff)); - String.set int_buf 3 (Char.chr ((m lsr 24) land 0xff)); - int_buf - -let decodeInt int_buf = - let b0 = Char.code (String.get int_buf 0) in - let b1 = Char.code (String.get int_buf 1) in - let b2 = Char.code (String.get int_buf 2) in - let b3 = Char.code (String.get int_buf 3) in - ((b3 lsl 24) lor (b2 lsl 16) lor (b1 lsl 8) lor b0) - -(*************************************************************************) -(* LOW-LEVEL IO *) -(*************************************************************************) - -let lost_connection () = - Lwt.fail (Util.Fatal "Lost connection with the server") - -let catch_io_errors th = - Lwt.catch th - (fun e -> - match e with - Unix.Unix_error(Unix.ECONNRESET, _, _) - | Unix.Unix_error(Unix.EPIPE, _, _) - (* Windows may also return the following errors... *) - | Unix.Unix_error(Unix.EINVAL, _, _) -> - (* Client has closed its end of the connection *) - lost_connection () - | _ -> - Lwt.fail e) - -(****) - -type connection = - { inputChannel : Unix.file_descr; - inputBuffer : string; - mutable inputLength : int; - outputChannel : Unix.file_descr; - outputBuffer : string; - mutable outputLength : int; - outputQueue : (string * int * int) list Queue.t; - mutable pendingOutput : bool; - mutable flowControl : bool; - mutable canWrite : bool; - mutable tokens : int; - mutable reader : unit Lwt.t option } - -let receivedBytes = ref 0. -let emittedBytes = ref 0. - -let inputBuffer_size = 8192 - -let fill_inputBuffer conn = - assert (conn.inputLength = 0); - catch_io_errors - (fun () -> - Lwt_unix.read conn.inputChannel conn.inputBuffer 0 inputBuffer_size - >>= (fun len -> - debugV (fun() -> - if len = 0 then - Util.msg "grab: EOF\n" - else - Util.msg "grab: %s\n" - (String.escaped (String.sub conn.inputBuffer 0 len))); - if len = 0 then - lost_connection () - else begin - receivedBytes := !receivedBytes +. float len; - conn.inputLength <- len; - Lwt.return () - end)) - -let rec grab_rec conn s pos len = - if conn.inputLength = 0 then begin - fill_inputBuffer conn >>= (fun () -> - grab_rec conn s pos len) - end else begin - let l = min (len - pos) conn.inputLength in - String.blit conn.inputBuffer 0 s pos l; - conn.inputLength <- conn.inputLength - l; - if conn.inputLength > 0 then - String.blit conn.inputBuffer l conn.inputBuffer 0 conn.inputLength; - if pos + l < len then - grab_rec conn s (pos + l) len - else - Lwt.return () - end - -let grab conn s len = - assert (len > 0); - assert (String.length s <= len); - grab_rec conn s 0 len - -let peek_without_blocking conn = - String.sub conn.inputBuffer 0 conn.inputLength - -(****) - -let outputBuffer_size = 8192 - -let rec send_output conn = - catch_io_errors - (fun () -> - Lwt_unix.write - conn.outputChannel conn.outputBuffer 0 conn.outputLength - >>= (fun len -> - debugV (fun() -> - Util.msg "dump: %s\n" - (String.escaped (String.sub conn.outputBuffer 0 len))); - emittedBytes := !emittedBytes +. float len; - conn.outputLength <- conn.outputLength - len; - if conn.outputLength > 0 then - String.blit - conn.outputBuffer len conn.outputBuffer 0 conn.outputLength; - Lwt.return ())) - -let rec fill_buffer_2 conn s pos len = - if conn.outputLength = outputBuffer_size then - send_output conn >>= (fun () -> - fill_buffer_2 conn s pos len) - else begin - let l = min (len - pos) (outputBuffer_size - conn.outputLength) in - String.blit s pos conn.outputBuffer conn.outputLength l; - conn.outputLength <- conn.outputLength + l; - if pos + l < len then - fill_buffer_2 conn s (pos + l) len - else - Lwt.return () - end - -let rec fill_buffer conn l = - match l with - (s, pos, len) :: rem -> - assert (pos >= 0); - assert (len >= 0); - assert (pos + len <= String.length s); - fill_buffer_2 conn s pos len >>= (fun () -> - fill_buffer conn rem) - | [] -> - Lwt.return () - -(* - Flow-control mechanism (only active under windows). - Only one side is allowed to send message at any given time. - Once it has finished sending message, a special message is sent - meaning that the destination is now allowed to send messages. - A side is allowed to send any number of messages, but will then - not be allowed to send before having received the same number of - messages. - This way, there can be no dead-lock with both sides trying - simultaneously to send some messages. Furthermore, multiple - messages can still be coalesced. -*) -let needFlowControl = windowsHack - -(* Loop until the output buffer is empty *) -let rec flush_buffer conn = - if conn.tokens <= 0 && conn.canWrite then begin - assert conn.flowControl; - conn.canWrite <- false; - debugE (fun() -> Util.msg "Sending write token\n"); - (* Special message allowing the other side to write *) - fill_buffer conn [(encodeInt 0, 0, 4)] >>= (fun () -> - flush_buffer conn) >>= (fun () -> - if windowsHack then begin - debugE (fun() -> Util.msg "Restarting reader\n"); - match conn.reader with - None -> - () - | Some r -> - conn.reader <- None; - Lwt.wakeup r () - end; - Lwt.return ()) - end else if conn.outputLength > 0 then - send_output conn >>= (fun () -> - flush_buffer conn) - else begin - conn.pendingOutput <- false; - Lwt.return () - end - -let rec msg_length l = - match l with - [] -> 0 - | (s, p, l)::r -> l + msg_length r - -(* Send all pending messages *) -let rec dump_rec conn = - try - let l = Queue.take conn.outputQueue in - fill_buffer conn l >>= (fun () -> - if conn.flowControl then conn.tokens <- conn.tokens - 1; - debugE (fun () -> Util.msg "Remaining tokens: %d\n" conn.tokens); - dump_rec conn) - with Queue.Empty -> - (* We wait a bit before flushing everything, so that other packets - send just afterwards can be coalesced *) - Lwt_unix.yield () >>= (fun () -> - try - ignore (Queue.peek conn.outputQueue); - dump_rec conn - with Queue.Empty -> - flush_buffer conn) - -(* Start the thread that write all pending messages, if this thread is - not running at this time *) -let signalSomethingToWrite conn = - if not conn.canWrite && conn.pendingOutput then - debugE - (fun () -> Util.msg "Something to write, but no write token (%d)\n" - conn.tokens); - if conn.pendingOutput = false && conn.canWrite then begin - conn.pendingOutput <- true; - Lwt.ignore_result (dump_rec conn) - end - -(* Add a message to the output queue and schedule its emission *) -(* A message is a list of fragments of messages, represented by triplets - (string, position in string, length) *) -let dump conn l = - Queue.add l conn.outputQueue; - signalSomethingToWrite conn; - Lwt.return () - -(* Invoked when a special message is received from the other side, - allowing this side to send messages *) -let allowWrites conn = - if conn.flowControl then begin - assert (conn.pendingOutput = false); - assert (not conn.canWrite); - conn.canWrite <- true; - debugE (fun () -> Util.msg "Received write token (%d)\n" conn.tokens); - (* Flush pending messages, if there are any *) - signalSomethingToWrite conn - end - -(* Invoked when a special message is received from the other side, - meaning that the other side does not block on write, and that - therefore there can be no dead-lock. *) -let disableFlowControl conn = - debugE (fun () -> Util.msg "Flow control disabled\n"); - conn.flowControl <- false; - conn.canWrite <- true; - conn.tokens <- 1; - (* We are allowed to write, so we flush pending messages, if there - are any *) - signalSomethingToWrite conn - -(****) - -(* Initialize the connection *) -let setupIO in_ch out_ch = - if not windowsHack then begin - Unix.set_nonblock in_ch; - Unix.set_nonblock out_ch - end; - { inputChannel = in_ch; - inputBuffer = String.create inputBuffer_size; - inputLength = 0; - outputChannel = out_ch; - outputBuffer = String.create outputBuffer_size; - outputLength = 0; - outputQueue = Queue.create (); - pendingOutput = false; - flowControl = true; - canWrite = true; - tokens = 1; - reader = None } - -(* XXX *) -module Thread = struct - - let unwindProtect f cleanup = - Lwt.catch f - (fun e -> - match e with - Util.Transient err | Util.Fatal err -> - debugT - (fun () -> - Util.msg - "Exception caught by Thread.unwindProtect: %s\n" err); - Lwt.catch (fun () -> cleanup e) (fun e' -> - Util.encodeException "Thread.unwindProtect" `Fatal e') - >>= (fun () -> - Lwt.fail e) - | _ -> - Lwt.fail e) - -end - -(*****************************************************************************) -(* MARSHALING *) -(*****************************************************************************) - -type tag = string - -type 'a marshalFunction = - 'a -> (string * int * int) list -> (string * int * int) list -type 'a unmarshalFunction = string -> 'a -type 'a marshalingFunctions = 'a marshalFunction * 'a unmarshalFunction - -let registeredSet = ref Util.StringSet.empty - -let rec first_chars len msg = - match msg with - [] -> - "" - | (s, p, l) :: rem -> - if l < len then - String.sub s p l ^ first_chars (len - l) rem - else - String.sub s p len - -(* An integer just a little smaller than the maximum representable in 30 bits *) -let hugeint = 1000000000 - -let safeMarshal marshalPayload tag data rem = - let (rem', length) = marshalPayload data rem in - if length > hugeint then begin - let start = first_chars (min length 10) rem' in - let start = if length > 10 then start ^ "..." else start in - let start = String.escaped start in - Util.msg "Fatal error in safeMarshal: sending too many (%d) bytes with tag %s and contents [%s]\n" length tag start; - raise (Util.Fatal ((Printf.sprintf - "Message payload too large (%d, %s, [%s]). \n" length tag start) - ^ "This is a bug in Unison; if it happens to you in a repeatable way, \n" - ^ "please post a report on the unison-users mailing list.")) - end; - let l = String.length tag in - debugE (fun() -> - let start = first_chars (min length 10) rem' in - let start = if length > 10 then start ^ "..." else start in - let start = String.escaped start in - Util.msg "send [%s] '%s' %d bytes\n" tag start length); - ((encodeInt (l + length), 0, 4) :: (tag, 0, l) :: rem') - -let safeUnmarshal unmarshalPayload tag buf = - let taglength = String.length tag in - let identifier = String.sub buf 0 (min taglength (String.length buf)) in - if identifier = tag then - unmarshalPayload buf taglength - else - raise (Util.Fatal - (Printf.sprintf "[safeUnmarshal] expected %s but got %s" - tag identifier)) - -let registerTag string = - if Util.StringSet.mem string !registeredSet then - raise (Util.Fatal (Printf.sprintf "tag %s is already registered" string)) - else - registeredSet := Util.StringSet.add string !registeredSet; - string - -let defaultMarshalingFunctions = - (fun data rem -> - try - let s = Marshal.to_string data [Marshal.No_sharing] in - let l = String.length s in - ((s, 0, String.length s) :: rem, l) - with Out_of_memory -> - raise (Util.Fatal - "Trying to transfer too much data in one go.\n\ - If this happens during update detection, try to\n\ - synchronize smaller pieces of the replica first\n\ - using the \"path\" directive.")), - (fun buf pos -> Marshal.from_string buf pos) - -let makeMarshalingFunctions payloadMarshalingFunctions string = - let (marshalPayload, unmarshalPayload) = payloadMarshalingFunctions in - let tag = registerTag string in - let marshal (data : 'a) rem = safeMarshal marshalPayload tag data rem in - let unmarshal buf = (safeUnmarshal unmarshalPayload tag buf : 'a) in - (marshal, unmarshal) - -(*****************************************************************************) -(* SERVER SETUP *) -(*****************************************************************************) - -(* BCPFIX: Now that we've beefed up the clroot data structure, shouldn't - these be part of it too? *) -let sshCmd = - Prefs.createString "sshcmd" "ssh" - ("!path to the ssh executable") - ("This preference can be used to explicitly set the name of the " - ^ "ssh executable (e.g., giving a full path name), if necessary.") - -let rshCmd = - Prefs.createString "rshcmd" "rsh" - ("*path to the rsh executable") - ("This preference can be used to explicitly set the name of the " - ^ "rsh executable (e.g., giving a full path name), if necessary.") - -let rshargs = - Prefs.createString "rshargs" "" - "*other arguments (if any) for remote shell command" - ("The string value of this preference will be passed as additional " - ^ "arguments (besides the host name and the name of the Unison " - ^ "executable on the remote system) to the \\verb|rsh| " - ^ "command used to invoke the remote server. " - ) - -let sshargs = - Prefs.createString "sshargs" "" - "!other arguments (if any) for remote shell command" - ("The string value of this preference will be passed as additional " - ^ "arguments (besides the host name and the name of the Unison " - ^ "executable on the remote system) to the \\verb|ssh| " - ^ "command used to invoke the remote server. " - ) - -let serverCmd = - Prefs.createString "servercmd" "" - ("!name of " ^ Uutil.myName ^ " executable on remote server") - ("This preference can be used to explicitly set the name of the " - ^ "Unison executable on the remote server (e.g., giving a full " - ^ "path name), if necessary.") - -let addversionno = - Prefs.createBool "addversionno" false - ("!add version number to name of " ^ Uutil.myName ^ " on server") - ("When this flag is set to {\\tt true}, Unison " - ^ "will use \\texttt{unison-\\ARG{currentversionnumber}} instead of " - ^ "just \\verb|unison| as the remote server command. This allows " - ^ "multiple binaries for different versions of unison to coexist " - ^ "conveniently on the same server: whichever version is run " - ^ "on the client, the same version will be selected on the server.") - -(* List containing the connected hosts and the file descriptors of - the communication. *) -(* -(* Perhaps the list would be better indexed by root - (host name [+ user name] [+ socket]) ... *) -let connectedHosts = ref [] - -(* Gets the Read/Write file descriptors for a host; - the connection must have been set up by canonizeRoot before calling *) -let hostConnection host = - try Safelist.assoc host !connectedHosts - with Not_found -> - raise(Util.Fatal "hostConnection") -*) - -(* connectedHosts is a list of command-line roots, their corresponding - canonical host names and canonical fspaths, and their connections. - Local command-line roots are not in the list. - Although there can only be one remote host per sync, it's possible - connectedHosts to hold more than one hosts if more than one sync is - performed. - It's also possible for there to be two connections open for the - same canonical root. -*) -let connectedHosts = ref [] -let hostConnection host = (* host must be canonical *) - let rec loop = function - [] -> raise(Util.Fatal "Remote.hostConnection") - | (cl,h,fspath,conn)::tl -> if h=host then conn else loop tl in - loop !connectedHosts - -let canonize clroot = (* connection for clroot must have been set up already *) - match clroot with - Clroot.ConnectLocal s -> (Common.Local, Fspath.canonize s) - | _ -> - let rec loop = function - [] -> raise(Util.Fatal "Remote.canonize") - | (cl,h,fspath,conn)::tl -> - if cl=clroot then (Common.Remote h,fspath) else loop tl in - loop !connectedHosts - - -(********************************************************************** - CLIENT/SERVER PROTOCOLS - **********************************************************************) - -(* -Each protocol has a name, a client side, and a server side. - -The server remembers the server side of each protocol in a table -indexed by protocol name. The function of the server is to wait for -the client to invoke a protocol, and carry out the appropriate server -side. - -Protocols are invoked on the client with arguments for the server side. -The result of the protocol is the result of the server side. In types, - - serverSide : 'a -> 'b - -That is, the server side takes arguments of type 'a from the client, -and returns a result of type 'b. - -A protocol is started by the client sending a Request packet and then a -packet containing the protocol name to the server. The server looks -up the server side of the protocol in its table. - -Next, the client sends a packet containing marshaled arguments for the -server side. - -The server unmarshals the arguments and invokes the server side with -the arguments from the client. - -When the server side completes it gives a result. The server marshals -the result and sends it to the client. (Instead of a result, the -server may also send back either a Transient or a Fatal error packet). -Finally, the client can receive the result packet from the server and -unmarshal it. - -The protocol is fully symmetric, so the server may send a Request -packet to invoke a function remotely on the client. In this case, the -two switch roles.) -*) - -let receivePacket conn = - (* Get the length of the packet *) - let int_buf = String.create 4 in - grab conn int_buf 4 >>= (fun () -> - let length = decodeInt int_buf in - assert (length >= 0); - (* Get packet *) - let buf = String.create length in - grab conn buf length >>= (fun () -> - (debugE (fun () -> - let start = - if length > 10 then (String.sub buf 0 10) ^ "..." - else String.sub buf 0 length in - let start = String.escaped start in - Util.msg "receive '%s' %d bytes\n" start length); - Lwt.return buf))) - -type servercmd = - connection -> string -> - ((string * int * int) list -> (string * int * int) list) Lwt.t -let serverCmds = ref (Util.StringMap.empty : servercmd Util.StringMap.t) - -type header = - NormalResult - | TransientExn of string - | FatalExn of string - | Request of string - -let ((marshalHeader, unmarshalHeader) : header marshalingFunctions) = - makeMarshalingFunctions defaultMarshalingFunctions "rsp" - -let processRequest conn id cmdName buf = - let cmd = - try Util.StringMap.find cmdName !serverCmds - with Not_found -> raise (Util.Fatal (cmdName ^ " not registered!")) - in - Lwt.try_bind (fun () -> cmd conn buf) - (fun marshal -> - debugE (fun () -> Util.msg "Sending result (id: %d)\n" (decodeInt id)); - dump conn ((id, 0, 4) :: marshalHeader NormalResult (marshal []))) - (function - Util.Transient s -> - debugE (fun () -> - Util.msg "Sending transient exception (id: %d)\n" (decodeInt id)); - dump conn ((id, 0, 4) :: marshalHeader (TransientExn s) []) - | Util.Fatal s -> - debugE (fun () -> - Util.msg "Sending fatal exception (id: %d)\n" (decodeInt id)); - dump conn ((id, 0, 4) :: marshalHeader (FatalExn s) []) - | e -> - Lwt.fail e) - -(* Message ids *) -type msgId = int -module MsgIdMap = Map.Make (struct type t = msgId let compare = compare end) -let ids = ref 1 -let newMsgId () = incr ids; if !ids = hugeint then ids := 2; !ids - -(* Threads waiting for a response from the other side *) -let receivers = ref MsgIdMap.empty - -let find_receiver id = - let thr = MsgIdMap.find id !receivers in - receivers := MsgIdMap.remove id !receivers; - thr - -(* Receiving thread: read a message and dispatch it to the right - thread or create a new thread to process requests. *) -let rec receive conn = - (if windowsHack && conn.canWrite then - let wait = Lwt.wait () in - assert (conn.reader = None); - conn.reader <- Some wait; - wait - else - Lwt.return ()) >>= (fun () -> - debugE (fun () -> Util.msg "Waiting for next message\n"); - (* Get the message ID *) - let id = String.create 4 in - grab conn id 4 >>= (fun () -> - let num_id = decodeInt id in - if num_id = 0 then begin - debugE (fun () -> Util.msg "Received the write permission\n"); - allowWrites conn; - receive conn - end else begin - if conn.flowControl then conn.tokens <- conn.tokens + 1; - debugE - (fun () -> Util.msg "Message received (id: %d) (tokens: %d)\n" - num_id conn.tokens); - (* Read the header *) - receivePacket conn >>= (fun buf -> - let req = unmarshalHeader buf in - begin match req with - Request cmdName -> - receivePacket conn >>= (fun buf -> - (* We yield before starting processing the request. - This way, the request may call [Lwt_unix.run] and this will - not block the receiving thread. *) - Lwt.ignore_result - (Lwt_unix.yield () >>= (fun () -> - processRequest conn id cmdName buf)); - receive conn) - | NormalResult -> - receivePacket conn >>= (fun buf -> - Lwt.wakeup (find_receiver num_id) buf; - receive conn) - | TransientExn s -> - debugV (fun() -> Util.msg "receive: Transient remote error '%s']" s); - Lwt.wakeup_exn (find_receiver num_id) (Util.Transient s); - receive conn - | FatalExn s -> - debugV (fun() -> Util.msg "receive: Fatal remote error '%s']" s); - Lwt.wakeup_exn (find_receiver num_id) (Util.Fatal ("Server: " ^ s)); - receive conn - end) - end)) - -let wait_for_reply id = - let res = Lwt.wait () in - receivers := MsgIdMap.add id res !receivers; - (* We yield to let the receiving thread restart. This way, the - thread may call [Lwt_unix.run] and this will not block the - receiving thread. *) - Lwt.catch - (fun () -> - res >>= (fun v -> Lwt_unix.yield () >>= (fun () -> Lwt.return v))) - (fun e -> Lwt_unix.yield () >>= (fun () -> Lwt.fail e)) - -let registerSpecialServerCmd - (cmdName : string) - marshalingFunctionsArgs - marshalingFunctionsResult - (serverSide : connection -> 'a -> 'b Lwt.t) - = - (* Check that this command name has not already been bound *) - if (Util.StringMap.mem cmdName !serverCmds) then - raise (Util.Fatal (cmdName ^ " already registered!")); - (* Create marshaling and unmarshaling functions *) - let ((marshalArgs,unmarshalArgs) : 'a marshalingFunctions) = - makeMarshalingFunctions marshalingFunctionsArgs (cmdName ^ "-args") in - let ((marshalResult,unmarshalResult) : 'b marshalingFunctions) = - makeMarshalingFunctions marshalingFunctionsResult (cmdName ^ "-res") in - (* Create a server function and remember it *) - let server conn buf = - let args = unmarshalArgs buf in - serverSide conn args >>= (fun answer -> - Lwt.return (marshalResult answer)) - in - serverCmds := Util.StringMap.add cmdName server !serverCmds; - (* Create a client function and return it *) - let client conn serverArgs = - let id = newMsgId () in (* Message ID *) - assert (id >= 0); (* tracking down an assert failure in receivePacket... *) - let request = - (encodeInt id, 0, 4) :: - marshalHeader (Request cmdName) (marshalArgs serverArgs []) - in - let reply = wait_for_reply id in - debugE (fun () -> Util.msg "Sending request (id: %d)\n" id); - dump conn request >>= (fun () -> - reply >>= (fun buf -> - Lwt.return (unmarshalResult buf))) - in - client - -let registerServerCmd name f = - registerSpecialServerCmd - name defaultMarshalingFunctions defaultMarshalingFunctions f - -(* RegisterHostCmd is a simpler version of registerClientServer [registerServerCmd?]. - It is used to create remote procedure calls: the only communication - between the client and server is the sending of arguments from - client to server, and the sending of the result from the server - to the client. Thus, server side does not need the file descriptors - for communication with the client. - - RegisterHostCmd recognizes the case where the server is the local - host, and it avoids socket communication in this case. -*) -let registerHostCmd cmdName cmd = - let serverSide = (fun _ args -> cmd args) in - let client0 = - registerServerCmd cmdName serverSide in - let client host args = - let conn = hostConnection host in - client0 conn args in - (* Return a function that runs either the proxy or the local version, - depending on whether the call is to the local host or a remote one *) - fun host args -> - match host with - "" -> cmd args - | _ -> client host args - -let hostOfRoot root = - match root with - (Common.Local, _) -> "" - | (Common.Remote host, _) -> host -let connectionToRoot root = hostConnection (hostOfRoot root) - -(* RegisterRootCmd is like registerHostCmd but it indexes connections by - root instead of host. *) -let registerRootCmd (cmdName : string) (cmd : (Fspath.t * 'a) -> 'b) = - let r = registerHostCmd cmdName cmd in - fun root args -> r (hostOfRoot root) ((snd root), args) - -let registerRootCmdWithConnection - (cmdName : string) (cmd : connection -> 'a -> 'b) = - let client0 = registerServerCmd cmdName cmd in - (* Return a function that runs either the proxy or the local version, - depending on whether the call is to the local host or a remote one *) - fun localRoot remoteRoot args -> - match (hostOfRoot localRoot) with - "" -> let conn = hostConnection (hostOfRoot remoteRoot) in - cmd conn args - | _ -> let conn = hostConnection (hostOfRoot localRoot) in - client0 conn args - - -(**************************************************************************** - BUILDING CONNECTIONS TO THE SERVER - ****************************************************************************) - -let connectionHeader = "Unison " ^ Uutil.myMajorVersion ^ "\n" - -let rec checkHeader conn prefix buffer pos len = - if pos = len then - Lwt.return () - else begin - (grab conn buffer 1 >>= (fun () -> - if buffer.[0] <> connectionHeader.[pos] then - let rest = peek_without_blocking conn in - Lwt.fail - (Util.Fatal - ("Received unexpected header from the server:\n \ - expected \"" - ^ String.escaped (* (String.sub connectionHeader 0 (pos + 1)) *) - connectionHeader - ^ "\" but received \"" ^ String.escaped (prefix ^ buffer ^ rest) ^ "\", \n" - ^ "which differs at \"" ^ String.escaped (prefix ^ buffer) ^ "\".\n" - ^ "This can happen because you have different versions of Unison\n" - ^ "installed on the client and server machines, or because\n" - ^ "your connection is failing and somebody is printing an error\n" - ^ "message, or because your remote login shell is printing\n" - ^ "something itself before starting Unison.")) - else - checkHeader conn (prefix ^ buffer) buffer (pos + 1) len)) - end - -(****) - -(* - Disable flow control if possible. - Both hosts must use non-blocking I/O (otherwise a dead-lock is - possible with ssh). -*) - -let negociateFlowControlLocal conn () = - if not needFlowControl then disableFlowControl conn; - Lwt.return needFlowControl - -let negociateFlowControlRemote = - registerServerCmd "negociateFlowControl" negociateFlowControlLocal - -let negociateFlowControl conn = - if not needFlowControl then - negociateFlowControlRemote conn () >>= (fun needed -> - if not needed then - negociateFlowControlLocal conn () >>= (fun _ -> Lwt.return ()) - else - Lwt.return ()) - else - Lwt.return () - -(****) - -let initConnection in_ch out_ch = - if not windowsHack then - ignore(Sys.set_signal Sys.sigpipe Sys.Signal_ignore); - let conn = setupIO in_ch out_ch in - conn.canWrite <- false; - checkHeader conn "" " " 0 (String.length connectionHeader) >>= (fun () -> - Lwt.ignore_result (receive conn); - negociateFlowControl conn >>= (fun () -> - Lwt.return conn)) - -let inetAddr host = - let targetHostEntry = Unix.gethostbyname host in - targetHostEntry.Unix.h_addr_list.(0) - -let buildSocketConnection host port = - Util.convertUnixErrorsToFatal "canonizeRoot" (fun () -> - let rec loop = function - [] -> - raise (Util.Fatal - (Printf.sprintf - "Can't find the IP address of the server (%s:%s)" host - port)) - | ai::r -> - (* create a socket to talk to the remote host *) - let socket = Unix.socket ai.Unix.ai_family ai.Unix.ai_socktype ai.Unix.ai_protocol in - begin try - Unix.connect socket ai.Unix.ai_addr; - initConnection socket socket - with - Unix.Unix_error (error, _, reason) -> - (if error != Unix.EAFNOSUPPORT then - Util.warn - (Printf.sprintf - "Can't connect to server (%s:%s): %s" host port reason); - loop r) - end - in loop (Unix.getaddrinfo host port [ Unix.AI_SOCKTYPE Unix.SOCK_STREAM ])) - -let buildShellConnection shell host userOpt portOpt rootName termInteract = - let remoteCmd = - (if Prefs.read serverCmd="" then Uutil.myName - else Prefs.read serverCmd) - ^ (if Prefs.read addversionno then "-" ^ Uutil.myMajorVersion else "") - ^ " -server" in - let userArgs = - match userOpt with - None -> [] - | Some user -> ["-l"; user] in - let portArgs = - match portOpt with - None -> [] - | Some port -> ["-p"; port] in - let shellCmd = - (if shell = "ssh" then - Prefs.read sshCmd - else if shell = "rsh" then - Prefs.read rshCmd - else - shell) in - let shellCmdArgs = - (if shell = "ssh" then - Prefs.read sshargs - else if shell = "rsh" then - Prefs.read rshargs - else - "") in - let preargs = - ([shellCmd]@userArgs at portArgs@ - [host]@ - (if shell="ssh" then ["-e none"] else [])@ - [shellCmdArgs;remoteCmd]) in - (* Split compound arguments at space chars, to make - create_process happy *) - let args = - Safelist.concat - (Safelist.map (fun s -> Util.splitIntoWords s ' ') preargs) in - let argsarray = Array.of_list args in - let (i1,o1) = Unix.pipe() in - let (i2,o2) = Unix.pipe() in - (* We need to make sure that there is only one reader and one - writer by pipe, so that, when one side of the connection - dies, the other side receives an EOF or a SIGPIPE. *) - Unix.set_close_on_exec i2; - Unix.set_close_on_exec o1; - (* We add CYGWIN=binmode to the environment before calling - ssh because the cygwin implementation on Windows sometimes - puts the pipe in text mode (which does end of line - translation). Specifically, if unison is invoked from - a DOS command prompt or other non-cygwin context, the pipe - goes into text mode; this does not happen if unison is - invoked from cygwin's bash. By setting CYGWIN=binmode - we force the pipe to remain in binary mode. *) - Unix.putenv "CYGWIN" "binmode"; - debug (fun ()-> Util.msg "Shell connection: %s (%s)\n" - shellCmd (String.concat ", " args)); - let term = - match termInteract with - None -> - ignore (Unix.create_process shellCmd argsarray i1 o2 Unix.stderr); - None - | Some callBack -> - fst (Terminal.create_session shellCmd argsarray i1 o2 Unix.stderr) - in - Unix.close i1; Unix.close o2; - begin match term, termInteract with - | Some fdTerm, Some callBack -> - Terminal.handlePasswordRequests fdTerm (callBack rootName) - | _ -> - () - end; - initConnection i2 o1 - -let canonizeOnServer = - registerServerCmd "canonizeOnServer" - (fun _ s -> Lwt.return (Os.myCanonicalHostName, Fspath.canonize s)) - -let canonizeRoot rootName clroot termInteract = - let finish ioServer s = - canonizeOnServer ioServer s >>= (fun (host, fspath) -> - connectedHosts := (clroot,host,fspath,ioServer)::(!connectedHosts); - Lwt.return (Common.Remote host,fspath)) in - let rec hostfspath = function - [] -> None - | (clroot',host,fspath,_)::tl -> - if clroot=clroot' - then Some(Lwt.return(Common.Remote host,fspath)) - else hostfspath tl in - match clroot with - Clroot.ConnectLocal s -> - Lwt.return (Common.Local, Fspath.canonize s) - | Clroot.ConnectBySocket(host,port,s) -> - (match hostfspath !connectedHosts with - Some x -> x - | None -> - buildSocketConnection host port >>= (fun ioServer -> - finish ioServer s)) - | Clroot.ConnectByShell(shell,host,userOpt,portOpt,s) -> - (match hostfspath !connectedHosts with - Some x -> x - | None -> - buildShellConnection - shell host userOpt portOpt rootName termInteract >>= - (fun ioServer -> finish ioServer s)) - -(* A new interface, useful for terminal interaction, it should - eventually replace canonizeRoot and buildShellConnection *) -(* A preconnection is None if there's nothing more to do, and Some if - terminal interaction might be required (for ssh password) *) -type preconnection = - (Unix.file_descr - * Unix.file_descr - * Unix.file_descr - * Unix.file_descr - * string option - * Unix.file_descr option - * Clroot.clroot - * int) -let openConnectionStart clroot = - match clroot with - Clroot.ConnectLocal s -> - None - | Clroot.ConnectBySocket(host,port,s) -> - (* This check isn't foolproof as the host in the clroot might not be canonical *) - if (Safelist.exists (fun (clroot',_,_,_) -> clroot=clroot') !connectedHosts) - then None - else begin - let ioServer = Lwt_unix.run(buildSocketConnection host port) in - let (host,fspath) = Lwt_unix.run(canonizeOnServer ioServer s) in - connectedHosts := (clroot,host,fspath,ioServer)::(!connectedHosts); - None - end - | Clroot.ConnectByShell(shell,host,userOpt,portOpt,s) -> - if (Safelist.exists (fun (clroot',_,_,_) -> clroot=clroot') !connectedHosts) - then None - else begin - let remoteCmd = - (if Prefs.read serverCmd="" then Uutil.myName - else Prefs.read serverCmd) - ^ (if Prefs.read addversionno then "-" ^ Uutil.myMajorVersion else "") - ^ " -server" in - let userArgs = - match userOpt with - None -> [] - | Some user -> ["-l"; user] in - let portArgs = - match portOpt with - None -> [] - | Some port -> ["-p"; port] in - let shellCmd = - (if shell = "ssh" then - Prefs.read sshCmd - else if shell = "rsh" then - Prefs.read rshCmd - else - shell) in - let shellCmdArgs = - (if shell = "ssh" then - Prefs.read sshargs - else if shell = "rsh" then - Prefs.read rshargs - else - "") in - let preargs = - ([shellCmd]@userArgs at portArgs@ - [host]@ - (if shell="ssh" then ["-e none"] else [])@ - [shellCmdArgs;remoteCmd]) in - (* Split compound arguments at space chars, to make - create_process happy *) - let args = - Safelist.concat - (Safelist.map (fun s -> Util.splitIntoWords s ' ') preargs) in - let argsarray = Array.of_list args in - let (i1,o1) = Unix.pipe() in - let (i2,o2) = Unix.pipe() in - (* We need to make sure that there is only one reader and one - writer by pipe, so that, when one side of the connection - dies, the other side receives an EOF or a SIGPIPE. *) - Unix.set_close_on_exec i2; - Unix.set_close_on_exec o1; - (* We add CYGWIN=binmode to the environment before calling - ssh because the cygwin implementation on Windows sometimes - puts the pipe in text mode (which does end of line - translation). Specifically, if unison is invoked from - a DOS command prompt or other non-cygwin context, the pipe - goes into text mode; this does not happen if unison is - invoked from cygwin's bash. By setting CYGWIN=binmode - we force the pipe to remain in binary mode. *) - Unix.putenv "CYGWIN" "binmode"; - debug (fun ()-> Util.msg "Shell connection: %s (%s)\n" - shellCmd (String.concat ", " args)); - let (term,pid) = - Terminal.create_session shellCmd argsarray i1 o2 Unix.stderr in - (* after terminal interact, remember to close i1 and o2 *) - Some(i1,i2,o1,o2,s,term,clroot,pid) - end - -let openConnectionPrompt = function - (i1,i2,o1,o2,s,Some fdTerm,clroot,pid) -> - let x = Terminal.termInput fdTerm i2 in - x - | _ -> None - -let openConnectionReply = function - (i1,i2,o1,o2,s,Some fdTerm,clroot,pid) -> - (fun response -> - (* FIX: should loop on write, watch for EINTR, etc. *) - ignore(Unix.write fdTerm (response ^ "\n") 0 (String.length response + 1))) - | _ -> (fun _ -> ()) - -let openConnectionEnd (i1,i2,o1,o2,s,_,clroot,pid) = - Unix.close i1; Unix.close o2; - let ioServer = Lwt_unix.run (initConnection i2 o1) in - let (host,fspath) = Lwt_unix.run(canonizeOnServer ioServer s) in - connectedHosts := (clroot,host,fspath,ioServer)::(!connectedHosts) - -let openConnectionCancel (i1,i2,o1,o2,s,fdopt,clroot,pid) = - try Unix.kill pid Sys.sigkill with _ -> (); - try Unix.close i1 with _ -> (); - try Unix.close i2 with _ -> (); - try Unix.close o1 with _ -> (); - try Unix.close o2 with _ -> (); - match fdopt with None -> () | Some fd -> (try Unix.close fd with _ -> ()) - -(****************************************************************************) -(* SERVER-MODE COMMAND PROCESSING LOOP *) -(****************************************************************************) - -let showWarningOnClient = - (registerServerCmd - "showWarningOnClient" - (fun _ str -> Lwt.return (Util.warn str))) - -let forwardMsgToClient = - (registerServerCmd - "forwardMsgToClient" - (fun _ str -> (*msg "forwardMsgToClient: %s\n" str; *) - Lwt.return (Trace.displayMessageLocally str))) - -(* This function loops, waits for commands, and passes them to - the relevant functions. *) -let commandLoop in_ch out_ch = - Trace.runningasserver := true; - (* Send header indicating to the client that it has successfully - connected to the server *) - let conn = setupIO in_ch out_ch in - try - Lwt_unix.run - (dump conn [(connectionHeader, 0, String.length connectionHeader)] - >>= (fun () -> - (* Set the local warning printer to make an RPC to the client and - show the warning there; ditto for the message printer *) - Util.warnPrinter := - Some (fun str -> Lwt_unix.run (showWarningOnClient conn str)); - Trace.messageForwarder := - Some (fun str -> Lwt_unix.run (forwardMsgToClient conn str)); - receive conn >>= - Lwt.wait)) -(* debug (fun () -> Util.msg "Should never happen\n") *) - with Util.Fatal "Lost connection with the server" -> - debug (fun () -> Util.msg "Connection closed by the client\n") - -let killServer = - Prefs.createBool "killserver" false - "!kill server when done (even when using sockets)" - ("When set to \\verb|true|, this flag causes Unison to kill the remote " - ^ "server process when the synchronization is finished. This behavior " - ^ "is the default for \\verb|ssh| connections, so this preference is not " - ^ "normally needed when running over \\verb|ssh|; it is provided so " - ^ "that socket-mode servers can be killed off after a single run of " - ^ "Unison, rather than waiting to accept future connections. (Some " - ^ "users prefer to start a remote socket server for each run of Unison, " - ^ "rather than leaving one running all the time.)") - -(* For backward compatibility *) -let _ = Prefs.alias killServer "killServer" - -(* Used by the socket mechanism: Create a socket on portNum and wait - for a request. Each request is processed by commandLoop. When a - session finishes, the server waits for another request. *) -let waitOnPort hostOpt port = - Util.convertUnixErrorsToFatal - "waiting on port" - (fun () -> - let host = match hostOpt with - Some host -> host - | None -> "" in - let rec loop = function - [] -> raise (Util.Fatal - (if host = "" then - Printf.sprintf "Can't bind socket to port %s" port - else - Printf.sprintf "Can't bind socket to port %s on host %s" port host)) - | ai::r -> - (* Open a socket to listen for queries *) - let socket = Unix.socket ai.Unix.ai_family ai.Unix.ai_socktype - ai.Unix.ai_protocol in - begin try - (* Allow reuse of local addresses for bind *) - Unix.setsockopt socket Unix.SO_REUSEADDR true; - (* Bind the socket to portnum on the local host *) - Unix.bind socket ai.Unix.ai_addr; - (* Start listening, allow up to 1 pending request *) - Unix.listen socket 1; - socket - with - Unix.Unix_error (error, _, reason) -> - (if error != Unix.EAFNOSUPPORT then - Util.msg - "Can't bind socket to port %s at address [%s]: %s\n" - port - (match ai.Unix.ai_addr with - Unix.ADDR_INET (addr, _) -> Unix.string_of_inet_addr addr - | _ -> assert false) - (Unix.error_message error); - loop r) - end in - let listening = loop (Unix.getaddrinfo host port [ Unix.AI_SOCKTYPE - Unix.SOCK_STREAM ; Unix.AI_PASSIVE ]) in - Util.msg "server started\n"; - while - (* Accept a connection *) - let (connected,_) = Os.accept listening in - Unix.setsockopt connected Unix.SO_KEEPALIVE true; - commandLoop connected connected; - (* The client has closed its end of the connection *) - begin try Unix.close connected with Unix.Unix_error _ -> () end; - not (Prefs.read killServer) - do () done) - -let beAServer () = - begin try - Sys.chdir (Sys.getenv "HOME") - with Not_found -> - Util.msg - "Environment variable HOME unbound: \ - executing server in current directory\n" - end; - commandLoop Unix.stdin Unix.stdout Copied: branches/2.32/src/remote.ml (from rev 320, trunk/src/remote.ml) =================================================================== --- branches/2.32/src/remote.ml (rev 0) +++ branches/2.32/src/remote.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,1212 @@ +(* Unison file synchronizer: src/remote.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +(* +XXX +- Check exception handling +- Use Lwt_unix.system for the merge function + (Unix.open_process_in for diff) +*) + +let (>>=) = Lwt.bind + +let debug = Trace.debug "remote" +let debugV = Trace.debug "remote+" +let debugE = Trace.debug "remote+" +let debugT = Trace.debug "remote+" + +(* BCP: The previous definitions of the last two were like this: + let debugE = Trace.debug "remote_emit" + let debugT = Trace.debug "thread" + But that resulted in huge amounts of output from '-debug all'. +*) + +let windowsHack = Sys.os_type <> "Unix" + +(****) + +let encodeInt m = + let int_buf = String.create 4 in + String.set int_buf 0 (Char.chr ( m land 0xff)); + String.set int_buf 1 (Char.chr ((m lsr 8) land 0xff)); + String.set int_buf 2 (Char.chr ((m lsr 16) land 0xff)); + String.set int_buf 3 (Char.chr ((m lsr 24) land 0xff)); + int_buf + +let decodeInt int_buf = + let b0 = Char.code (String.get int_buf 0) in + let b1 = Char.code (String.get int_buf 1) in + let b2 = Char.code (String.get int_buf 2) in + let b3 = Char.code (String.get int_buf 3) in + ((b3 lsl 24) lor (b2 lsl 16) lor (b1 lsl 8) lor b0) + +(*************************************************************************) +(* LOW-LEVEL IO *) +(*************************************************************************) + +let lost_connection () = + Lwt.fail (Util.Fatal "Lost connection with the server") + +let catch_io_errors th = + Lwt.catch th + (fun e -> + match e with + Unix.Unix_error(Unix.ECONNRESET, _, _) + | Unix.Unix_error(Unix.EPIPE, _, _) + (* Windows may also return the following errors... *) + | Unix.Unix_error(Unix.EINVAL, _, _) -> + (* Client has closed its end of the connection *) + lost_connection () + | _ -> + Lwt.fail e) + +(****) + +type connection = + { inputChannel : Unix.file_descr; + inputBuffer : string; + mutable inputLength : int; + outputChannel : Unix.file_descr; + outputBuffer : string; + mutable outputLength : int; + outputQueue : (string * int * int) list Queue.t; + mutable pendingOutput : bool; + mutable flowControl : bool; + mutable canWrite : bool; + mutable tokens : int; + mutable reader : unit Lwt.t option } + +let receivedBytes = ref 0. +let emittedBytes = ref 0. + +let inputBuffer_size = 8192 + +let fill_inputBuffer conn = + assert (conn.inputLength = 0); + catch_io_errors + (fun () -> + Lwt_unix.read conn.inputChannel conn.inputBuffer 0 inputBuffer_size + >>= (fun len -> + debugV (fun() -> + if len = 0 then + Util.msg "grab: EOF\n" + else + Util.msg "grab: %s\n" + (String.escaped (String.sub conn.inputBuffer 0 len))); + if len = 0 then + lost_connection () + else begin + receivedBytes := !receivedBytes +. float len; + conn.inputLength <- len; + Lwt.return () + end)) + +let rec grab_rec conn s pos len = + if conn.inputLength = 0 then begin + fill_inputBuffer conn >>= (fun () -> + grab_rec conn s pos len) + end else begin + let l = min (len - pos) conn.inputLength in + String.blit conn.inputBuffer 0 s pos l; + conn.inputLength <- conn.inputLength - l; + if conn.inputLength > 0 then + String.blit conn.inputBuffer l conn.inputBuffer 0 conn.inputLength; + if pos + l < len then + grab_rec conn s (pos + l) len + else + Lwt.return () + end + +let grab conn s len = + assert (len > 0); + assert (String.length s <= len); + grab_rec conn s 0 len + +let peek_without_blocking conn = + String.sub conn.inputBuffer 0 conn.inputLength + +(****) + +let outputBuffer_size = 8192 + +let rec send_output conn = + catch_io_errors + (fun () -> + Lwt_unix.write + conn.outputChannel conn.outputBuffer 0 conn.outputLength + >>= (fun len -> + debugV (fun() -> + Util.msg "dump: %s\n" + (String.escaped (String.sub conn.outputBuffer 0 len))); + emittedBytes := !emittedBytes +. float len; + conn.outputLength <- conn.outputLength - len; + if conn.outputLength > 0 then + String.blit + conn.outputBuffer len conn.outputBuffer 0 conn.outputLength; + Lwt.return ())) + +let rec fill_buffer_2 conn s pos len = + if conn.outputLength = outputBuffer_size then + send_output conn >>= (fun () -> + fill_buffer_2 conn s pos len) + else begin + let l = min (len - pos) (outputBuffer_size - conn.outputLength) in + String.blit s pos conn.outputBuffer conn.outputLength l; + conn.outputLength <- conn.outputLength + l; + if pos + l < len then + fill_buffer_2 conn s (pos + l) len + else + Lwt.return () + end + +let rec fill_buffer conn l = + match l with + (s, pos, len) :: rem -> + assert (pos >= 0); + assert (len >= 0); + assert (pos + len <= String.length s); + fill_buffer_2 conn s pos len >>= (fun () -> + fill_buffer conn rem) + | [] -> + Lwt.return () + +(* + Flow-control mechanism (only active under windows). + Only one side is allowed to send message at any given time. + Once it has finished sending message, a special message is sent + meaning that the destination is now allowed to send messages. + A side is allowed to send any number of messages, but will then + not be allowed to send before having received the same number of + messages. + This way, there can be no dead-lock with both sides trying + simultaneously to send some messages. Furthermore, multiple + messages can still be coalesced. +*) +let needFlowControl = windowsHack + +(* Loop until the output buffer is empty *) +let rec flush_buffer conn = + if conn.tokens <= 0 && conn.canWrite then begin + assert conn.flowControl; + conn.canWrite <- false; + debugE (fun() -> Util.msg "Sending write token\n"); + (* Special message allowing the other side to write *) + fill_buffer conn [(encodeInt 0, 0, 4)] >>= (fun () -> + flush_buffer conn) >>= (fun () -> + if windowsHack then begin + debugE (fun() -> Util.msg "Restarting reader\n"); + match conn.reader with + None -> + () + | Some r -> + conn.reader <- None; + Lwt.wakeup r () + end; + Lwt.return ()) + end else if conn.outputLength > 0 then + send_output conn >>= (fun () -> + flush_buffer conn) + else begin + conn.pendingOutput <- false; + Lwt.return () + end + +let rec msg_length l = + match l with + [] -> 0 + | (s, p, l)::r -> l + msg_length r + +(* Send all pending messages *) +let rec dump_rec conn = + try + let l = Queue.take conn.outputQueue in + fill_buffer conn l >>= (fun () -> + if conn.flowControl then conn.tokens <- conn.tokens - 1; + debugE (fun () -> Util.msg "Remaining tokens: %d\n" conn.tokens); + dump_rec conn) + with Queue.Empty -> + (* We wait a bit before flushing everything, so that other packets + send just afterwards can be coalesced *) + Lwt_unix.yield () >>= (fun () -> + try + ignore (Queue.peek conn.outputQueue); + dump_rec conn + with Queue.Empty -> + flush_buffer conn) + +(* Start the thread that write all pending messages, if this thread is + not running at this time *) +let signalSomethingToWrite conn = + if not conn.canWrite && conn.pendingOutput then + debugE + (fun () -> Util.msg "Something to write, but no write token (%d)\n" + conn.tokens); + if conn.pendingOutput = false && conn.canWrite then begin + conn.pendingOutput <- true; + Lwt.ignore_result (dump_rec conn) + end + +(* Add a message to the output queue and schedule its emission *) +(* A message is a list of fragments of messages, represented by triplets + (string, position in string, length) *) +let dump conn l = + Queue.add l conn.outputQueue; + signalSomethingToWrite conn; + Lwt.return () + +(* Invoked when a special message is received from the other side, + allowing this side to send messages *) +let allowWrites conn = + if conn.flowControl then begin + assert (conn.pendingOutput = false); + assert (not conn.canWrite); + conn.canWrite <- true; + debugE (fun () -> Util.msg "Received write token (%d)\n" conn.tokens); + (* Flush pending messages, if there are any *) + signalSomethingToWrite conn + end + +(* Invoked when a special message is received from the other side, + meaning that the other side does not block on write, and that + therefore there can be no dead-lock. *) +let disableFlowControl conn = + debugE (fun () -> Util.msg "Flow control disabled\n"); + conn.flowControl <- false; + conn.canWrite <- true; + conn.tokens <- 1; + (* We are allowed to write, so we flush pending messages, if there + are any *) + signalSomethingToWrite conn + +(****) + +(* Initialize the connection *) +let setupIO in_ch out_ch = + if not windowsHack then begin + Unix.set_nonblock in_ch; + Unix.set_nonblock out_ch + end; + { inputChannel = in_ch; + inputBuffer = String.create inputBuffer_size; + inputLength = 0; + outputChannel = out_ch; + outputBuffer = String.create outputBuffer_size; + outputLength = 0; + outputQueue = Queue.create (); + pendingOutput = false; + flowControl = true; + canWrite = true; + tokens = 1; + reader = None } + +(* XXX *) +module Thread = struct + + let unwindProtect f cleanup = + Lwt.catch f + (fun e -> + match e with + Util.Transient err | Util.Fatal err -> + debugT + (fun () -> + Util.msg + "Exception caught by Thread.unwindProtect: %s\n" err); + Lwt.catch (fun () -> cleanup e) (fun e' -> + Util.encodeException "Thread.unwindProtect" `Fatal e') + >>= (fun () -> + Lwt.fail e) + | _ -> + Lwt.fail e) + +end + +(*****************************************************************************) +(* MARSHALING *) +(*****************************************************************************) + +type tag = string + +type 'a marshalFunction = + 'a -> (string * int * int) list -> (string * int * int) list +type 'a unmarshalFunction = string -> 'a +type 'a marshalingFunctions = 'a marshalFunction * 'a unmarshalFunction + +let registeredSet = ref Util.StringSet.empty + +let rec first_chars len msg = + match msg with + [] -> + "" + | (s, p, l) :: rem -> + if l < len then + String.sub s p l ^ first_chars (len - l) rem + else + String.sub s p len + +(* An integer just a little smaller than the maximum representable in 30 bits *) +let hugeint = 1000000000 + +let safeMarshal marshalPayload tag data rem = + let (rem', length) = marshalPayload data rem in + if length > hugeint then begin + let start = first_chars (min length 10) rem' in + let start = if length > 10 then start ^ "..." else start in + let start = String.escaped start in + Util.msg "Fatal error in safeMarshal: sending too many (%d) bytes with tag %s and contents [%s]\n" length tag start; + raise (Util.Fatal ((Printf.sprintf + "Message payload too large (%d, %s, [%s]). \n" length tag start) + ^ "This is a bug in Unison; if it happens to you in a repeatable way, \n" + ^ "please post a report on the unison-users mailing list.")) + end; + let l = String.length tag in + debugE (fun() -> + let start = first_chars (min length 10) rem' in + let start = if length > 10 then start ^ "..." else start in + let start = String.escaped start in + Util.msg "send [%s] '%s' %d bytes\n" tag start length); + ((encodeInt (l + length), 0, 4) :: (tag, 0, l) :: rem') + +let safeUnmarshal unmarshalPayload tag buf = + let taglength = String.length tag in + let identifier = String.sub buf 0 (min taglength (String.length buf)) in + if identifier = tag then + unmarshalPayload buf taglength + else + raise (Util.Fatal + (Printf.sprintf "[safeUnmarshal] expected %s but got %s" + tag identifier)) + +let registerTag string = + if Util.StringSet.mem string !registeredSet then + raise (Util.Fatal (Printf.sprintf "tag %s is already registered" string)) + else + registeredSet := Util.StringSet.add string !registeredSet; + string + +let defaultMarshalingFunctions = + (fun data rem -> + try + let s = Marshal.to_string data [Marshal.No_sharing] in + let l = String.length s in + ((s, 0, String.length s) :: rem, l) + with Out_of_memory -> + raise (Util.Fatal + "Trying to transfer too much data in one go.\n\ + If this happens during update detection, try to\n\ + synchronize smaller pieces of the replica first\n\ + using the \"path\" directive.")), + (fun buf pos -> Marshal.from_string buf pos) + +let makeMarshalingFunctions payloadMarshalingFunctions string = + let (marshalPayload, unmarshalPayload) = payloadMarshalingFunctions in + let tag = registerTag string in + let marshal (data : 'a) rem = safeMarshal marshalPayload tag data rem in + let unmarshal buf = (safeUnmarshal unmarshalPayload tag buf : 'a) in + (marshal, unmarshal) + +(*****************************************************************************) +(* SERVER SETUP *) +(*****************************************************************************) + +(* BCPFIX: Now that we've beefed up the clroot data structure, shouldn't + these be part of it too? *) +let sshCmd = + Prefs.createString "sshcmd" "ssh" + ("!path to the ssh executable") + ("This preference can be used to explicitly set the name of the " + ^ "ssh executable (e.g., giving a full path name), if necessary.") + +let rshCmd = + Prefs.createString "rshcmd" "rsh" + ("*path to the rsh executable") + ("This preference can be used to explicitly set the name of the " + ^ "rsh executable (e.g., giving a full path name), if necessary.") + +let rshargs = + Prefs.createString "rshargs" "" + "*other arguments (if any) for remote shell command" + ("The string value of this preference will be passed as additional " + ^ "arguments (besides the host name and the name of the Unison " + ^ "executable on the remote system) to the \\verb|rsh| " + ^ "command used to invoke the remote server. " + ) + +let sshargs = + Prefs.createString "sshargs" "" + "!other arguments (if any) for remote shell command" + ("The string value of this preference will be passed as additional " + ^ "arguments (besides the host name and the name of the Unison " + ^ "executable on the remote system) to the \\verb|ssh| " + ^ "command used to invoke the remote server. " + ) + +let serverCmd = + Prefs.createString "servercmd" "" + ("!name of " ^ Uutil.myName ^ " executable on remote server") + ("This preference can be used to explicitly set the name of the " + ^ "Unison executable on the remote server (e.g., giving a full " + ^ "path name), if necessary.") + +let addversionno = + Prefs.createBool "addversionno" false + ("!add version number to name of " ^ Uutil.myName ^ " on server") + ("When this flag is set to {\\tt true}, Unison " + ^ "will use \\texttt{unison-\\ARG{currentversionnumber}} instead of " + ^ "just \\verb|unison| as the remote server command. This allows " + ^ "multiple binaries for different versions of unison to coexist " + ^ "conveniently on the same server: whichever version is run " + ^ "on the client, the same version will be selected on the server.") + +(* List containing the connected hosts and the file descriptors of + the communication. *) +(* +(* Perhaps the list would be better indexed by root + (host name [+ user name] [+ socket]) ... *) +let connectedHosts = ref [] + +(* Gets the Read/Write file descriptors for a host; + the connection must have been set up by canonizeRoot before calling *) +let hostConnection host = + try Safelist.assoc host !connectedHosts + with Not_found -> + raise(Util.Fatal "hostConnection") +*) + +(* connectedHosts is a list of command-line roots, their corresponding + canonical host names and canonical fspaths, and their connections. + Local command-line roots are not in the list. + Although there can only be one remote host per sync, it's possible + connectedHosts to hold more than one hosts if more than one sync is + performed. + It's also possible for there to be two connections open for the + same canonical root. +*) +let connectedHosts = ref [] +let hostConnection host = (* host must be canonical *) + let rec loop = function + [] -> raise(Util.Fatal "Remote.hostConnection") + | (cl,h,fspath,conn)::tl -> if h=host then conn else loop tl in + loop !connectedHosts + +let canonize clroot = (* connection for clroot must have been set up already *) + match clroot with + Clroot.ConnectLocal s -> (Common.Local, Fspath.canonize s) + | _ -> + let rec loop = function + [] -> raise(Util.Fatal "Remote.canonize") + | (cl,h,fspath,conn)::tl -> + if cl=clroot then (Common.Remote h,fspath) else loop tl in + loop !connectedHosts + + +(********************************************************************** + CLIENT/SERVER PROTOCOLS + **********************************************************************) + +(* +Each protocol has a name, a client side, and a server side. + +The server remembers the server side of each protocol in a table +indexed by protocol name. The function of the server is to wait for +the client to invoke a protocol, and carry out the appropriate server +side. + +Protocols are invoked on the client with arguments for the server side. +The result of the protocol is the result of the server side. In types, + + serverSide : 'a -> 'b + +That is, the server side takes arguments of type 'a from the client, +and returns a result of type 'b. + +A protocol is started by the client sending a Request packet and then a +packet containing the protocol name to the server. The server looks +up the server side of the protocol in its table. + +Next, the client sends a packet containing marshaled arguments for the +server side. + +The server unmarshals the arguments and invokes the server side with +the arguments from the client. + +When the server side completes it gives a result. The server marshals +the result and sends it to the client. (Instead of a result, the +server may also send back either a Transient or a Fatal error packet). +Finally, the client can receive the result packet from the server and +unmarshal it. + +The protocol is fully symmetric, so the server may send a Request +packet to invoke a function remotely on the client. In this case, the +two switch roles.) +*) + +let receivePacket conn = + (* Get the length of the packet *) + let int_buf = String.create 4 in + grab conn int_buf 4 >>= (fun () -> + let length = decodeInt int_buf in + assert (length >= 0); + (* Get packet *) + let buf = String.create length in + grab conn buf length >>= (fun () -> + (debugE (fun () -> + let start = + if length > 10 then (String.sub buf 0 10) ^ "..." + else String.sub buf 0 length in + let start = String.escaped start in + Util.msg "receive '%s' %d bytes\n" start length); + Lwt.return buf))) + +type servercmd = + connection -> string -> + ((string * int * int) list -> (string * int * int) list) Lwt.t +let serverCmds = ref (Util.StringMap.empty : servercmd Util.StringMap.t) + +type header = + NormalResult + | TransientExn of string + | FatalExn of string + | Request of string + +let ((marshalHeader, unmarshalHeader) : header marshalingFunctions) = + makeMarshalingFunctions defaultMarshalingFunctions "rsp" + +let processRequest conn id cmdName buf = + let cmd = + try Util.StringMap.find cmdName !serverCmds + with Not_found -> raise (Util.Fatal (cmdName ^ " not registered!")) + in + Lwt.try_bind (fun () -> cmd conn buf) + (fun marshal -> + debugE (fun () -> Util.msg "Sending result (id: %d)\n" (decodeInt id)); + dump conn ((id, 0, 4) :: marshalHeader NormalResult (marshal []))) + (function + Util.Transient s -> + debugE (fun () -> + Util.msg "Sending transient exception (id: %d)\n" (decodeInt id)); + dump conn ((id, 0, 4) :: marshalHeader (TransientExn s) []) + | Util.Fatal s -> + debugE (fun () -> + Util.msg "Sending fatal exception (id: %d)\n" (decodeInt id)); + dump conn ((id, 0, 4) :: marshalHeader (FatalExn s) []) + | e -> + Lwt.fail e) + +(* Message ids *) +type msgId = int +module MsgIdMap = Map.Make (struct type t = msgId let compare = compare end) +let ids = ref 1 +let newMsgId () = incr ids; if !ids = hugeint then ids := 2; !ids + +(* Threads waiting for a response from the other side *) +let receivers = ref MsgIdMap.empty + +let find_receiver id = + let thr = MsgIdMap.find id !receivers in + receivers := MsgIdMap.remove id !receivers; + thr + +(* Receiving thread: read a message and dispatch it to the right + thread or create a new thread to process requests. *) +let rec receive conn = + (if windowsHack && conn.canWrite then + let wait = Lwt.wait () in + assert (conn.reader = None); + conn.reader <- Some wait; + wait + else + Lwt.return ()) >>= (fun () -> + debugE (fun () -> Util.msg "Waiting for next message\n"); + (* Get the message ID *) + let id = String.create 4 in + grab conn id 4 >>= (fun () -> + let num_id = decodeInt id in + if num_id = 0 then begin + debugE (fun () -> Util.msg "Received the write permission\n"); + allowWrites conn; + receive conn + end else begin + if conn.flowControl then conn.tokens <- conn.tokens + 1; + debugE + (fun () -> Util.msg "Message received (id: %d) (tokens: %d)\n" + num_id conn.tokens); + (* Read the header *) + receivePacket conn >>= (fun buf -> + let req = unmarshalHeader buf in + begin match req with + Request cmdName -> + receivePacket conn >>= (fun buf -> + (* We yield before starting processing the request. + This way, the request may call [Lwt_unix.run] and this will + not block the receiving thread. *) + Lwt.ignore_result + (Lwt_unix.yield () >>= (fun () -> + processRequest conn id cmdName buf)); + receive conn) + | NormalResult -> + receivePacket conn >>= (fun buf -> + Lwt.wakeup (find_receiver num_id) buf; + receive conn) + | TransientExn s -> + debugV (fun() -> Util.msg "receive: Transient remote error '%s']" s); + Lwt.wakeup_exn (find_receiver num_id) (Util.Transient s); + receive conn + | FatalExn s -> + debugV (fun() -> Util.msg "receive: Fatal remote error '%s']" s); + Lwt.wakeup_exn (find_receiver num_id) (Util.Fatal ("Server: " ^ s)); + receive conn + end) + end)) + +let wait_for_reply id = + let res = Lwt.wait () in + receivers := MsgIdMap.add id res !receivers; + (* We yield to let the receiving thread restart. This way, the + thread may call [Lwt_unix.run] and this will not block the + receiving thread. *) + Lwt.catch + (fun () -> + res >>= (fun v -> Lwt_unix.yield () >>= (fun () -> Lwt.return v))) + (fun e -> Lwt_unix.yield () >>= (fun () -> Lwt.fail e)) + +let registerSpecialServerCmd + (cmdName : string) + marshalingFunctionsArgs + marshalingFunctionsResult + (serverSide : connection -> 'a -> 'b Lwt.t) + = + (* Check that this command name has not already been bound *) + if (Util.StringMap.mem cmdName !serverCmds) then + raise (Util.Fatal (cmdName ^ " already registered!")); + (* Create marshaling and unmarshaling functions *) + let ((marshalArgs,unmarshalArgs) : 'a marshalingFunctions) = + makeMarshalingFunctions marshalingFunctionsArgs (cmdName ^ "-args") in + let ((marshalResult,unmarshalResult) : 'b marshalingFunctions) = + makeMarshalingFunctions marshalingFunctionsResult (cmdName ^ "-res") in + (* Create a server function and remember it *) + let server conn buf = + let args = unmarshalArgs buf in + serverSide conn args >>= (fun answer -> + Lwt.return (marshalResult answer)) + in + serverCmds := Util.StringMap.add cmdName server !serverCmds; + (* Create a client function and return it *) + let client conn serverArgs = + let id = newMsgId () in (* Message ID *) + assert (id >= 0); (* tracking down an assert failure in receivePacket... *) + let request = + (encodeInt id, 0, 4) :: + marshalHeader (Request cmdName) (marshalArgs serverArgs []) + in + let reply = wait_for_reply id in + debugE (fun () -> Util.msg "Sending request (id: %d)\n" id); + dump conn request >>= (fun () -> + reply >>= (fun buf -> + Lwt.return (unmarshalResult buf))) + in + client + +let registerServerCmd name f = + registerSpecialServerCmd + name defaultMarshalingFunctions defaultMarshalingFunctions f + +(* RegisterHostCmd is a simpler version of registerClientServer [registerServerCmd?]. + It is used to create remote procedure calls: the only communication + between the client and server is the sending of arguments from + client to server, and the sending of the result from the server + to the client. Thus, server side does not need the file descriptors + for communication with the client. + + RegisterHostCmd recognizes the case where the server is the local + host, and it avoids socket communication in this case. +*) +let registerHostCmd cmdName cmd = + let serverSide = (fun _ args -> cmd args) in + let client0 = + registerServerCmd cmdName serverSide in + let client host args = + let conn = hostConnection host in + client0 conn args in + (* Return a function that runs either the proxy or the local version, + depending on whether the call is to the local host or a remote one *) + fun host args -> + match host with + "" -> cmd args + | _ -> client host args + +let hostOfRoot root = + match root with + (Common.Local, _) -> "" + | (Common.Remote host, _) -> host +let connectionToRoot root = hostConnection (hostOfRoot root) + +(* RegisterRootCmd is like registerHostCmd but it indexes connections by + root instead of host. *) +let registerRootCmd (cmdName : string) (cmd : (Fspath.t * 'a) -> 'b) = + let r = registerHostCmd cmdName cmd in + fun root args -> r (hostOfRoot root) ((snd root), args) + +let registerRootCmdWithConnection + (cmdName : string) (cmd : connection -> 'a -> 'b) = + let client0 = registerServerCmd cmdName cmd in + (* Return a function that runs either the proxy or the local version, + depending on whether the call is to the local host or a remote one *) + fun localRoot remoteRoot args -> + match (hostOfRoot localRoot) with + "" -> let conn = hostConnection (hostOfRoot remoteRoot) in + cmd conn args + | _ -> let conn = hostConnection (hostOfRoot localRoot) in + client0 conn args + + +(**************************************************************************** + BUILDING CONNECTIONS TO THE SERVER + ****************************************************************************) + +let connectionHeader = "Unison " ^ Uutil.myMajorVersion ^ "\n" + +let rec checkHeader conn prefix buffer pos len = + if pos = len then + Lwt.return () + else begin + (grab conn buffer 1 >>= (fun () -> + if buffer.[0] <> connectionHeader.[pos] then + let rest = peek_without_blocking conn in + Lwt.fail + (Util.Fatal + ("Received unexpected header from the server:\n \ + expected \"" + ^ String.escaped (* (String.sub connectionHeader 0 (pos + 1)) *) + connectionHeader + ^ "\" but received \"" ^ String.escaped (prefix ^ buffer ^ rest) ^ "\", \n" + ^ "which differs at \"" ^ String.escaped (prefix ^ buffer) ^ "\".\n" + ^ "This can happen because you have different versions of Unison\n" + ^ "installed on the client and server machines, or because\n" + ^ "your connection is failing and somebody is printing an error\n" + ^ "message, or because your remote login shell is printing\n" + ^ "something itself before starting Unison.")) + else + checkHeader conn (prefix ^ buffer) buffer (pos + 1) len)) + end + +(****) + +(* + Disable flow control if possible. + Both hosts must use non-blocking I/O (otherwise a dead-lock is + possible with ssh). +*) + +let negociateFlowControlLocal conn () = + if not needFlowControl then disableFlowControl conn; + Lwt.return needFlowControl + +let negociateFlowControlRemote = + registerServerCmd "negociateFlowControl" negociateFlowControlLocal + +let negociateFlowControl conn = + if not needFlowControl then + negociateFlowControlRemote conn () >>= (fun needed -> + if not needed then + negociateFlowControlLocal conn () >>= (fun _ -> Lwt.return ()) + else + Lwt.return ()) + else + Lwt.return () + +(****) + +let initConnection in_ch out_ch = + if not windowsHack then + ignore(Sys.set_signal Sys.sigpipe Sys.Signal_ignore); + let conn = setupIO in_ch out_ch in + conn.canWrite <- false; + checkHeader conn "" " " 0 (String.length connectionHeader) >>= (fun () -> + Lwt.ignore_result (receive conn); + negociateFlowControl conn >>= (fun () -> + Lwt.return conn)) + +let inetAddr host = + let targetHostEntry = Unix.gethostbyname host in + targetHostEntry.Unix.h_addr_list.(0) + +let buildSocketConnection host port = + Util.convertUnixErrorsToFatal "canonizeRoot" (fun () -> + let rec loop = function + [] -> + raise (Util.Fatal + (Printf.sprintf + "Can't find the IP address of the server (%s:%s)" host + port)) + | ai::r -> + (* create a socket to talk to the remote host *) + let socket = Unix.socket ai.Unix.ai_family ai.Unix.ai_socktype ai.Unix.ai_protocol in + begin try + Unix.connect socket ai.Unix.ai_addr; + initConnection socket socket + with + Unix.Unix_error (error, _, reason) -> + (if error != Unix.EAFNOSUPPORT then + Util.warn + (Printf.sprintf + "Can't connect to server (%s:%s): %s" host port reason); + loop r) + end + in loop (Unix.getaddrinfo host port [ Unix.AI_SOCKTYPE Unix.SOCK_STREAM ])) + +let buildShellConnection shell host userOpt portOpt rootName termInteract = + let remoteCmd = + (if Prefs.read serverCmd="" then Uutil.myName + else Prefs.read serverCmd) + ^ (if Prefs.read addversionno then "-" ^ Uutil.myMajorVersion else "") + ^ " -server" in + let userArgs = + match userOpt with + None -> [] + | Some user -> ["-l"; user] in + let portArgs = + match portOpt with + None -> [] + | Some port -> ["-p"; port] in + let shellCmd = + (if shell = "ssh" then + Prefs.read sshCmd + else if shell = "rsh" then + Prefs.read rshCmd + else + shell) in + let shellCmdArgs = + (if shell = "ssh" then + Prefs.read sshargs + else if shell = "rsh" then + Prefs.read rshargs + else + "") in + let preargs = + ([shellCmd]@userArgs at portArgs@ + [host]@ + (if shell="ssh" then ["-e none"] else [])@ + [shellCmdArgs;remoteCmd]) in + (* Split compound arguments at space chars, to make + create_process happy *) + let args = + Safelist.concat + (Safelist.map (fun s -> Util.splitIntoWords s ' ') preargs) in + let argsarray = Array.of_list args in + let (i1,o1) = Unix.pipe() in + let (i2,o2) = Unix.pipe() in + (* We need to make sure that there is only one reader and one + writer by pipe, so that, when one side of the connection + dies, the other side receives an EOF or a SIGPIPE. *) + Unix.set_close_on_exec i2; + Unix.set_close_on_exec o1; + (* We add CYGWIN=binmode to the environment before calling + ssh because the cygwin implementation on Windows sometimes + puts the pipe in text mode (which does end of line + translation). Specifically, if unison is invoked from + a DOS command prompt or other non-cygwin context, the pipe + goes into text mode; this does not happen if unison is + invoked from cygwin's bash. By setting CYGWIN=binmode + we force the pipe to remain in binary mode. *) + Unix.putenv "CYGWIN" "binmode"; + debug (fun ()-> Util.msg "Shell connection: %s (%s)\n" + shellCmd (String.concat ", " args)); + let term = + match termInteract with + None -> + ignore (Unix.create_process shellCmd argsarray i1 o2 Unix.stderr); + None + | Some callBack -> + fst (Terminal.create_session shellCmd argsarray i1 o2 Unix.stderr) + in + Unix.close i1; Unix.close o2; + begin match term, termInteract with + | Some fdTerm, Some callBack -> + Terminal.handlePasswordRequests fdTerm (callBack rootName) + | _ -> + () + end; + initConnection i2 o1 + +let canonizeOnServer = + registerServerCmd "canonizeOnServer" + (fun _ s -> Lwt.return (Os.myCanonicalHostName, Fspath.canonize s)) + +let canonizeRoot rootName clroot termInteract = + let finish ioServer s = + canonizeOnServer ioServer s >>= (fun (host, fspath) -> + connectedHosts := (clroot,host,fspath,ioServer)::(!connectedHosts); + Lwt.return (Common.Remote host,fspath)) in + let rec hostfspath = function + [] -> None + | (clroot',host,fspath,_)::tl -> + if clroot=clroot' + then Some(Lwt.return(Common.Remote host,fspath)) + else hostfspath tl in + match clroot with + Clroot.ConnectLocal s -> + Lwt.return (Common.Local, Fspath.canonize s) + | Clroot.ConnectBySocket(host,port,s) -> + (match hostfspath !connectedHosts with + Some x -> x + | None -> + buildSocketConnection host port >>= (fun ioServer -> + finish ioServer s)) + | Clroot.ConnectByShell(shell,host,userOpt,portOpt,s) -> + (match hostfspath !connectedHosts with + Some x -> x + | None -> + buildShellConnection + shell host userOpt portOpt rootName termInteract >>= + (fun ioServer -> finish ioServer s)) + +(* A new interface, useful for terminal interaction, it should + eventually replace canonizeRoot and buildShellConnection *) +(* A preconnection is None if there's nothing more to do, and Some if + terminal interaction might be required (for ssh password) *) +type preconnection = + (Unix.file_descr + * Unix.file_descr + * Unix.file_descr + * Unix.file_descr + * string option + * Unix.file_descr option + * Clroot.clroot + * int) +let openConnectionStart clroot = + match clroot with + Clroot.ConnectLocal s -> + None + | Clroot.ConnectBySocket(host,port,s) -> + (* This check isn't foolproof as the host in the clroot might not be canonical *) + if (Safelist.exists (fun (clroot',_,_,_) -> clroot=clroot') !connectedHosts) + then None + else begin + let ioServer = Lwt_unix.run(buildSocketConnection host port) in + let (host,fspath) = Lwt_unix.run(canonizeOnServer ioServer s) in + connectedHosts := (clroot,host,fspath,ioServer)::(!connectedHosts); + None + end + | Clroot.ConnectByShell(shell,host,userOpt,portOpt,s) -> + if (Safelist.exists (fun (clroot',_,_,_) -> clroot=clroot') !connectedHosts) + then None + else begin + let remoteCmd = + (if Prefs.read serverCmd="" then Uutil.myName + else Prefs.read serverCmd) + ^ (if Prefs.read addversionno then "-" ^ Uutil.myMajorVersion else "") + ^ " -server" in + let userArgs = + match userOpt with + None -> [] + | Some user -> ["-l"; user] in + let portArgs = + match portOpt with + None -> [] + | Some port -> ["-p"; port] in + let shellCmd = + (if shell = "ssh" then + Prefs.read sshCmd + else if shell = "rsh" then + Prefs.read rshCmd + else + shell) in + let shellCmdArgs = + (if shell = "ssh" then + Prefs.read sshargs + else if shell = "rsh" then + Prefs.read rshargs + else + "") in + let preargs = + ([shellCmd]@userArgs at portArgs@ + [host]@ + (if shell="ssh" then ["-e none"] else [])@ + [shellCmdArgs;remoteCmd]) in + (* Split compound arguments at space chars, to make + create_process happy *) + let args = + Safelist.concat + (Safelist.map (fun s -> Util.splitIntoWords s ' ') preargs) in + let argsarray = Array.of_list args in + let (i1,o1) = Unix.pipe() in + let (i2,o2) = Unix.pipe() in + (* We need to make sure that there is only one reader and one + writer by pipe, so that, when one side of the connection + dies, the other side receives an EOF or a SIGPIPE. *) + Unix.set_close_on_exec i2; + Unix.set_close_on_exec o1; + (* We add CYGWIN=binmode to the environment before calling + ssh because the cygwin implementation on Windows sometimes + puts the pipe in text mode (which does end of line + translation). Specifically, if unison is invoked from + a DOS command prompt or other non-cygwin context, the pipe + goes into text mode; this does not happen if unison is + invoked from cygwin's bash. By setting CYGWIN=binmode + we force the pipe to remain in binary mode. *) + Unix.putenv "CYGWIN" "binmode"; + debug (fun ()-> Util.msg "Shell connection: %s (%s)\n" + shellCmd (String.concat ", " args)); + let (term,pid) = + Terminal.create_session shellCmd argsarray i1 o2 Unix.stderr in + (* after terminal interact, remember to close i1 and o2 *) + Some(i1,i2,o1,o2,s,term,clroot,pid) + end + +let openConnectionPrompt = function + (i1,i2,o1,o2,s,Some fdTerm,clroot,pid) -> + let x = Terminal.termInput fdTerm i2 in + x + | _ -> None + +let openConnectionReply = function + (i1,i2,o1,o2,s,Some fdTerm,clroot,pid) -> + (fun response -> + (* FIX: should loop on write, watch for EINTR, etc. *) + ignore(Unix.write fdTerm (response ^ "\n") 0 (String.length response + 1))) + | _ -> (fun _ -> ()) + +let openConnectionEnd (i1,i2,o1,o2,s,_,clroot,pid) = + Unix.close i1; Unix.close o2; + let ioServer = Lwt_unix.run (initConnection i2 o1) in + let (host,fspath) = Lwt_unix.run(canonizeOnServer ioServer s) in + connectedHosts := (clroot,host,fspath,ioServer)::(!connectedHosts) + +let openConnectionCancel (i1,i2,o1,o2,s,fdopt,clroot,pid) = + try Unix.kill pid Sys.sigkill with _ -> (); + try Unix.close i1 with _ -> (); + try Unix.close i2 with _ -> (); + try Unix.close o1 with _ -> (); + try Unix.close o2 with _ -> (); + match fdopt with None -> () | Some fd -> (try Unix.close fd with _ -> ()) + +(****************************************************************************) +(* SERVER-MODE COMMAND PROCESSING LOOP *) +(****************************************************************************) + +let showWarningOnClient = + (registerServerCmd + "showWarningOnClient" + (fun _ str -> Lwt.return (Util.warn str))) + +let forwardMsgToClient = + (registerServerCmd + "forwardMsgToClient" + (fun _ str -> (*msg "forwardMsgToClient: %s\n" str; *) + Lwt.return (Trace.displayMessageLocally str))) + +(* This function loops, waits for commands, and passes them to + the relevant functions. *) +let commandLoop in_ch out_ch = + Trace.runningasserver := true; + (* Send header indicating to the client that it has successfully + connected to the server *) + let conn = setupIO in_ch out_ch in + try + Lwt_unix.run + (dump conn [(connectionHeader, 0, String.length connectionHeader)] + >>= (fun () -> + (* Set the local warning printer to make an RPC to the client and + show the warning there; ditto for the message printer *) + Util.warnPrinter := + Some (fun str -> Lwt_unix.run (showWarningOnClient conn str)); + Trace.messageForwarder := + Some (fun str -> Lwt_unix.run (forwardMsgToClient conn str)); + receive conn >>= + Lwt.wait)) +(* debug (fun () -> Util.msg "Should never happen\n") *) + with Util.Fatal "Lost connection with the server" -> + debug (fun () -> Util.msg "Connection closed by the client\n") + +let killServer = + Prefs.createBool "killserver" false + "!kill server when done (even when using sockets)" + ("When set to \\verb|true|, this flag causes Unison to kill the remote " + ^ "server process when the synchronization is finished. This behavior " + ^ "is the default for \\verb|ssh| connections, so this preference is not " + ^ "normally needed when running over \\verb|ssh|; it is provided so " + ^ "that socket-mode servers can be killed off after a single run of " + ^ "Unison, rather than waiting to accept future connections. (Some " + ^ "users prefer to start a remote socket server for each run of Unison, " + ^ "rather than leaving one running all the time.)") + +(* For backward compatibility *) +let _ = Prefs.alias killServer "killServer" + +(* Used by the socket mechanism: Create a socket on portNum and wait + for a request. Each request is processed by commandLoop. When a + session finishes, the server waits for another request. *) +let waitOnPort hostOpt port = + Util.convertUnixErrorsToFatal + "waiting on port" + (fun () -> + let host = match hostOpt with + Some host -> host + | None -> "" in + let rec loop = function + [] -> raise (Util.Fatal + (if host = "" then + Printf.sprintf "Can't bind socket to port %s" port + else + Printf.sprintf "Can't bind socket to port %s on host %s" port host)) + | ai::r -> + (* Open a socket to listen for queries *) + let socket = Unix.socket ai.Unix.ai_family ai.Unix.ai_socktype + ai.Unix.ai_protocol in + begin try + (* Allow reuse of local addresses for bind *) + Unix.setsockopt socket Unix.SO_REUSEADDR true; + (* Bind the socket to portnum on the local host *) + Unix.bind socket ai.Unix.ai_addr; + (* Start listening, allow up to 1 pending request *) + Unix.listen socket 1; + socket + with + Unix.Unix_error (error, _, reason) -> + (if error != Unix.EAFNOSUPPORT then + Util.msg + "Can't bind socket to port %s at address [%s]: %s\n" + port + (match ai.Unix.ai_addr with + Unix.ADDR_INET (addr, _) -> Unix.string_of_inet_addr addr + | _ -> assert false) + (Unix.error_message error); + loop r) + end in + let listening = loop (Unix.getaddrinfo host port [ Unix.AI_SOCKTYPE + Unix.SOCK_STREAM ; Unix.AI_PASSIVE ]) in + Util.msg "server started\n"; + while + (* Accept a connection *) + let (connected,_) = Os.accept listening in + Unix.setsockopt connected Unix.SO_KEEPALIVE true; + commandLoop connected connected; + (* The client has closed its end of the connection *) + begin try Unix.close connected with Unix.Unix_error _ -> () end; + not (Prefs.read killServer) + do () done) + +let beAServer () = + begin try + Sys.chdir (Sys.getenv "HOME") + with Not_found -> + Util.msg + "Environment variable HOME unbound: \ + executing server in current directory\n" + end; + commandLoop Unix.stdin Unix.stdout Deleted: branches/2.32/src/remote.mli =================================================================== --- trunk/src/remote.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/remote.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,102 +0,0 @@ -(* Unison file synchronizer: src/remote.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -module Thread : sig - val unwindProtect : (unit -> 'a Lwt.t) -> (exn -> unit Lwt.t) -> 'a Lwt.t -end - -(* Register a server function. The result is a function that takes a host - name as argument and either executes locally or else communicates with a - remote server, as appropriate. (Calling registerServerCmd also has the - side effect of registering the command under the given name, so that when - we are running as a server it can be looked up and executed when - requested by a remote client.) *) -val registerHostCmd : - string (* command name *) - -> ('a -> 'b Lwt.t) (* local command *) - -> ( string (* -> host *) - -> 'a (* arguments *) - -> 'b Lwt.t) (* -> (suspended) result *) - -(* A variant of registerHostCmd, for constructing a remote command to be - applied to a particular root (host + fspath). - - - - A naming convention: when a `root command' is built from a - corresponding `local command', we name the two functions - OnRoot and Local *) -val registerRootCmd : - string (* command name *) - -> ((Fspath.t * 'a) -> 'b Lwt.t) (* local command *) - -> ( Common.root (* -> root *) - -> 'a (* additional arguments *) - -> 'b Lwt.t) (* -> (suspended) result *) - -(* Enter "server mode", reading and processing commands from a remote - client process until killed *) -val beAServer : unit -> unit -val waitOnPort : string option -> string -> unit - -(* Whether the server should be killed when the client terminates *) -val killServer : bool Prefs.t - -(* Establish a connection to the remote server (if any) corresponding - to the root and return the canonical name of the root *) -val canonizeRoot : - string -> Clroot.clroot -> (string -> string -> string) option -> - Common.root Lwt.t - -(* Statistics *) -val emittedBytes : float ref -val receivedBytes : float ref - -(* Establish a connection to the server. - First call openConnectionStart, then loop: - call openConnectionPrompt, if you get a prompt, - respond with openConnectionReply if desired. - After you get None from openConnectionPrompt, - call openConnectionEnd. - Call openConnectionCancel to abort the connection. -*) -type preconnection -val openConnectionStart : Clroot.clroot -> preconnection option -val openConnectionPrompt : preconnection -> string option -val openConnectionReply : preconnection -> string -> unit -val openConnectionEnd : preconnection -> unit -val openConnectionCancel : preconnection -> unit - -(* return the canonical name of the root. The connection - to the root must have already been established by - the openConnection sequence. *) -val canonize : Clroot.clroot -> Common.root - -(****) - -type msgId = int -module MsgIdMap : Map.S with type key = msgId -val newMsgId : unit -> msgId - -type connection -val connectionToRoot : Common.root -> connection - -val registerServerCmd : - string -> (connection -> 'a -> 'b Lwt.t) -> connection -> 'a -> 'b Lwt.t -val registerSpecialServerCmd : - string -> - ('a -> (string * int * int) list -> (string * int * int) list * int) * - (string -> int -> 'a) -> - ('b -> (string * int * int) list -> (string * int * int) list * int) * - (string -> int -> 'b) -> - (connection -> 'a -> 'b Lwt.t) -> connection -> 'a -> 'b Lwt.t -val defaultMarshalingFunctions : - ('a -> (string * int * int) list -> (string * int * int) list * int) * - (string -> int -> 'b) -val encodeInt : int -> string -val decodeInt : string -> int -val registerRootCmdWithConnection : - string (* command name *) - -> (connection -> 'a -> 'b Lwt.t) (* local command *) - -> Common.root (* root on which the command is executed *) - -> Common.root (* other root *) - -> 'a (* additional arguments *) - -> 'b Lwt.t (* result *) Copied: branches/2.32/src/remote.mli (from rev 320, trunk/src/remote.mli) =================================================================== --- branches/2.32/src/remote.mli (rev 0) +++ branches/2.32/src/remote.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,102 @@ +(* Unison file synchronizer: src/remote.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +module Thread : sig + val unwindProtect : (unit -> 'a Lwt.t) -> (exn -> unit Lwt.t) -> 'a Lwt.t +end + +(* Register a server function. The result is a function that takes a host + name as argument and either executes locally or else communicates with a + remote server, as appropriate. (Calling registerServerCmd also has the + side effect of registering the command under the given name, so that when + we are running as a server it can be looked up and executed when + requested by a remote client.) *) +val registerHostCmd : + string (* command name *) + -> ('a -> 'b Lwt.t) (* local command *) + -> ( string (* -> host *) + -> 'a (* arguments *) + -> 'b Lwt.t) (* -> (suspended) result *) + +(* A variant of registerHostCmd, for constructing a remote command to be + applied to a particular root (host + fspath). + - + + A naming convention: when a `root command' is built from a + corresponding `local command', we name the two functions + OnRoot and Local *) +val registerRootCmd : + string (* command name *) + -> ((Fspath.t * 'a) -> 'b Lwt.t) (* local command *) + -> ( Common.root (* -> root *) + -> 'a (* additional arguments *) + -> 'b Lwt.t) (* -> (suspended) result *) + +(* Enter "server mode", reading and processing commands from a remote + client process until killed *) +val beAServer : unit -> unit +val waitOnPort : string option -> string -> unit + +(* Whether the server should be killed when the client terminates *) +val killServer : bool Prefs.t + +(* Establish a connection to the remote server (if any) corresponding + to the root and return the canonical name of the root *) +val canonizeRoot : + string -> Clroot.clroot -> (string -> string -> string) option -> + Common.root Lwt.t + +(* Statistics *) +val emittedBytes : float ref +val receivedBytes : float ref + +(* Establish a connection to the server. + First call openConnectionStart, then loop: + call openConnectionPrompt, if you get a prompt, + respond with openConnectionReply if desired. + After you get None from openConnectionPrompt, + call openConnectionEnd. + Call openConnectionCancel to abort the connection. +*) +type preconnection +val openConnectionStart : Clroot.clroot -> preconnection option +val openConnectionPrompt : preconnection -> string option +val openConnectionReply : preconnection -> string -> unit +val openConnectionEnd : preconnection -> unit +val openConnectionCancel : preconnection -> unit + +(* return the canonical name of the root. The connection + to the root must have already been established by + the openConnection sequence. *) +val canonize : Clroot.clroot -> Common.root + +(****) + +type msgId = int +module MsgIdMap : Map.S with type key = msgId +val newMsgId : unit -> msgId + +type connection +val connectionToRoot : Common.root -> connection + +val registerServerCmd : + string -> (connection -> 'a -> 'b Lwt.t) -> connection -> 'a -> 'b Lwt.t +val registerSpecialServerCmd : + string -> + ('a -> (string * int * int) list -> (string * int * int) list * int) * + (string -> int -> 'a) -> + ('b -> (string * int * int) list -> (string * int * int) list * int) * + (string -> int -> 'b) -> + (connection -> 'a -> 'b Lwt.t) -> connection -> 'a -> 'b Lwt.t +val defaultMarshalingFunctions : + ('a -> (string * int * int) list -> (string * int * int) list * int) * + (string -> int -> 'b) +val encodeInt : int -> string +val decodeInt : string -> int +val registerRootCmdWithConnection : + string (* command name *) + -> (connection -> 'a -> 'b Lwt.t) (* local command *) + -> Common.root (* root on which the command is executed *) + -> Common.root (* other root *) + -> 'a (* additional arguments *) + -> 'b Lwt.t (* result *) Deleted: branches/2.32/src/sortri.ml =================================================================== --- trunk/src/sortri.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/sortri.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,133 +0,0 @@ -(* Unison file synchronizer: src/sortri.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -open Common - -let dbgsort = Util.debug "sort" - -(* Preferences *) - -let bysize = - Prefs.createBool "sortbysize" false - "!list changed files by size, not name" - ("When this flag is set, the user interface will list changed files " - ^ "by size (smallest first) rather than by name. This is useful, for " - ^ "example, for synchronizing over slow links, since it puts very " - ^ "large files at the end of the list where they will not prevent " - ^ "smaller files from being transferred quickly.\n\n" - ^ "This preference (as well as the other sorting flags, but not the " - ^ "sorting preferences that require patterns as arguments) can be " - ^ "set interactively and temporarily using the 'Sort' menu in the " - ^ "graphical user interface.") - -let newfirst = - Prefs.createBool "sortnewfirst" false - "!list new before changed files" - ("When this flag is set, the user interface will list newly created " - ^ "files before all others. This is useful, for example, for checking " - ^ "that newly created files are not `junk', i.e., ones that should be " - ^ "ignored or deleted rather than synchronized.") - -let sortfirst = Pred.create "sortfirst" ~advanced:true - ("Each argument to \\texttt{sortfirst} is a pattern \\ARG{pathspec}, " - ^ "which describes a set of paths. " - ^ "Files matching any of these patterns will be listed first in the " - ^ "user interface. " - ^ "The syntax of \\ARG{pathspec} is " - ^ "described in \\sectionref{pathspec}{Path Specification}.") - -let sortlast = Pred.create "sortlast" ~advanced:true - ("Similar to \\verb|sortfirst|, except that files matching one of these " - ^ "patterns will be listed at the very end.") - -type savedPrefs = {nf:bool; bs:bool; sf:string list; sl:string list} -let savedPrefs = ref(None) - -let saveSortingPrefs () = - if !savedPrefs = None then - savedPrefs := Some { - sf = Pred.extern sortfirst; - sl = Pred.extern sortlast; - bs = Prefs.read bysize; - nf = Prefs.read newfirst } - -let restoreDefaultSettings () = - match !savedPrefs with - None -> () - | Some {nf=nf; bs=bs; sf=sf; sl=sl} -> - Prefs.set newfirst nf; - Prefs.set bysize bs; - Pred.intern sortfirst sf; - Pred.intern sortlast sl - -let zeroSortingPrefs () = - Prefs.set newfirst false; - Prefs.set bysize false; - Pred.intern sortfirst []; - Pred.intern sortlast [] - -(* ------------------- *) - -let sortByName () = - saveSortingPrefs(); - zeroSortingPrefs() - -let sortBySize () = - saveSortingPrefs(); - zeroSortingPrefs(); - Prefs.set bysize true - -let sortNewFirst () = - saveSortingPrefs(); - Prefs.set newfirst (not (Prefs.read newfirst)) - -(* ---------------------------------------------------------------------- *) -(* Main sorting functions *) - -let shouldSortFirst ri = - Pred.test sortfirst (Path.toString ri.path) -let shouldSortLast ri = - Pred.test sortlast (Path.toString ri.path) - -let newItem ri = - let newItem1 ri = - match ri.replicas with - Different((_, `Created, _, _), _, _, _) -> true - | _ -> false in - let newItem2 ri = - match ri.replicas with - Different(_, (_, `Created, _, _), _, _) -> true - | _ -> false - in newItem1 ri || newItem2 ri - -(* Should these go somewhere else? *) -let rec combineCmp = function - [] -> 0 - | c::cs -> if c<>0 then c else combineCmp cs -let invertCmp c = c * -1 - -let compareReconItems () = - let newfirst = Prefs.read newfirst in - fun ri1 ri2 -> - let pred p = - let b1 = p ri1 in let b2 = p ri2 in - if b1 && b2 then 0 else if b1 then -1 else if b2 then 1 else 0 in - let cmp = - combineCmp [ - pred problematic; - pred shouldSortFirst; - invertCmp (pred shouldSortLast); - if newfirst then pred newItem else 0; - (if Prefs.read bysize then - let l1 = Common.riLength ri1 in - let l2 = Common.riLength ri2 in - if l1 Util.msg "%s <= %s --> %d\n" - (Path.toString ri1.path) (Path.toString ri2.path) cmp); - cmp - -let sortReconItems items = Safelist.stable_sort (compareReconItems()) items - Copied: branches/2.32/src/sortri.ml (from rev 320, trunk/src/sortri.ml) =================================================================== --- branches/2.32/src/sortri.ml (rev 0) +++ branches/2.32/src/sortri.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,148 @@ +(* Unison file synchronizer: src/sortri.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +open Common + +let dbgsort = Util.debug "sort" + +(* Preferences *) + +let bysize = + Prefs.createBool "sortbysize" false + "!list changed files by size, not name" + ("When this flag is set, the user interface will list changed files " + ^ "by size (smallest first) rather than by name. This is useful, for " + ^ "example, for synchronizing over slow links, since it puts very " + ^ "large files at the end of the list where they will not prevent " + ^ "smaller files from being transferred quickly.\n\n" + ^ "This preference (as well as the other sorting flags, but not the " + ^ "sorting preferences that require patterns as arguments) can be " + ^ "set interactively and temporarily using the 'Sort' menu in the " + ^ "graphical user interface.") + +let newfirst = + Prefs.createBool "sortnewfirst" false + "!list new before changed files" + ("When this flag is set, the user interface will list newly created " + ^ "files before all others. This is useful, for example, for checking " + ^ "that newly created files are not `junk', i.e., ones that should be " + ^ "ignored or deleted rather than synchronized.") + +let sortfirst = Pred.create "sortfirst" ~advanced:true + ("Each argument to \\texttt{sortfirst} is a pattern \\ARG{pathspec}, " + ^ "which describes a set of paths. " + ^ "Files matching any of these patterns will be listed first in the " + ^ "user interface. " + ^ "The syntax of \\ARG{pathspec} is " + ^ "described in \\sectionref{pathspec}{Path Specification}.") + +let sortlast = Pred.create "sortlast" ~advanced:true + ("Similar to \\verb|sortfirst|, except that files matching one of these " + ^ "patterns will be listed at the very end.") + +type savedPrefs = {nf:bool; bs:bool; sf:string list; sl:string list} +let savedPrefs = ref(None) + +let saveSortingPrefs () = + if !savedPrefs = None then + savedPrefs := Some { + sf = Pred.extern sortfirst; + sl = Pred.extern sortlast; + bs = Prefs.read bysize; + nf = Prefs.read newfirst } + +let restoreDefaultSettings () = + match !savedPrefs with + None -> () + | Some {nf=nf; bs=bs; sf=sf; sl=sl} -> + Prefs.set newfirst nf; + Prefs.set bysize bs; + Pred.intern sortfirst sf; + Pred.intern sortlast sl + +let zeroSortingPrefs () = + Prefs.set newfirst false; + Prefs.set bysize false; + Pred.intern sortfirst []; + Pred.intern sortlast [] + +(* ------------------- *) + +let sortByName () = + saveSortingPrefs(); + zeroSortingPrefs() + +let sortBySize () = + saveSortingPrefs(); + zeroSortingPrefs(); + Prefs.set bysize true + +let sortNewFirst () = + saveSortingPrefs(); + Prefs.set newfirst (not (Prefs.read newfirst)) + +(* ---------------------------------------------------------------------- *) +(* Main sorting functions *) + +let shouldSortFirst ri = + Pred.test sortfirst (Path.toString ri.path) +let shouldSortLast ri = + Pred.test sortlast (Path.toString ri.path) + +let newItem ri = + let newItem1 ri = + match ri.replicas with + Different((_, `Created, _, _), _, _, _) -> true + | _ -> false in + let newItem2 ri = + match ri.replicas with + Different(_, (_, `Created, _, _), _, _) -> true + | _ -> false + in newItem1 ri || newItem2 ri + +(* Should these go somewhere else? *) +let rec combineCmp = function + [] -> 0 + | c::cs -> if c<>0 then c else combineCmp cs +let invertCmp c = c * -1 + +let compareReconItems () = + let newfirst = Prefs.read newfirst in + fun ri1 ri2 -> + let pred p = + let b1 = p ri1 in let b2 = p ri2 in + if b1 && b2 then 0 else if b1 then -1 else if b2 then 1 else 0 in + let cmp = + combineCmp [ + pred problematic; + pred shouldSortFirst; + invertCmp (pred shouldSortLast); + if newfirst then pred newItem else 0; + (if Prefs.read bysize then + let l1 = Common.riLength ri1 in + let l2 = Common.riLength ri2 in + if l1 Util.msg "%s <= %s --> %d\n" + (Path.toString ri1.path) (Path.toString ri2.path) cmp); + cmp + +let sortReconItems items = Safelist.stable_sort (compareReconItems()) items + Deleted: branches/2.32/src/sortri.mli =================================================================== --- trunk/src/sortri.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/sortri.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,19 +0,0 @@ -(* Unison file synchronizer: src/sortri.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* Sort a list of recon items according to the current setting of - various preferences (defined in sort.ml, and accessible from the - profile and via the functions below) *) -val sortReconItems : Common.reconItem list -> Common.reconItem list - -(* The underlying comparison function for sortReconItems (in case we - want to use it to sort something else, like stateItems in the UI) *) -val compareReconItems : unit -> (Common.reconItem -> Common.reconItem -> int) - -(* Set the global preferences so that future calls to sortReconItems - will sort in particular orders *) -val sortByName : unit -> unit -val sortBySize : unit -> unit -val sortNewFirst : unit -> unit -val restoreDefaultSettings : unit -> unit - Copied: branches/2.32/src/sortri.mli (from rev 320, trunk/src/sortri.mli) =================================================================== --- branches/2.32/src/sortri.mli (rev 0) +++ branches/2.32/src/sortri.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,19 @@ +(* Unison file synchronizer: src/sortri.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +(* Sort a list of recon items according to the current setting of + various preferences (defined in sort.ml, and accessible from the + profile and via the functions below) *) +val sortReconItems : Common.reconItem list -> Common.reconItem list + +(* The underlying comparison function for sortReconItems (in case we + want to use it to sort something else, like stateItems in the UI) *) +val compareReconItems : unit -> (Common.reconItem -> Common.reconItem -> int) + +(* Set the global preferences so that future calls to sortReconItems + will sort in particular orders *) +val sortByName : unit -> unit +val sortBySize : unit -> unit +val sortNewFirst : unit -> unit +val restoreDefaultSettings : unit -> unit + Deleted: branches/2.32/src/stasher.ml =================================================================== --- trunk/src/stasher.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/stasher.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,500 +0,0 @@ -(* Unison file synchronizer: src/stasher.ml *) -(* $I2: Last modified by lescuyer *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* --------------------------------------------------------------------------*) -(* Preferences for backing up and stashing *) - -let debug = Util.debug "stasher" -let verbose = Util.debug "stasher+" - -let backuplocation = - Prefs.createString "backuploc" "central" - "!where backups are stored ('local' or 'central')" - ("This preference determines whether backups should be kept locally, near the " - ^ "original files, or" - ^" in a central directory specified by the \\texttt{backupdir} " - ^"preference. If set to \\verb|local|, backups will be kept in " - ^"the same directory as the original files, and if set to \\verb|central|," - ^" \\texttt{backupdir} will be used instead.") - -let _ = Prefs.alias backuplocation "backuplocation" - -let backup = - Pred.create "backup" ~advanced:true - ("Including the preference \\texttt{-backup \\ARG{pathspec}} " - ^ "causes Unison to keep backup files for each path that matches " - ^ "\\ARG{pathspec}. These backup files are kept in the " - ^ "directory specified by the \\verb|backuplocation| preference. The backups are named " - ^ "according to the \\verb|backupprefix| and \\verb|backupsuffix| preferences." - ^ " The number of versions that are kept is determined by the " - ^ "\\verb|maxbackups| preference." - ^ "\n\n The syntax of \\ARG{pathspec} is described in " - ^ "\\sectionref{pathspec}{Path Specification}.") - -let _ = Pred.alias backup "mirror" - -let backupnot = - Pred.create "backupnot" ~advanced:true - ("The values of this preference specify paths or individual files or" - ^ " regular expressions that should {\\em not} " - ^ "be backed up, even if the {\\tt backup} preference selects " - ^ "them---i.e., " - ^ "it selectively overrides {\\tt backup}. The same caveats apply here " - ^ "as with {\\tt ignore} and {\tt ignorenot}.") - -let _ = Pred.alias backupnot "mirrornot" - -let shouldBackup p = - let s = (Path.toString p) in - Pred.test backup s && not (Pred.test backupnot s) - -let backupprefix = - Prefs.createString "backupprefix" ".bak.$VERSION." - "!prefix for the names of backup files" - ("When a backup for a file \\verb|NAME| is created, it is stored " - ^ "in a directory specified by \\texttt{backuplocation}, in a file called " - ^ "\\texttt{backupprefix}\\verb|NAME|\\texttt{backupsuffix}." - ^ " \\texttt{backupprefix} can include a directory name (causing Unison to " - ^ "keep all backup files for a given directory in a subdirectory with this name), and both " - ^ " \\texttt{backupprefix} and \\texttt{backupsuffix} can contain the string" - ^ "\\ARG{\\$VERSION}, which will be replaced by the \\emph{age} of the backup " - ^ "(1 for the most recent, 2 for the second most recent, and so on...)." - ^ " This keyword is ignored if it appears in a directory name" - ^ " in the prefix; if it does not appear anywhere" - ^ " in the prefix or the suffix, it will be automatically" - ^ " placed at the beginning of the suffix. " - ^ "\n\n" - ^ "One thing to be careful of: If the {\\tt backuploc} preference is set " - ^ "to {\\tt local}, Unison will automatically ignore {\\em all} files " - ^ "whose prefix and suffix match {\\tt backupprefix} and {\\tt backupsuffix}. " - ^ "So be careful to choose values for these preferences that are sufficiently " - ^ "different from the names of your real files.") - -let backupsuffix = - Prefs.createString "backupsuffix" "" - "!a suffix to be added to names of backup files" - ("See \\texttt{backupprefix} for full documentation.") - -let backups = - Prefs.createBool "backups" false - "!keep backup copies of all files (see also 'backup')" - ("Setting this flag to true is equivalent to " - ^" setting \\texttt{backuplocation} to \\texttt{local}" - ^" and \\texttt{backup} to \\verb|Name *|.") - -(* The following function is used to express the old backup preference, if set, - in the terms of the new preferences *) -let translateOldPrefs () = - match (Pred.extern backup, Pred.extern backupnot, Prefs.read backups) with - ([], [], true) -> - debug (fun () -> - Util.msg "backups preference set: translated into backup and backuplocation\n"); - Pred.intern backup ["Name *"]; - Prefs.set backuplocation "local" - | (_, _, false) -> - () - | _ -> raise (Util.Fatal ( "Both old 'backups' preference and " - ^ "new 'backup' preference are set!")) - -let maxbackups = - Prefs.createInt "maxbackups" 2 - "!number of backed up versions of a file" - ("This preference specifies the number of backup versions that will " - ^ "be kept by unison, for each path that matches the predicate " - ^ "\\verb|backup|. The default is 2.") - -let _ = Prefs.alias maxbackups "mirrorversions" -let _ = Prefs.alias maxbackups "backupversions" - -let backupdir = - Prefs.createString "backupdir" "" - "!directory for storing centralized backups" - ("If this preference is set, Unison will use it as the name of the " - ^ "directory used to store backup files specified by " - ^ "the {\\tt backup} preference, when {\\tt backuplocation} is set" - ^ " to \\verb|central|. It is checked {\\em after} the " - ^ "{\\tt UNISONBACKUPDIR} environment variable.") - -let backupDirectory () = - Util.convertUnixErrorsToTransient "backupDirectory()" (fun () -> - try Fspath.canonize (Some (Unix.getenv "UNISONBACKUPDIR")) - with Not_found -> - try Fspath.canonize (Some (Unix.getenv "UNISONMIRRORDIR")) - with Not_found -> - if Prefs.read backupdir <> "" - then Fspath.canonize (Some (Prefs.read backupdir)) - else Os.fileInUnisonDir "backup") - -let backupcurrent = - Pred.create "backupcurr" ~advanced:true - ("Including the preference \\texttt{-backupcurr \\ARG{pathspec}} " - ^" causes Unison to keep a backup of the {\\em current} version of every file " - ^ "matching \\ARG{pathspec}. " - ^" This file will be saved as a backup with version number 000. Such" - ^" backups can be used as inputs to external merging programs, for instance. See " - ^ "the documentatation for the \\verb|merge| preference." - ^" For more details, see \\sectionref{merge}{Merging Conflicting Versions}." - ^"\n\n The syntax of \\ARG{pathspec} is described in " - ^ "\\sectionref{pathspec}{Path Specification}.") - -let backupcurrentnot = - Pred.create "backupcurrnot" ~advanced:true - "Exceptions to \\verb|backupcurr|, like the \\verb|ignorenot| preference." - -let shouldBackupCurrent p = - (* BCP: removed next line [Apr 2007]: causes ALL mergeable files to be backed - up, which is probably not what users want -- the backupcurrent - switch should be used instead. - Globals.shouldMerge p || *) - (let s = Path.toString p in - Pred.test backupcurrent s && not (Pred.test backupcurrentnot s)) - -let _ = Pred.alias backupcurrent "backupcurrent" -let _ = Pred.alias backupcurrentnot "backupcurrentnot" - -(* ---------------------------------------------------------------------------*) - -(* NB: We use Str.regexp here because we need group matching to retrieve - and increment version numbers from backup file names. We only use - it here, though: to check if a path should be backed up or ignored, we - use Rx instead. (This is important because the Str regexp functions are - terribly slow.) *) - -(* A tuple of string option * string * string, describing a regular - expression that matches the filenames of unison backups according - to the current preferences. The first regexp is an option to match - the local directory, if any, in which backups are stored; the second - one matches the prefix, the third the suffix. - - Note that we always use forward slashes here (rather than using backslashes - when running on windows) because we are constructing rx's that are going to - be matched against Path.t's. (Strictly speaking, we ought to ask the Path - module what the path separator character is, rather than assuming it is slash, - but this is never going to change.) - *) -let backup_rx () = - let version_rx = "\\([0-9]+\\)" in - let prefix = Prefs.read backupprefix in - let suffix = Str.quote (Prefs.read backupsuffix) in - let (udir, uprefix) = - ((match Filename.dirname prefix with - | "." -> "" - | s -> (Fileutil.backslashes2forwardslashes s)^"/"), - Filename.basename prefix) in - let (dir, prefix) = - ((match udir with "" -> None | _ -> Some(Str.quote udir)), Str.quote uprefix) in - if Str.string_match (Str.regexp ".*\\\\\\$VERSION.*") (prefix^suffix) 0 then - (dir, - Str.global_replace (Str.regexp "\\\\\\$VERSION") version_rx prefix, - Str.global_replace (Str.regexp "\\\\\\$VERSION") version_rx suffix) - else - raise (Util.Fatal "Either backupprefix or backupsuffix must contain '$VERSION'") - -(* We ignore files whose name ends in .unison.bak, since people may still have these - lying around from using previous versions of Unison. *) -let oldBackupPrefPathspec = "Name *.unison.bak" - -(* This function creates Rx regexps based on the preferences to ignore - backups of old and current versions. *) -let addBackupFilesToIgnorePref () = - let (dir_rx, prefix_rx, suffix_rx) = backup_rx() in - let regexp_to_rx s = - Str.global_replace (Str.regexp "\\\\(") "" - (Str.global_replace (Str.regexp "\\\\)") "" s) in - let (full, dir) = - let d = - match dir_rx with - None -> "/" - | Some s -> regexp_to_rx s in - let p = regexp_to_rx prefix_rx in - let s = regexp_to_rx suffix_rx in - debug (fun() -> Util.msg "d = %s\n" d); - ("(.*/)?"^p^".*"^s, "(.*/)?"^(String.sub d 0 (String.length d - 1))) in - let theRegExp = - match dir_rx with - None -> "Regex " ^ full - | Some _ -> "Regex " ^ dir in - - Globals.addRegexpToIgnore oldBackupPrefPathspec; - if Prefs.read backuplocation = "local" then begin - debug (fun () -> - Util.msg "New pattern being added to ignore preferences (for backup files):\n %s\n" - theRegExp); - Globals.addRegexpToIgnore theRegExp - end - -(* We use references for functions that compute the prefixes and suffixes - in order to avoid using functions from the Str module each time we need them. *) -let make_prefix = ref (fun i -> assert false) -let make_suffix = ref (fun i -> assert false) - -(* This function updates the function used to create prefixes and suffixes - for naming backup files, according to the preferences. *) -let updateBackupNamingFunctions () = - let makeFun s = - match Str.full_split (Str.regexp "\\$VERSION") s with - [] -> (fun _ -> "") - | [Str.Text t] -> - (fun _ -> t) - | [Str.Delim _; Str.Text t] -> - (fun i -> Printf.sprintf "%d%s" i t) - | [Str.Text t; Str.Delim _] -> - (fun i -> Printf.sprintf "%s%d" t i) - | [Str.Text t; Str.Delim _; Str.Text t'] -> - (fun i -> Printf.sprintf "%s%d%s" t i t') - | _ -> raise (Util.Fatal ( - "The tag $VERSION should only appear " - ^"once in the backupprefix and backupsuffix preferences.")) in - - make_prefix := makeFun (Prefs.read backupprefix); - make_suffix := makeFun (Prefs.read backupsuffix); - debug (fun () -> Util.msg - "Prefix and suffix regexps for backup filenames have been updated\n") - -(*------------------------------------------------------------------------------------*) - -let makeBackupName path i = - (* if backups are kept centrally, the current version has exactly - the same name as the original, for convenience. *) - if i=0 && Prefs.read backuplocation = "central" then - path - else - Path.addSuffixToFinalName - (Path.addPrefixToFinalName path (!make_prefix i)) - (!make_suffix i) - -let stashDirectory fspath = - match Prefs.read backuplocation with - "central" -> backupDirectory () - | "local" -> fspath - | _ -> raise (Util.Fatal ("backuplocation preference should be set" - ^"to central or local.")) - -let showContent typ fspath path = - match typ with - | `FILE -> Fingerprint.toString (Fingerprint.file fspath path) - | `SYMLINK -> Os.readLink fspath path - | `DIRECTORY -> "DIR" - | `ABSENT -> "ABSENT" - -(* Generates a file name for a backup file. If backup file already exists, - the old file will be renamed with the count incremented. The newest - backup file is always the one with version number 1, larger numbers mean - older files. *) -(* BCP: Note that the way we keep bumping up the backup numbers on all existing - backup files could make backups very expensive if someone sets maxbackups to a - sufficiently large number! -*) -let backupPath fspath path = - let sFspath = stashDirectory fspath in - - let rec f i = - let tempPath = makeBackupName path i in - if Os.exists sFspath tempPath then - if i < Prefs.read maxbackups then - Os.rename "backupPath" sFspath tempPath sFspath (f (i + 1)) - else if i >= Prefs.read maxbackups then - Os.delete sFspath tempPath; - tempPath in - - let rec mkdirectories backdir = - verbose (fun () -> Util.msg - "mkdirectories %s %s\n" (Fspath.toString sFspath) (Path.toString backdir)); - if not (Os.exists sFspath Path.empty) then - Os.createDir sFspath Path.empty Props.dirDefault; - match Path.deconstructRev backdir with - None -> () - | Some (_, parent) -> - mkdirectories parent; - let props = (Fileinfo.get false sFspath Path.empty).Fileinfo.desc in - if not (Os.exists sFspath backdir) then Os.createDir sFspath backdir props in - - let path0 = makeBackupName path 0 in - let sourceTyp = (Fileinfo.get true fspath path).Fileinfo.typ in - let path0Typ = (Fileinfo.get true sFspath path0).Fileinfo.typ in - - if ( sourceTyp = `FILE && path0Typ = `FILE - && (Fingerprint.file fspath path) = (Fingerprint.file sFspath path0)) - || ( sourceTyp = `SYMLINK && path0Typ = `SYMLINK - && (Os.readLink fspath path) = (Os.readLink sFspath path0)) - then begin - debug (fun()-> Util.msg - "[%s / %s] = [%s / %s] = %s: no need to back up\n" - (Fspath.toString sFspath) (Path.toString path0) - (Fspath.toString fspath) (Path.toString path) - (showContent sourceTyp fspath path)); - None - end else begin - debug (fun()-> Util.msg - "stashed [%s / %s] = %s is not equal to new [%s / %s] = %s (or one is a dir): stash!\n" - (Fspath.toString sFspath) (Path.toString path0) - (showContent path0Typ sFspath path0) - (Fspath.toString fspath) (Path.toString path) - (showContent sourceTyp fspath path)); - let sPath = f 0 in - (* Make sure the parent directory exists *) - begin match Path.deconstructRev sPath with - | None -> mkdirectories Path.empty - | Some (_, backdir) -> mkdirectories backdir - end; - Some(sFspath, sPath) - end - -(*------------------------------------------------------------------------------------*) - -let backup fspath path (finalDisposition : [`AndRemove | `ByCopying]) = - debug (fun () -> Util.msg - "backup: %s / %s\n" - (Fspath.toString fspath) - (Path.toString path)); - Util.convertUnixErrorsToTransient "backup" (fun () -> - let disposeIfNeeded() = - if finalDisposition = `AndRemove then - Os.delete fspath path in - if not (Os.exists fspath path) then - debug (fun () -> Util.msg - "File %s in %s does not exist, so no need to back up\n" - (Path.toString path) (Fspath.toString fspath)) - else if shouldBackup path then begin - match backupPath fspath path with - None -> disposeIfNeeded() - | Some (backRoot, backPath) -> - debug (fun () -> Util.msg "Backing up %s / %s to %s in %s\n" - (Fspath.toString fspath) (Path.toString path) - (Path.toString backPath) (Fspath.toString backRoot)); - let byCopying() = - let rec copy p backp = - let info = Fileinfo.get true fspath p in - match info.Fileinfo.typ with - | `SYMLINK -> - debug (fun () -> Util.msg " Copying link %s / %s to %s / %s\n" - (Fspath.toString fspath) (Path.toString p) - (Fspath.toString backRoot) (Path.toString backp)); - Os.symlink backRoot backp (Os.readLink fspath p) - | `FILE -> - debug (fun () -> Util.msg " Copying file %s / %s to %s / %s\n" - (Fspath.toString fspath) (Path.toString p) - (Fspath.toString backRoot) (Path.toString backp)); - Copy.localFile fspath p backRoot backp backp - `Copy info.Fileinfo.desc - (Osx.ressLength info.Fileinfo.osX.Osx.ressInfo) None - | `DIRECTORY -> - debug (fun () -> Util.msg " Copying directory %s / %s to %s / %s\n" - (Fspath.toString fspath) (Path.toString p) - (Fspath.toString backRoot) (Path.toString backp)); - Os.createDir backRoot backp info.Fileinfo.desc; - let ch = Os.childrenOf fspath p in - Safelist.iter (fun n -> copy (Path.child p n) (Path.child backp n)) ch - | `ABSENT -> assert false in - copy path backPath; - debug (fun () -> Util.msg " Finished copying; deleting %s / %s\n" - (Fspath.toString fspath) (Path.toString path)); - disposeIfNeeded() in - try - if finalDisposition = `AndRemove then - Os.rename "backup" fspath path backRoot backPath - else - byCopying() - with _ -> - debug (fun () -> Util.msg "Rename failed -- copying instead\n"); - byCopying() - end else begin - debug (fun () -> Util.msg "Path %s / %s does not need to be backed up\n" - (Fspath.toString fspath) - (Path.toString path)); - disposeIfNeeded() - end) - -(*------------------------------------------------------------------------------------*) - -let rec stashCurrentVersion fspath path sourcePathOpt = - if shouldBackupCurrent path then - Util.convertUnixErrorsToTransient "stashCurrentVersion" (fun () -> - let sourcePath = match sourcePathOpt with None -> path | Some p -> p in - debug (fun () -> Util.msg "stashCurrentVersion of %s (drawn from %s) in %s\n" - (Path.toString path) (Path.toString sourcePath) (Fspath.toString fspath)); - let stat = Fileinfo.get true fspath sourcePath in - match stat.Fileinfo.typ with - `ABSENT -> () - | `DIRECTORY -> - assert (sourcePathOpt = None); - debug (fun () -> Util.msg "Stashing recursively because file is a directory\n"); - ignore (Safelist.iter - (fun n -> - let pathChild = Path.child path n in - if not (Globals.shouldIgnore pathChild) then - stashCurrentVersion fspath (Path.child path n) None) - (Os.childrenOf fspath path)) - | `SYMLINK -> - begin match backupPath fspath path with - | None -> () - | Some (stashFspath,stashPath) -> - Os.symlink stashFspath stashPath (Os.readLink fspath sourcePath) - end - | `FILE -> - begin match backupPath fspath path with - | None -> () - | Some (stashFspath, stashPath) -> - Copy.localFile - fspath sourcePath - stashFspath stashPath stashPath - `Copy - stat.Fileinfo.desc - (Osx.ressLength stat.Fileinfo.osX.Osx.ressInfo) - None - end) - -(*------------------------------------------------------------------------------------*) - -(* This function tries to find a backup of a recent version of the file at location - (fspath, path) in the current replica, matching the given fingerprint. If no file - is found, then the functions returns None *without* searching on the other replica *) -let getRecentVersion fspath path fingerprint = - debug (fun () -> - Util.msg "getRecentVersion of %s in %s\n" - (Path.toString path) - (Fspath.toString fspath)); - Util.convertUnixErrorsToTransient "getRecentVersion" (fun () -> - let dir = stashDirectory fspath in - let rec aux_find i = - let path = makeBackupName path i in - if Os.exists dir path && - (let dig = Os.fingerprint dir path (Fileinfo.get false dir path) in - dig = fingerprint) - then begin - debug (fun () -> - Util.msg "recent version %s found in %s\n" - (Path.toString path) - (Fspath.toString dir)); - Some (Fspath.concat dir path) - end else - if i = Prefs.read maxbackups then begin - debug (fun () -> - Util.msg "No recent version was available for %s on this root.\n" - (Fspath.toString (Fspath.concat fspath path))); - None - end else - aux_find (i+1) - in - aux_find 0) - -(*------------------------------------------------------------------------------------*) - -(* This function initializes the Stasher module according to the preferences - defined in the profile. It should be called whenever a profile is reloaded. *) -let initBackupsLocal () = - debug (fun () -> Util.msg "initBackupsLocal\n"); - translateOldPrefs (); - addBackupFilesToIgnorePref (); - updateBackupNamingFunctions () - -let initBackupsRoot: Common.root -> unit -> unit Lwt.t = - Remote.registerRootCmd - "initBackups" - (fun (fspath, ()) -> - Lwt.return (initBackupsLocal ())) - -let initBackups () = - Lwt_unix.run ( - Globals.allRootsIter (fun r -> initBackupsRoot r ())) Copied: branches/2.32/src/stasher.ml (from rev 320, trunk/src/stasher.ml) =================================================================== --- branches/2.32/src/stasher.ml (rev 0) +++ branches/2.32/src/stasher.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,515 @@ +(* Unison file synchronizer: src/stasher.ml *) +(* $I2: Last modified by lescuyer *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +(* --------------------------------------------------------------------------*) +(* Preferences for backing up and stashing *) + +let debug = Util.debug "stasher" +let verbose = Util.debug "stasher+" + +let backuplocation = + Prefs.createString "backuploc" "central" + "!where backups are stored ('local' or 'central')" + ("This preference determines whether backups should be kept locally, near the " + ^ "original files, or" + ^" in a central directory specified by the \\texttt{backupdir} " + ^"preference. If set to \\verb|local|, backups will be kept in " + ^"the same directory as the original files, and if set to \\verb|central|," + ^" \\texttt{backupdir} will be used instead.") + +let _ = Prefs.alias backuplocation "backuplocation" + +let backup = + Pred.create "backup" ~advanced:true + ("Including the preference \\texttt{-backup \\ARG{pathspec}} " + ^ "causes Unison to keep backup files for each path that matches " + ^ "\\ARG{pathspec}. These backup files are kept in the " + ^ "directory specified by the \\verb|backuplocation| preference. The backups are named " + ^ "according to the \\verb|backupprefix| and \\verb|backupsuffix| preferences." + ^ " The number of versions that are kept is determined by the " + ^ "\\verb|maxbackups| preference." + ^ "\n\n The syntax of \\ARG{pathspec} is described in " + ^ "\\sectionref{pathspec}{Path Specification}.") + +let _ = Pred.alias backup "mirror" + +let backupnot = + Pred.create "backupnot" ~advanced:true + ("The values of this preference specify paths or individual files or" + ^ " regular expressions that should {\\em not} " + ^ "be backed up, even if the {\\tt backup} preference selects " + ^ "them---i.e., " + ^ "it selectively overrides {\\tt backup}. The same caveats apply here " + ^ "as with {\\tt ignore} and {\tt ignorenot}.") + +let _ = Pred.alias backupnot "mirrornot" + +let shouldBackup p = + let s = (Path.toString p) in + Pred.test backup s && not (Pred.test backupnot s) + +let backupprefix = + Prefs.createString "backupprefix" ".bak.$VERSION." + "!prefix for the names of backup files" + ("When a backup for a file \\verb|NAME| is created, it is stored " + ^ "in a directory specified by \\texttt{backuplocation}, in a file called " + ^ "\\texttt{backupprefix}\\verb|NAME|\\texttt{backupsuffix}." + ^ " \\texttt{backupprefix} can include a directory name (causing Unison to " + ^ "keep all backup files for a given directory in a subdirectory with this name), and both " + ^ " \\texttt{backupprefix} and \\texttt{backupsuffix} can contain the string" + ^ "\\ARG{\\$VERSION}, which will be replaced by the \\emph{age} of the backup " + ^ "(1 for the most recent, 2 for the second most recent, and so on...)." + ^ " This keyword is ignored if it appears in a directory name" + ^ " in the prefix; if it does not appear anywhere" + ^ " in the prefix or the suffix, it will be automatically" + ^ " placed at the beginning of the suffix. " + ^ "\n\n" + ^ "One thing to be careful of: If the {\\tt backuploc} preference is set " + ^ "to {\\tt local}, Unison will automatically ignore {\\em all} files " + ^ "whose prefix and suffix match {\\tt backupprefix} and {\\tt backupsuffix}. " + ^ "So be careful to choose values for these preferences that are sufficiently " + ^ "different from the names of your real files.") + +let backupsuffix = + Prefs.createString "backupsuffix" "" + "!a suffix to be added to names of backup files" + ("See \\texttt{backupprefix} for full documentation.") + +let backups = + Prefs.createBool "backups" false + "!keep backup copies of all files (see also 'backup')" + ("Setting this flag to true is equivalent to " + ^" setting \\texttt{backuplocation} to \\texttt{local}" + ^" and \\texttt{backup} to \\verb|Name *|.") + +(* The following function is used to express the old backup preference, if set, + in the terms of the new preferences *) +let translateOldPrefs () = + match (Pred.extern backup, Pred.extern backupnot, Prefs.read backups) with + ([], [], true) -> + debug (fun () -> + Util.msg "backups preference set: translated into backup and backuplocation\n"); + Pred.intern backup ["Name *"]; + Prefs.set backuplocation "local" + | (_, _, false) -> + () + | _ -> raise (Util.Fatal ( "Both old 'backups' preference and " + ^ "new 'backup' preference are set!")) + +let maxbackups = + Prefs.createInt "maxbackups" 2 + "!number of backed up versions of a file" + ("This preference specifies the number of backup versions that will " + ^ "be kept by unison, for each path that matches the predicate " + ^ "\\verb|backup|. The default is 2.") + +let _ = Prefs.alias maxbackups "mirrorversions" +let _ = Prefs.alias maxbackups "backupversions" + +let backupdir = + Prefs.createString "backupdir" "" + "!directory for storing centralized backups" + ("If this preference is set, Unison will use it as the name of the " + ^ "directory used to store backup files specified by " + ^ "the {\\tt backup} preference, when {\\tt backuplocation} is set" + ^ " to \\verb|central|. It is checked {\\em after} the " + ^ "{\\tt UNISONBACKUPDIR} environment variable.") + +let backupDirectory () = + Util.convertUnixErrorsToTransient "backupDirectory()" (fun () -> + try Fspath.canonize (Some (Unix.getenv "UNISONBACKUPDIR")) + with Not_found -> + try Fspath.canonize (Some (Unix.getenv "UNISONMIRRORDIR")) + with Not_found -> + if Prefs.read backupdir <> "" + then Fspath.canonize (Some (Prefs.read backupdir)) + else Os.fileInUnisonDir "backup") + +let backupcurrent = + Pred.create "backupcurr" ~advanced:true + ("Including the preference \\texttt{-backupcurr \\ARG{pathspec}} " + ^" causes Unison to keep a backup of the {\\em current} version of every file " + ^ "matching \\ARG{pathspec}. " + ^" This file will be saved as a backup with version number 000. Such" + ^" backups can be used as inputs to external merging programs, for instance. See " + ^ "the documentatation for the \\verb|merge| preference." + ^" For more details, see \\sectionref{merge}{Merging Conflicting Versions}." + ^"\n\n The syntax of \\ARG{pathspec} is described in " + ^ "\\sectionref{pathspec}{Path Specification}.") + +let backupcurrentnot = + Pred.create "backupcurrnot" ~advanced:true + "Exceptions to \\verb|backupcurr|, like the \\verb|ignorenot| preference." + +let shouldBackupCurrent p = + (* BCP: removed next line [Apr 2007]: causes ALL mergeable files to be backed + up, which is probably not what users want -- the backupcurrent + switch should be used instead. + Globals.shouldMerge p || *) + (let s = Path.toString p in + Pred.test backupcurrent s && not (Pred.test backupcurrentnot s)) + +let _ = Pred.alias backupcurrent "backupcurrent" +let _ = Pred.alias backupcurrentnot "backupcurrentnot" + +(* ---------------------------------------------------------------------------*) + +(* NB: We use Str.regexp here because we need group matching to retrieve + and increment version numbers from backup file names. We only use + it here, though: to check if a path should be backed up or ignored, we + use Rx instead. (This is important because the Str regexp functions are + terribly slow.) *) + +(* A tuple of string option * string * string, describing a regular + expression that matches the filenames of unison backups according + to the current preferences. The first regexp is an option to match + the local directory, if any, in which backups are stored; the second + one matches the prefix, the third the suffix. + + Note that we always use forward slashes here (rather than using backslashes + when running on windows) because we are constructing rx's that are going to + be matched against Path.t's. (Strictly speaking, we ought to ask the Path + module what the path separator character is, rather than assuming it is slash, + but this is never going to change.) + *) +let backup_rx () = + let version_rx = "\\([0-9]+\\)" in + let prefix = Prefs.read backupprefix in + let suffix = Str.quote (Prefs.read backupsuffix) in + let (udir, uprefix) = + ((match Filename.dirname prefix with + | "." -> "" + | s -> (Fileutil.backslashes2forwardslashes s)^"/"), + Filename.basename prefix) in + let (dir, prefix) = + ((match udir with "" -> None | _ -> Some(Str.quote udir)), Str.quote uprefix) in + if Str.string_match (Str.regexp ".*\\\\\\$VERSION.*") (prefix^suffix) 0 then + (dir, + Str.global_replace (Str.regexp "\\\\\\$VERSION") version_rx prefix, + Str.global_replace (Str.regexp "\\\\\\$VERSION") version_rx suffix) + else + raise (Util.Fatal "Either backupprefix or backupsuffix must contain '$VERSION'") + +(* We ignore files whose name ends in .unison.bak, since people may still have these + lying around from using previous versions of Unison. *) +let oldBackupPrefPathspec = "Name *.unison.bak" + +(* This function creates Rx regexps based on the preferences to ignore + backups of old and current versions. *) +let addBackupFilesToIgnorePref () = + let (dir_rx, prefix_rx, suffix_rx) = backup_rx() in + let regexp_to_rx s = + Str.global_replace (Str.regexp "\\\\(") "" + (Str.global_replace (Str.regexp "\\\\)") "" s) in + let (full, dir) = + let d = + match dir_rx with + None -> "/" + | Some s -> regexp_to_rx s in + let p = regexp_to_rx prefix_rx in + let s = regexp_to_rx suffix_rx in + debug (fun() -> Util.msg "d = %s\n" d); + ("(.*/)?"^p^".*"^s, "(.*/)?"^(String.sub d 0 (String.length d - 1))) in + let theRegExp = + match dir_rx with + None -> "Regex " ^ full + | Some _ -> "Regex " ^ dir in + + Globals.addRegexpToIgnore oldBackupPrefPathspec; + if Prefs.read backuplocation = "local" then begin + debug (fun () -> + Util.msg "New pattern being added to ignore preferences (for backup files):\n %s\n" + theRegExp); + Globals.addRegexpToIgnore theRegExp + end + +(* We use references for functions that compute the prefixes and suffixes + in order to avoid using functions from the Str module each time we need them. *) +let make_prefix = ref (fun i -> assert false) +let make_suffix = ref (fun i -> assert false) + +(* This function updates the function used to create prefixes and suffixes + for naming backup files, according to the preferences. *) +let updateBackupNamingFunctions () = + let makeFun s = + match Str.full_split (Str.regexp "\\$VERSION") s with + [] -> (fun _ -> "") + | [Str.Text t] -> + (fun _ -> t) + | [Str.Delim _; Str.Text t] -> + (fun i -> Printf.sprintf "%d%s" i t) + | [Str.Text t; Str.Delim _] -> + (fun i -> Printf.sprintf "%s%d" t i) + | [Str.Text t; Str.Delim _; Str.Text t'] -> + (fun i -> Printf.sprintf "%s%d%s" t i t') + | _ -> raise (Util.Fatal ( + "The tag $VERSION should only appear " + ^"once in the backupprefix and backupsuffix preferences.")) in + + make_prefix := makeFun (Prefs.read backupprefix); + make_suffix := makeFun (Prefs.read backupsuffix); + debug (fun () -> Util.msg + "Prefix and suffix regexps for backup filenames have been updated\n") + +(*------------------------------------------------------------------------------------*) + +let makeBackupName path i = + (* if backups are kept centrally, the current version has exactly + the same name as the original, for convenience. *) + if i=0 && Prefs.read backuplocation = "central" then + path + else + Path.addSuffixToFinalName + (Path.addPrefixToFinalName path (!make_prefix i)) + (!make_suffix i) + +let stashDirectory fspath = + match Prefs.read backuplocation with + "central" -> backupDirectory () + | "local" -> fspath + | _ -> raise (Util.Fatal ("backuplocation preference should be set" + ^"to central or local.")) + +let showContent typ fspath path = + match typ with + | `FILE -> Fingerprint.toString (Fingerprint.file fspath path) + | `SYMLINK -> Os.readLink fspath path + | `DIRECTORY -> "DIR" + | `ABSENT -> "ABSENT" + +(* Generates a file name for a backup file. If backup file already exists, + the old file will be renamed with the count incremented. The newest + backup file is always the one with version number 1, larger numbers mean + older files. *) +(* BCP: Note that the way we keep bumping up the backup numbers on all existing + backup files could make backups very expensive if someone sets maxbackups to a + sufficiently large number! +*) +let backupPath fspath path = + let sFspath = stashDirectory fspath in + + let rec f i = + let tempPath = makeBackupName path i in + if Os.exists sFspath tempPath then + if i < Prefs.read maxbackups then + Os.rename "backupPath" sFspath tempPath sFspath (f (i + 1)) + else if i >= Prefs.read maxbackups then + Os.delete sFspath tempPath; + tempPath in + + let rec mkdirectories backdir = + verbose (fun () -> Util.msg + "mkdirectories %s %s\n" (Fspath.toString sFspath) (Path.toString backdir)); + if not (Os.exists sFspath Path.empty) then + Os.createDir sFspath Path.empty Props.dirDefault; + match Path.deconstructRev backdir with + None -> () + | Some (_, parent) -> + mkdirectories parent; + let props = (Fileinfo.get false sFspath Path.empty).Fileinfo.desc in + if not (Os.exists sFspath backdir) then Os.createDir sFspath backdir props in + + let path0 = makeBackupName path 0 in + let sourceTyp = (Fileinfo.get true fspath path).Fileinfo.typ in + let path0Typ = (Fileinfo.get true sFspath path0).Fileinfo.typ in + + if ( sourceTyp = `FILE && path0Typ = `FILE + && (Fingerprint.file fspath path) = (Fingerprint.file sFspath path0)) + || ( sourceTyp = `SYMLINK && path0Typ = `SYMLINK + && (Os.readLink fspath path) = (Os.readLink sFspath path0)) + then begin + debug (fun()-> Util.msg + "[%s / %s] = [%s / %s] = %s: no need to back up\n" + (Fspath.toString sFspath) (Path.toString path0) + (Fspath.toString fspath) (Path.toString path) + (showContent sourceTyp fspath path)); + None + end else begin + debug (fun()-> Util.msg + "stashed [%s / %s] = %s is not equal to new [%s / %s] = %s (or one is a dir): stash!\n" + (Fspath.toString sFspath) (Path.toString path0) + (showContent path0Typ sFspath path0) + (Fspath.toString fspath) (Path.toString path) + (showContent sourceTyp fspath path)); + let sPath = f 0 in + (* Make sure the parent directory exists *) + begin match Path.deconstructRev sPath with + | None -> mkdirectories Path.empty + | Some (_, backdir) -> mkdirectories backdir + end; + Some(sFspath, sPath) + end + +(*------------------------------------------------------------------------------------*) + +let backup fspath path (finalDisposition : [`AndRemove | `ByCopying]) = + debug (fun () -> Util.msg + "backup: %s / %s\n" + (Fspath.toString fspath) + (Path.toString path)); + Util.convertUnixErrorsToTransient "backup" (fun () -> + let disposeIfNeeded() = + if finalDisposition = `AndRemove then + Os.delete fspath path in + if not (Os.exists fspath path) then + debug (fun () -> Util.msg + "File %s in %s does not exist, so no need to back up\n" + (Path.toString path) (Fspath.toString fspath)) + else if shouldBackup path then begin + match backupPath fspath path with + None -> disposeIfNeeded() + | Some (backRoot, backPath) -> + debug (fun () -> Util.msg "Backing up %s / %s to %s in %s\n" + (Fspath.toString fspath) (Path.toString path) + (Path.toString backPath) (Fspath.toString backRoot)); + let byCopying() = + let rec copy p backp = + let info = Fileinfo.get true fspath p in + match info.Fileinfo.typ with + | `SYMLINK -> + debug (fun () -> Util.msg " Copying link %s / %s to %s / %s\n" + (Fspath.toString fspath) (Path.toString p) + (Fspath.toString backRoot) (Path.toString backp)); + Os.symlink backRoot backp (Os.readLink fspath p) + | `FILE -> + debug (fun () -> Util.msg " Copying file %s / %s to %s / %s\n" + (Fspath.toString fspath) (Path.toString p) + (Fspath.toString backRoot) (Path.toString backp)); + Copy.localFile fspath p backRoot backp backp + `Copy info.Fileinfo.desc + (Osx.ressLength info.Fileinfo.osX.Osx.ressInfo) None + | `DIRECTORY -> + debug (fun () -> Util.msg " Copying directory %s / %s to %s / %s\n" + (Fspath.toString fspath) (Path.toString p) + (Fspath.toString backRoot) (Path.toString backp)); + Os.createDir backRoot backp info.Fileinfo.desc; + let ch = Os.childrenOf fspath p in + Safelist.iter (fun n -> copy (Path.child p n) (Path.child backp n)) ch + | `ABSENT -> assert false in + copy path backPath; + debug (fun () -> Util.msg " Finished copying; deleting %s / %s\n" + (Fspath.toString fspath) (Path.toString path)); + disposeIfNeeded() in + try + if finalDisposition = `AndRemove then + Os.rename "backup" fspath path backRoot backPath + else + byCopying() + with _ -> + debug (fun () -> Util.msg "Rename failed -- copying instead\n"); + byCopying() + end else begin + debug (fun () -> Util.msg "Path %s / %s does not need to be backed up\n" + (Fspath.toString fspath) + (Path.toString path)); + disposeIfNeeded() + end) + +(*------------------------------------------------------------------------------------*) + +let rec stashCurrentVersion fspath path sourcePathOpt = + if shouldBackupCurrent path then + Util.convertUnixErrorsToTransient "stashCurrentVersion" (fun () -> + let sourcePath = match sourcePathOpt with None -> path | Some p -> p in + debug (fun () -> Util.msg "stashCurrentVersion of %s (drawn from %s) in %s\n" + (Path.toString path) (Path.toString sourcePath) (Fspath.toString fspath)); + let stat = Fileinfo.get true fspath sourcePath in + match stat.Fileinfo.typ with + `ABSENT -> () + | `DIRECTORY -> + assert (sourcePathOpt = None); + debug (fun () -> Util.msg "Stashing recursively because file is a directory\n"); + ignore (Safelist.iter + (fun n -> + let pathChild = Path.child path n in + if not (Globals.shouldIgnore pathChild) then + stashCurrentVersion fspath (Path.child path n) None) + (Os.childrenOf fspath path)) + | `SYMLINK -> + begin match backupPath fspath path with + | None -> () + | Some (stashFspath,stashPath) -> + Os.symlink stashFspath stashPath (Os.readLink fspath sourcePath) + end + | `FILE -> + begin match backupPath fspath path with + | None -> () + | Some (stashFspath, stashPath) -> + Copy.localFile + fspath sourcePath + stashFspath stashPath stashPath + `Copy + stat.Fileinfo.desc + (Osx.ressLength stat.Fileinfo.osX.Osx.ressInfo) + None + end) + +(*------------------------------------------------------------------------------------*) + +(* This function tries to find a backup of a recent version of the file at location + (fspath, path) in the current replica, matching the given fingerprint. If no file + is found, then the functions returns None *without* searching on the other replica *) +let getRecentVersion fspath path fingerprint = + debug (fun () -> + Util.msg "getRecentVersion of %s in %s\n" + (Path.toString path) + (Fspath.toString fspath)); + Util.convertUnixErrorsToTransient "getRecentVersion" (fun () -> + let dir = stashDirectory fspath in + let rec aux_find i = + let path = makeBackupName path i in + if Os.exists dir path && + (let dig = Os.fingerprint dir path (Fileinfo.get false dir path) in + dig = fingerprint) + then begin + debug (fun () -> + Util.msg "recent version %s found in %s\n" + (Path.toString path) + (Fspath.toString dir)); + Some (Fspath.concat dir path) + end else + if i = Prefs.read maxbackups then begin + debug (fun () -> + Util.msg "No recent version was available for %s on this root.\n" + (Fspath.toString (Fspath.concat fspath path))); + None + end else + aux_find (i+1) + in + aux_find 0) + +(*------------------------------------------------------------------------------------*) + +(* This function initializes the Stasher module according to the preferences + defined in the profile. It should be called whenever a profile is reloaded. *) +let initBackupsLocal () = + debug (fun () -> Util.msg "initBackupsLocal\n"); + translateOldPrefs (); + addBackupFilesToIgnorePref (); + updateBackupNamingFunctions () + +let initBackupsRoot: Common.root -> unit -> unit Lwt.t = + Remote.registerRootCmd + "initBackups" + (fun (fspath, ()) -> + Lwt.return (initBackupsLocal ())) + +let initBackups () = + Lwt_unix.run ( + Globals.allRootsIter (fun r -> initBackupsRoot r ())) Deleted: branches/2.32/src/strings.ml =================================================================== --- trunk/src/strings.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/strings.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,3931 +0,0 @@ -(* DO NOT MODIFY. - This file has been automatically generated, see docs.ml. *) - -let docs = - ("about", ("About Unison", - "Unison File Synchronizer\n\ - Version 2.32.1\n\ - \n\ - ")) -:: - ("", ("Overview", - "Overview\n\ - \n\ - \032 Unison is a file-synchronization tool for Unix and Windows. It allows\n\ - \032 two replicas of a collection of files and directories to be stored on\n\ - \032 different hosts (or different disks on the same host), modified\n\ - \032 separately, and then brought up to date by propagating the changes in\n\ - \032 each replica to the other.\n\ - \n\ - \032 Unison shares a number of features with tools such as configuration\n\ - \032 management packages (CVS (http://www.cyclic.com/), PRCS\n\ - \032 (http://www.XCF.Berkeley.EDU/~jmacd/prcs.html), etc.), distributed\n\ - \032 filesystems (Coda (http://www.coda.cs.cmu.edu/), etc.),\n\ - \032 uni-directional mirroring utilities (rsync\n\ - \032 (http://samba.anu.edu.au/rsync/), etc.), and other synchronizers\n\ - \032 (Intellisync (http://www.pumatech.com), Reconcile\n\ - \032 (http://www.merl.com/reports/TR99-14/), etc). However, there are\n\ - \032 several points where it differs:\n\ - \032 * Unison runs on both Windows (95, 98, NT, 2k, and XP) and Unix\n\ - \032 (OSX, Solaris, Linux, etc.) systems. Moreover, Unison works across\n\ - \032 platforms, allowing you to synchronize a Windows laptop with a\n\ - \032 Unix server, for example.\n\ - \032 * Unlike a distributed filesystem, Unison is a user-level program:\n\ - \032 there is no need to modify the kernel or to have superuser\n\ - \032 privileges on either host.\n\ - \032 * Unlike simple mirroring or backup utilities, Unison can deal with\n\ - \032 updates to both replicas of a distributed directory structure.\n\ - \032 Updates that do not conflict are propagated automatically.\n\ - \032 Conflicting updates are detected and displayed.\n\ - \032 * Unison works between any pair of machines connected to the\n\ - \032 internet, communicating over either a direct socket link or\n\ - \032 tunneling over an encrypted ssh connection. It is careful with\n\ - \032 network bandwidth, and runs well over slow links such as PPP\n\ - \032 connections. Transfers of small updates to large files are\n\ - \032 optimized using a compression protocol similar to rsync.\n\ - \032 * Unison has a clear and precise specification, described below.\n\ - \032 * Unison is resilient to failure. It is careful to leave the\n\ - \032 replicas and its own private structures in a sensible state at all\n\ - \032 times, even in case of abnormal termination or communication\n\ - \032 failures.\n\ - \032 * Unison is free; full source code is available under the GNU Public\n\ - \032 License.\n\ - \n\ - ")) -:: - ("", ("Preface", - "Preface\n\ - \n\ - ")) -:: - ("people", ("People", - "People\n\ - \n\ - \032 Benjamin Pierce (http://www.cis.upenn.edu/~bcpierce/) leads the Unison\n\ - \032 project. The current version of Unison was designed and implemented by\n\ - \032 Trevor Jim (http://www.research.att.com/~trevor/), Benjamin Pierce\n\ - \032 (http://www.cis.upenn.edu/~bcpierce/), and J\233r\244me Vouillon\n\ - \032 (http://www.pps.jussieu.fr/~vouillon/), with Alan Schmitt\n\ - \032 (http://alan.petitepomme.net/), Malo Denielou, Zhe Yang\n\ - \032 (http://www.brics.dk/~zheyang/), Sylvain Gommier, and Matthieu Goulay.\n\ - \032 The Mac user interface was started by Trevor Jim and enormously\n\ - \032 improved by Ben Willmore. Our implementation of the rsync\n\ - \032 (http://samba.org/rsync/) protocol was built by Norman Ramsey\n\ - \032 (http://www.eecs.harvard.edu/~nr/) and Sylvain Gommier. It is is based\n\ - \032 on Andrew Tridgell (http://samba.anu.edu.au/~tridge/)'s thesis work\n\ - \032 (http://samba.anu.edu.au/~tridge/phd_thesis.pdf) and inspired by his\n\ - \032 rsync (http://samba.org/rsync/) utility. The mirroring and merging\n\ - \032 functionality was implemented by Sylvain Roy, improved by Malo\n\ - \032 Denielou, and improved yet further by St\233phane Lescuyer. Jacques\n\ - \032 Garrigue (http://wwwfun.kurims.kyoto-u.ac.jp/~garrigue/) contributed\n\ - \032 the original Gtk version of the user interface; the Gtk2 version was\n\ - \032 built by Stephen Tse. Sundar Balasubramaniam helped build a prototype\n\ - \032 implementation of an earlier synchronizer in Java. Insik Shin\n\ - \032 (http://www.cis.upenn.edu/~ishin/) and Insup Lee\n\ - \032 (http://www.cis.upenn.edu/~lee/) contributed design ideas to this\n\ - \032 implementation. Cedric Fournet\n\ - \032 (http://research.microsoft.com/~fournet/) contributed to an even\n\ - \032 earlier prototype.\n\ - \n\ - ")) -:: - ("lists", ("Mailing Lists and Bug Reporting", - "Mailing Lists and Bug Reporting\n\ - \n\ - Mailing Lists:\n\ - \n\ - \032 Moderated mailing lists are available for bug reporting, announcements\n\ - \032 of new versions, discussions among users, and discussions among\n\ - \032 developers. See\n\ - \n\ - \032 http://www.cis.upenn.edu/~bcpierce/unison/lists.html\n\ - \n\ - \032 for more information.\n\ - \n\ - ")) -:: - ("status", ("Development Status", - "Development Status\n\ - \n\ - \032 Unison is no longer under active development as a research project.\n\ - \032 (Our research efforts are now focused on a follow-on project called\n\ - \032 Harmony, described at http://www.cis.upenn.edu/~bcpierce/harmony.) At\n\ - \032 this point, there is no one whose job it is to maintain Unison, fix\n\ - \032 bugs, or answer questions.\n\ - \n\ - \032 However, the original developers are all still using Unison daily. It\n\ - \032 will continue to be maintained and supported for the foreseeable\n\ - \032 future, and we will occasionally release new versions with bug fixes,\n\ - \032 small improvements, and contributed patches.\n\ - \n\ - \032 Reports of bugs affecting correctness or safety are of interest to\n\ - \032 many people and will generally get high priority. Other bug reports\n\ - \032 will be looked at as time permits. Bugs should be reported to the\n\ - \032 users list at unison-users at yahoogroups.com\n\ - \032 (mailto:unison-users at yahoogroups.com).\n\ - \n\ - \032 Feature requests are welcome, but will probably just be added to the\n\ - \032 ever-growing todo list. They should also be sent to\n\ - \032 unison-users at yahoogroups.com (mailto:unison-users at yahoogroups.com).\n\ - \n\ - \032 Patches are even more welcome. They should be sent to\n\ - \032 unison-hackers at lists.seas.upenn.edu\n\ - \032 (mailto:unison-hackers at lists.seas.upenn.edu). (Since safety and\n\ - \032 robustness are Unison's most important properties, patches will be\n\ - \032 held to high standards of clear design and clean coding.) If you want\n\ - \032 to contribute to Unison, start by downloading the developer tarball\n\ - \032 from the download page. For some details on how the code is organized,\n\ - \032 etc., see the file CONTRIB.\n\ - \n\ - ")) -:: - ("copying", ("Copying", - "Copying\n\ - \n\ - \032 This file is part of Unison.\n\ - \n\ - \032 Unison is free software: you can redistribute it and/or modify it\n\ - \032 under the terms of the GNU General Public License as published by the\n\ - \032 Free Software Foundation, either version 3 of the License, or (at your\n\ - \032 option) any later version.\n\ - \n\ - \032 Unison is distributed in the hope that it will be useful, but WITHOUT\n\ - \032 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or\n\ - \032 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License\n\ - \032 for more details.\n\ - \n\ - \032 The GNU Public License can be found at http://www.gnu.org/licenses. A\n\ - \032 copy is also included in the Unison source distribution in the file\n\ - \032 COPYING.\n\ - \n\ - ")) -:: - ("ack", ("Acknowledgements", - "Acknowledgements\n\ - \n\ - \032 Work on Unison has been supported by the National Science Foundation\n\ - \032 under grants CCR-9701826 and ITR-0113226, Principles and Practice of\n\ - \032 Synchronization, and by University of Pennsylvania's Institute for\n\ - \032 Research in Cognitive Science (IRCS).\n\ - \n\ - ")) -:: - ("install", ("Installation", - "Installation\n\ - \n\ - \032 Unison is designed to be easy to install. The following sequence of\n\ - \032 steps should get you a fully working installation in a few minutes. If\n\ - \032 you run into trouble, you may find the suggestions on the Frequently\n\ - \032 Asked Questions page\n\ - \032 (http://www.cis.upenn.edu/~bcpierce/unison/faq.html) helpful.\n\ - \032 Pre-built binaries are available for a variety of platforms.\n\ - \n\ - \032 Unison can be used with either of two user interfaces:\n\ - \032 1. a simple textual interface, suitable for dumb terminals (and\n\ - \032 running from scripts), and\n\ - \032 2. a more sophisticated grapical interface, based on Gtk2.\n\ - \n\ - \032 You will need to install a copy of Unison on every machine that you\n\ - \032 want to synchronize. However, you only need the version with a\n\ - \032 graphical user interface (if you want a GUI at all) on the machine\n\ - \032 where you're actually going to display the interface (the CLIENT\n\ - \032 machine). Other machines that you synchronize with can get along just\n\ - \032 fine with the textual version.\n\ - \n\ - Downloading Unison\n\ - \n\ - \032 The Unison download site lives under\n\ - \032 http://www.cis.upenn.edu/~bcpierce/unison.\n\ - \n\ - \032 If a pre-built binary of Unison is available for the client machine's\n\ - \032 architecture, just download it and put it somewhere in your search\n\ - \032 path (if you're going to invoke it from the command line) or on your\n\ - \032 desktop (if you'll be click-starting it).\n\ - \n\ - \032 The executable file for the graphical version (with a name including\n\ - \032 gtkui) actually provides both interfaces: the graphical one appears by\n\ - \032 default, while the textual interface can be selected by including -ui\n\ - \032 text on the command line. The textui executable provides just the\n\ - \032 textual interface.\n\ - \n\ - \032 If you don't see a pre-built executable for your architecture, you'll\n\ - \032 need to build it yourself. See the section \"Building Unison\" . There\n\ - \032 are also a small number of contributed ports to other architectures\n\ - \032 that are not maintained by us. See the Contributed Ports page\n\ - \032 (http://www.cis.upenn.edu/~bcpierce/unison/download.html) to check\n\ - \032 what's available.\n\ - \n\ - \032 Check to make sure that what you have downloaded is really executable.\n\ - \032 Either click-start it, or type \"unison -version\" at the command line.\n\ - \n\ - \032 Unison can be used in three different modes: with different\n\ - \032 directories on a single machine, with a remote machine over a direct\n\ - \032 socket connection, or with a remote machine using ssh for\n\ - \032 authentication and secure transfer. If you intend to use the last\n\ - \032 option, you may need to install ssh; see the section \"Installing Ssh\"\n\ - \032 .\n\ - \n\ - Running Unison\n\ - \n\ - \032 Once you've got Unison installed on at least one system, read the\n\ - \032 section \"Tutorial\" of the user manual (or type \"unison -doc tutorial\")\n\ - \032 for instructions on how to get started.\n\ - \n\ - Upgrading\n\ - \n\ - \032 Upgrading to a new version of Unison is as simple as throwing away the\n\ - \032 old binary and installing the new one.\n\ - \n\ - \032 Before upgrading, it is a good idea to run the old version one last\n\ - \032 time, to make sure all your replicas are completely synchronized. A\n\ - \032 new version of Unison will sometimes introduce a different format for\n\ - \032 the archive files used to remember information about the previous\n\ - \032 state of the replicas. In this case, the old archive will be ignored\n\ - \032 (not deleted -- if you roll back to the previous version of Unison,\n\ - \032 you will find the old archives intact), which means that any\n\ - \032 differences between the replicas will show up as conflicts that need\n\ - \032 to be resolved manually.\n\ - \n\ - Building Unison from Scratch\n\ - \n\ - \032 If a pre-built image is not available, you will need to compile it\n\ - \032 from scratch; the sources are available from the same place as the\n\ - \032 binaries.\n\ - \n\ - \032 In principle, Unison should work on any platform to which OCaml has\n\ - \032 been ported and on which the Unix module is fully implemented. It has\n\ - \032 been tested on many flavors of Windows (98, NT, 2000, XP) and Unix (OS\n\ - \032 X, Solaris, Linux, FreeBSD), and on both 32- and 64-bit architectures.\n\ - \n\ - Unix\n\ - \n\ - \032 You'll need the Objective Caml compiler (version 3.07 or later), which\n\ - \032 is available from http://caml.inria.fr. Building and installing OCaml\n\ - \032 on Unix systems is very straightforward; just follow the instructions\n\ - \032 in the distribution. You'll probably want to build the native-code\n\ - \032 compiler in addition to the bytecode compiler, as Unison runs much\n\ - \032 faster when compiled to native code, but this is not absolutely\n\ - \032 necessary. (Quick start: on many systems, the following sequence of\n\ - \032 commands will get you a working and installed compiler: first do make\n\ - \032 world opt, then su to root and do make install.)\n\ - \n\ - \032 You'll also need the GNU make utility, standard on many Unix systems.\n\ - \032 (Type \"make -version\" to check that you've got the GNU version.)\n\ - \n\ - \032 Once you've got OCaml installed, grab a copy of the Unison sources,\n\ - \032 unzip and untar them, change to the new \"unison\" directory, and type\n\ - \032 \"make UISTYLE=text.\" The result should be an executable file called\n\ - \032 \"unison\". Type \"./unison\" to make sure the program is executable. You\n\ - \032 should get back a usage message.\n\ - \n\ - \032 If you want to build the graphical user interface, you will need to\n\ - \032 install two additional things:\n\ - \032 * The Gtk2 libraries. These areavailable from http://www.gtk.org and\n\ - \032 are standard on many Unix installations.\n\ - \032 * The lablgtk2 OCaml library. Grab the developers' tarball from\n\ - \n\ - \032 http://wwwfun.kurims.kyoto-u.ac.jp/soft/olabl/lablgtk.html,\n\ - \032 untar it, and follow the instructions to build and install it.\n\ - \032 (Quick start: make configure, then make, then make opt, then su\n\ - \032 and make install.)\n\ - \n\ - \032 Now build unison. If your search paths are set up correctly, simply\n\ - \032 typing make again should build a unison executable with a Gtk2\n\ - \032 graphical interface. (In previous releases of Unison, it was necessary\n\ - \032 to add UISTYLE=gtk2 to the 'make' command above. This requirement has\n\ - \032 been removed: the makefile should detect automatically when lablgtk2\n\ - \032 is present and set this flag automatically.)\n\ - \n\ - \032 Put the unison executable somewhere in your search path, either by\n\ - \032 adding the Unison directory to your PATH variable or by copying the\n\ - \032 executable to some standard directory where executables are stored.\n\ - \n\ - Windows\n\ - \n\ - \032 Although the binary distribution should work on any version of\n\ - \032 Windows, some people may want to build Unison from scratch on those\n\ - \032 systems too.\n\ - \n\ - Bytecode version:\n\ - \n\ - \032 The simpler but slower compilation option to build a Unison executable\n\ - \032 is to build a bytecode version. You need first install Windows version\n\ - \032 of the OCaml compiler (version 3.07 or later, available from\n\ - \032 http://caml.inria.fr). Then grab a copy of Unison sources and type\n\ - \032 make NATIVE=false\n\ - \n\ - \032 to compile the bytecode. The result should be an executable file\n\ - \032 called unison.exe.\n\ - \n\ - Native version:\n\ - \n\ - \032 Building a more efficient, native version of Unison on Windows\n\ - \032 requires a little more work. See the file INSTALL.win32 in the source\n\ - \032 code distribution.\n\ - \n\ - Installation Options\n\ - \n\ - \032 The Makefile in the distribution includes several switches that can be\n\ - \032 used to control how Unison is built. Here are the most useful ones:\n\ - \032 * Building with NATIVE=true uses the native-code OCaml compiler,\n\ - \032 yielding an executable that will run quite a bit faster. We use\n\ - \032 this for building distribution versions.\n\ - \032 * Building with make DEBUGGING=true generates debugging symbols.\n\ - \032 * Building with make STATIC=true generates a (mostly) statically\n\ - \032 linked executable. We use this for building distribution versions,\n\ - \032 for portability.\n\ - \n\ - ")) -:: - ("tutorial", ("Tutorial", - "Tutorial\n\ - \n\ - Preliminaries\n\ - \n\ - \032 Unison can be used with either of two user interfaces:\n\ - \032 1. a straightforward textual interface and\n\ - \032 2. a more sophisticated graphical interface\n\ - \n\ - \032 The textual interface is more convenient for running from scripts and\n\ - \032 works on dumb terminals; the graphical interface is better for most\n\ - \032 interactive use. For this tutorial, you can use either. If you are\n\ - \032 running Unison from the command line, just typing unison will select\n\ - \032 either the text or the graphical interface, depending on which has\n\ - \032 been selected as default when the executable you are running was\n\ - \032 built. You can force the text interface even if graphical is the\n\ - \032 default by adding -ui text. The other command-line arguments to both\n\ - \032 versions are identical.\n\ - \n\ - \032 The graphical version can also be run directly by clicking on its\n\ - \032 icon, but this may require a little set-up (see the section\n\ - \032 \"Click-starting Unison\" ). For this tutorial, we assume that you're\n\ - \032 starting it from the command line.\n\ - \n\ - \032 Unison can synchronize files and directories on a single machine, or\n\ - \032 between two machines on a network. (The same program runs on both\n\ - \032 machines; the only difference is which one is responsible for\n\ - \032 displaying the user interface.) If you're only interested in a\n\ - \032 single-machine setup, then let's call that machine the CLIENT . If\n\ - \032 you're synchronizing two machines, let's call them CLIENT and SERVER .\n\ - \n\ - Local Usage\n\ - \n\ - \032 Let's get the client machine set up first and see how to synchronize\n\ - \032 two directories on a single machine.\n\ - \n\ - \032 Follow the instructions in the section \"Installation\" to either\n\ - \032 download or build an executable version of Unison, and install it\n\ - \032 somewhere on your search path. (If you just want to use the textual\n\ - \032 user interface, download the appropriate textui binary. If you just\n\ - \032 want to the graphical interface--or if you will use both interfaces\n\ - \032 [the gtkui binary actually has both compiled in]--then download the\n\ - \032 gtkui binary.)\n\ - \n\ - \032 Create a small test directory a.tmp containing a couple of files\n\ - \032 and/or subdirectories, e.g.,\n\ - \032 mkdir a.tmp\n\ - \032 touch a.tmp/a a.tmp/b\n\ - \032 mkdir a.tmp/d\n\ - \032 touch a.tmp/d/f\n\ - \n\ - \032 Copy this directory to b.tmp:\n\ - \032 cp -r a.tmp b.tmp\n\ - \n\ - \032 Now try synchronizing a.tmp and b.tmp. (Since they are identical,\n\ - \032 synchronizing them won't propagate any changes, but Unison will\n\ - \032 remember the current state of both directories so that it will be able\n\ - \032 to tell next time what has changed.) Type:\n\ - \032 unison a.tmp b.tmp\n\ - \n\ - \032 Textual Interface:\n\ - \032 * You should see a message notifying you that all the files are\n\ - \032 actually equal and then get returned to the command line.\n\ - \n\ - \032 Graphical Interface:\n\ - \032 * You should get a big empty window with a message at the bottom\n\ - \032 notifying you that all files are identical. Choose the Exit item\n\ - \032 from the File menu to get back to the command line.\n\ - \n\ - \032 Next, make some changes in a.tmp and/or b.tmp. For example:\n\ - \032 rm a.tmp/a\n\ - \032 echo \"Hello\" > a.tmp/b\n\ - \032 echo \"Hello\" > b.tmp/b\n\ - \032 date > b.tmp/c\n\ - \032 echo \"Hi there\" > a.tmp/d/h\n\ - \032 echo \"Hello there\" > b.tmp/d/h\n\ - \n\ - \032 Run Unison again:\n\ - \032 unison a.tmp b.tmp\n\ - \n\ - \032 This time, the user interface will display only the files that have\n\ - \032 changed. If a file has been modified in just one replica, then it will\n\ - \032 be displayed with an arrow indicating the direction that the change\n\ - \032 needs to be propagated. For example,\n\ - \032 <--- new file c [f]\n\ - \n\ - \032 indicates that the file c has been modified only in the second\n\ - \032 replica, and that the default action is therefore to propagate the new\n\ - \032 version to the first replica. To follw Unison's recommendation, press\n\ - \032 the \"f\" at the prompt.\n\ - \n\ - \032 If both replicas are modified and their contents are different, then\n\ - \032 the changes are in conflict: <-?-> is displayed to indicate that\n\ - \032 Unison needs guidance on which replica should override the other.\n\ - \032 new file <-?-> new file d/h []\n\ - \n\ - \032 By default, neither version will be propagated and both replicas will\n\ - \032 remain as they are.\n\ - \n\ - \032 If both replicas have been modified but their new contents are the\n\ - \032 same (as with the file b), then no propagation is necessary and\n\ - \032 nothing is shown. Unison simply notes that the file is up to date.\n\ - \n\ - \032 These display conventions are used by both versions of the user\n\ - \032 interface. The only difference lies in the way in which Unison's\n\ - \032 default actions are either accepted or overriden by the user.\n\ - \n\ - \032 Textual Interface:\n\ - \032 * The status of each modified file is displayed, in turn. When the\n\ - \032 copies of a file in the two replicas are not identical, the user\n\ - \032 interface will ask for instructions as to how to propagate the\n\ - \032 change. If some default action is indicated (by an arrow), you can\n\ - \032 simply press Return to go on to the next changed file. If you want\n\ - \032 to do something different with this file, press \"<\" or \">\" to\n\ - \032 force the change to be propagated from right to left or from left\n\ - \032 to right, or else press \"/\" to skip this file and leave both\n\ - \032 replicas alone. When it reaches the end of the list of modified\n\ - \032 files, Unison will ask you one more time whether it should proceed\n\ - \032 with the updates that have been selected.\n\ - \032 When Unison stops to wait for input from the user, pressing \"?\"\n\ - \032 will always give a list of possible responses and their meanings.\n\ - \n\ - \032 Graphical Interface:\n\ - \032 * The main window shows all the files that have been modified in\n\ - \032 either a.tmp or b.tmp. To override a default action (or to select\n\ - \032 an action in the case when there is no default), first select the\n\ - \032 file, either by clicking on its name or by using the up- and\n\ - \032 down-arrow keys. Then press either the left-arrow or \"<\" key (to\n\ - \032 cause the version in b.tmp to propagate to a.tmp) or the\n\ - \032 right-arrow or \">\" key (which makes the a.tmp version override\n\ - \032 b.tmp).\n\ - \032 Every keyboard command can also be invoked from the menus at the\n\ - \032 top of the user interface. (Conversely, each menu item is\n\ - \032 annotated with its keyboard equivalent, if it has one.)\n\ - \032 When you are satisfied with the directions for the propagation of\n\ - \032 changes as shown in the main window, click the \"Go\" button to set\n\ - \032 them in motion. A check sign will be displayed next to each\n\ - \032 filename when the file has been dealt with.\n\ - \n\ - Remote Usage\n\ - \n\ - \032 Next, we'll get Unison set up to synchronize replicas on two different\n\ - \032 machines.\n\ - \n\ - \032 Follow the instructions in the Installation section to download or\n\ - \032 build an executable version of Unison on the server machine, and\n\ - \032 install it somewhere on your search path. (It doesn't matter whether\n\ - \032 you install the textual or graphical version, since the copy of Unison\n\ - \032 on the server doesn't need to display any user interface at all.)\n\ - \n\ - \032 It is important that the version of Unison installed on the server\n\ - \032 machine is the same as the version of Unison on the client machine.\n\ - \032 But some flexibility on the version of Unison at the client side can\n\ - \032 be achieved by using the -addversionno option; see the section\n\ - \032 \"Preferences\" .\n\ - \n\ - \032 Now there is a decision to be made. Unison provides two methods for\n\ - \032 communicating between the client and the server:\n\ - \032 * Remote shell method: To use this method, you must have some way of\n\ - \032 invoking remote commands on the server from the client's command\n\ - \032 line, using a facility such as ssh. This method is more convenient\n\ - \032 (since there is no need to manually start a \"unison server\"\n\ - \032 process on the server) and also more secure (especially if you use\n\ - \032 ssh).\n\ - \032 * Socket method: This method requires only that you can get TCP\n\ - \032 packets from the client to the server and back. A draconian\n\ - \032 firewall can prevent this, but otherwise it should work anywhere.\n\ - \n\ - \032 Decide which of these you want to try, and continue with the section\n\ - \032 \"Remote Shell Method\" or the section \"Socket Method\" , as appropriate.\n\ - \n\ - Remote Shell Method\n\ - \n\ - \032 The standard remote shell facility on Unix systems is ssh, which\n\ - \032 provides the same functionality as the older rsh but much better\n\ - \032 security. Ssh is available from ftp://ftp.cs.hut.fi/pub/ssh/;\n\ - \032 up-to-date binaries for some architectures can also be found at\n\ - \032 ftp://ftp.faqs.org/ssh/contrib. See section [1]A.2 for installation\n\ - \032 instructions for the Windows version.\n\ - \n\ - \032 Running ssh requires some coordination between the client and server\n\ - \032 machines to establish that the client is allowed to invoke commands on\n\ - \032 the server; please refer to the or ssh documentation for information\n\ - \032 on how to set this up. The examples in this section use ssh, but you\n\ - \032 can substitute rsh for ssh if you wish.\n\ - \n\ - \032 First, test that we can invoke Unison on the server from the client.\n\ - \032 Typing\n\ - \032 ssh remotehostname unison -version\n\ - \n\ - \032 should print the same version information as running\n\ - \032 unison -version\n\ - \n\ - \032 locally on the client. If remote execution fails, then either\n\ - \032 something is wrong with your ssh setup (e.g., \"permission denied\") or\n\ - \032 else the search path that's being used when executing commands on the\n\ - \032 server doesn't contain the unison executable (e.g., \"command not\n\ - \032 found\").\n\ - \n\ - \032 Create a test directory a.tmp in your home directory on the client\n\ - \032 machine.\n\ - \n\ - \032 Test that the local unison client can start and connect to the remote\n\ - \032 server. Type\n\ - \032 unison -testServer a.tmp ssh://remotehostname/a.tmp\n\ - \n\ - \032 Now cd to your home directory and type:\n\ - \032 unison a.tmp ssh://remotehostname/a.tmp\n\ - \n\ - \032 The result should be that the entire directory a.tmp is propagated\n\ - \032 from the client to your home directory on the server.\n\ - \n\ - \032 After finishing the first synchronization, change a few files and try\n\ - \032 synchronizing again. You should see similar results as in the local\n\ - \032 case.\n\ - \n\ - \032 If your user name on the server is not the same as on the client, you\n\ - \032 need to specify it on the command line:\n\ - \032 unison a.tmp ssh://username at remotehostname/a.tmp\n\ - \n\ - \032 Notes:\n\ - \032 * If you want to put a.tmp some place other than your home directory\n\ - \032 on the remote host, you can give an absolute path for it by adding\n\ - \032 an extra slash between remotehostname and the beginning of the\n\ - \032 path:\n\ - \032 unison a.tmp ssh://remotehostname//absolute/path/to/a.tmp\n\ - \032 * You can give an explicit path for the unison executable on the\n\ - \032 server by using the command-line option \"-servercmd\n\ - \032 /full/path/name/of/unison\" or adding\n\ - \032 \"servercmd=/full/path/name/of/unison\" to your profile (see the\n\ - \032 section \"Profile\" ). Similarly, you can specify a explicit path\n\ - \032 for the ssh program using the \"-sshcmd\" option. Extra arguments\n\ - \032 can be passed to ssh by setting the -sshargs preference.\n\ - \n\ - Socket Method\n\ - \n\ - \032 Warning: The socket method is insecure: not only are the texts of\n\ - \032 your changes transmitted over the network in unprotected form, it\n\ - \032 is also possible for anyone in the world to connect to the server\n\ - \032 process and read out the contents of your filesystem! (Of course,\n\ - \032 to do this they must understand the protocol that Unison uses to\n\ - \032 communicate between client and server, but all they need for this\n\ - \032 is a copy of the Unison sources.) The socket method is provided\n\ - \032 only for expert users with specific needs; everyone else should use\n\ - \032 the ssh method.\n\ - \n\ - \032 To run Unison over a socket connection, you must start a Unison daemon\n\ - \032 process on the server. This process runs continuously, waiting for\n\ - \032 connections over a given socket from client machines running Unison\n\ - \032 and processing their requests in turn.\n\ - \n\ - \032 To start the daemon, type\n\ - \032 unison -socket NNNN\n\ - \n\ - \032 on the server machine, where NNNN is the socket number that the daemon\n\ - \032 should listen on for connections from clients. (NNNN can be any large\n\ - \032 number that is not being used by some other program; if NNNN is\n\ - \032 already in use, Unison will exit with an error message.) Note that\n\ - \032 paths specified by the client will be interpreted relative to the\n\ - \032 directory in which you start the server process; this behavior is\n\ - \032 different from the ssh case, where the path is relative to your home\n\ - \032 directory on the server.\n\ - \n\ - \032 Create a test directory a.tmp in your home directory on the client\n\ - \032 machine. Now type:\n\ - \032 unison a.tmp socket://remotehostname:NNNN/a.tmp\n\ - \n\ - \032 The result should be that the entire directory a.tmp is propagated\n\ - \032 from the client to the server (a.tmp will be created on the server in\n\ - \032 the directory that the server was started from). After finishing the\n\ - \032 first synchronization, change a few files and try synchronizing again.\n\ - \032 You should see similar results as in the local case.\n\ - \n\ - \032 Since the socket method is not used by many people, its functionality\n\ - \032 is rather limited. For example, the server can only deal with one\n\ - \032 client at a time.\n\ - \n\ - Using Unison for All Your Files\n\ - \n\ - \032 Once you are comfortable with the basic operation of Unison, you may\n\ - \032 find yourself wanting to use it regularly to synchronize your commonly\n\ - \032 used files. There are several possible ways of going about this:\n\ - \032 1. Synchronize your whole home directory, using the Ignore facility\n\ - \032 (see the section \"Ignore\" ) to avoid synchronizing temporary files\n\ - \032 and things that only belong on one host.\n\ - \032 2. Create a subdirectory called shared (or current, or whatever) in\n\ - \032 your home directory on each host, and put all the files you want\n\ - \032 to synchronize into this directory.\n\ - \032 3. Create a subdirectory called shared (or current, or whatever) in\n\ - \032 your home directory on each host, and put links to all the files\n\ - \032 you want to synchronize into this directory. Use the follow\n\ - \032 preference (see the section \"Symbolic Links\" ) to make Unison\n\ - \032 treat these links as transparent.\n\ - \032 4. Make your home directory the root of the synchronization, but tell\n\ - \032 Unison to synchronize only some of the files and subdirectories\n\ - \032 within it on any given run. This can be accomplished by using the\n\ - \032 -path switch on the command line:\n\ - \032 unison /home/username ssh://remotehost//home/username -path shared\n\ - \032 The -path option can be used as many times as needed, to\n\ - \032 synchronize several files or subdirectories:\n\ - \032 unison /home/username ssh://remotehost//home/username \\\n\ - \032 -path shared \\\n\ - \032 -path pub \\\n\ - \032 -path .netscape/bookmarks.html\n\ - \032 These -path arguments can also be put in your preference file. See\n\ - \032 the section \"Preferences\" for an example.\n\ - \n\ - \032 Most people find that they only need to maintain a profile (or\n\ - \032 profiles) on one of the hosts that they synchronize, since Unison is\n\ - \032 always initiated from this host. (For example, if you're synchronizing\n\ - \032 a laptop with a fileserver, you'll probably always run Unison on the\n\ - \032 laptop.) This is a bit different from the usual situation with\n\ - \032 asymmetric mirroring programs like rdist, where the mirroring\n\ - \032 operation typically needs to be initiated from the machine with the\n\ - \032 most recent changes. the section \"Profile\" covers the syntax of Unison\n\ - \032 profiles, together with some sample profiles.\n\ - \n\ - \032 Some tips on improving Unison's performance can be found on the\n\ - \032 Frequently Asked Questions page\n\ - \032 (http://www.cis.upenn.edu/~bcpierce/unison/faq.html).\n\ - \n\ - Using Unison to Synchronize More Than Two Machines\n\ - \n\ - \032 Unison is designed for synchronizing pairs of replicas. However, it is\n\ - \032 possible to use it to keep larger groups of machines in sync by\n\ - \032 performing multiple pairwise synchronizations.\n\ - \n\ - \032 If you need to do this, the most reliable way to set things up is to\n\ - \032 organize the machines into a \"star topology,\" with one machine\n\ - \032 designated as the \"hub\" and the rest as \"spokes,\" and with each spoke\n\ - \032 machine synchronizing only with the hub. The big advantage of the star\n\ - \032 topology is that it eliminates the possibility of confusing \"spurious\n\ - \032 conflicts\" arising from the fact that a separate archive is maintained\n\ - \032 by Unison for every pair of hosts that it synchronizes.\n\ - \n\ - Going Further\n\ - \n\ - \032 On-line documentation for the various features of Unison can be\n\ - \032 obtained either by typing\n\ - \032 unison -doc topics\n\ - \n\ - \032 at the command line, or by selecting the Help menu in the graphical\n\ - \032 user interface. The same information is also available in a typeset\n\ - \032 User's Manual (HTML or PostScript format) through\n\ - \032 http://www.cis.upenn.edu/~bcpierce/unison.\n\ - \n\ - \032 If you use Unison regularly, you should subscribe to one of the\n\ - \032 mailing lists, to receive announcements of new versions. See the\n\ - \032 section \"Mailing Lists\" .\n\ - \n\ - ")) -:: - ("basics", ("Basic Concepts", - "Basic Concepts\n\ - \n\ - \032 To understand how Unison works, it is necessary to discuss a few\n\ - \032 straightforward concepts. These concepts are developed more rigorously\n\ - \032 and at more length in a number of papers, available at\n\ - \032 http://www.cis.upenn.edu/~bcpierce/papers. But the informal\n\ - \032 presentation here should be enough for most users.\n\ - \n\ - Roots\n\ - \n\ - \032 A replica's root tells Unison where to find a set of files to be\n\ - \032 synchronized, either on the local machine or on a remote host. For\n\ - \032 example,\n\ - \032 relative/path/of/root\n\ - \n\ - \032 specifies a local root relative to the directory where Unison is\n\ - \032 started, while\n\ - \032 /absolute/path/of/root\n\ - \n\ - \032 specifies a root relative to the top of the local filesystem,\n\ - \032 independent of where Unison is running. Remote roots can begin with\n\ - \032 ssh://, rsh:// to indicate that the remote server should be started\n\ - \032 with rsh or ssh:\n\ - \032 ssh://remotehost//absolute/path/of/root\n\ - \032 rsh://user at remotehost/relative/path/of/root\n\ - \n\ - \032 If the remote server is already running (in the socket mode), then the\n\ - \032 syntax\n\ - \032 socket://remotehost:portnum//absolute/path/of/root\n\ - \032 socket://remotehost:portnum/relative/path/of/root\n\ - \n\ - \032 is used to specify the hostname and the port that the client Unison\n\ - \032 should use to contact it.\n\ - \n\ - \032 The syntax for roots is based on that of URIs (described in RFC 2396).\n\ - \032 The full grammar is:\n\ - \032 replica ::= [protocol:]//[user@][host][:port][/path]\n\ - \032 | path\n\ - \n\ - \032 protocol ::= file\n\ - \032 | socket\n\ - \032 | ssh\n\ - \032 | rsh\n\ - \n\ - \032 user ::= [-_a-zA-Z0-9]+\n\ - \n\ - \032 host ::= [-_a-zA-Z0-9.]+\n\ - \n\ - \032 port ::= [0-9]+\n\ - \n\ - \032 When path is given without any protocol prefix, the protocol is\n\ - \032 assumed to be file:. Under Windows, it is possible to synchronize with\n\ - \032 a remote directory using the file: protocol over the Windows Network\n\ - \032 Neighborhood. For example,\n\ - \032 unison foo //host/drive/bar\n\ - \n\ - \032 synchronizes the local directory foo with the directory drive:\\bar on\n\ - \032 the machine host, provided that host is accessible via Network\n\ - \032 Neighborhood. When the file: protocol is used in this way, there is no\n\ - \032 need for a Unison server to be running on the remote host. However,\n\ - \032 running Unison this way is only a good idea if the remote host is\n\ - \032 reached by a very fast network connection, since the full contents of\n\ - \032 every file in the remote replica will have to be transferred to the\n\ - \032 local machine to detect updates.\n\ - \n\ - \032 The names of roots are canonized by Unison before it uses them to\n\ - \032 compute the names of the corresponding archive files, so\n\ - \032 //saul//home/bcpierce/common and //saul.cis.upenn.edu/common will be\n\ - \032 recognized as the same replica under different names.\n\ - \n\ - Paths\n\ - \n\ - \032 A path refers to a point within a set of files being synchronized; it\n\ - \032 is specified relative to the root of the replica.\n\ - \n\ - \032 Formally, a path is just a sequence of names, separated by /. Note\n\ - \032 that the path separator character is always a forward slash, no matter\n\ - \032 what operating system Unison is running on. Forward slashes are\n\ - \032 converted to backslashes as necessary when paths are converted to\n\ - \032 filenames in the local filesystem on a particular host. (For example,\n\ - \032 suppose that we run Unison on a Windows system, synchronizing the\n\ - \032 local root c:\\pierce with the root\n\ - \032 ssh://saul.cis.upenn.edu/home/bcpierce on a Unix server. Then the path\n\ - \032 current/todo.txt refers to the file c:\\pierce\\current\\todo.txt on the\n\ - \032 client and /home/bcpierce/current/todo.txt on the server.)\n\ - \n\ - \032 The empty path (i.e., the empty sequence of names) denotes the whole\n\ - \032 replica. Unison displays the empty path as \"[root].\"\n\ - \n\ - \032 If p is a path and q is a path beginning with p, then q is said to be\n\ - \032 a descendant of p. (Each path is also a descendant of itself.)\n\ - \n\ - What is an Update?\n\ - \n\ - \032 The contents of a path p in a particular replica could be a file, a\n\ - \032 directory, a symbolic link, or absent (if p does not refer to anything\n\ - \032 at all in that replica). More specifically:\n\ - \032 * If p refers to an ordinary file, then the contents of p are the\n\ - \032 actual contents of this file (a string of bytes) plus the current\n\ - \032 permission bits of the file.\n\ - \032 * If p refers to a symbolic link, then the contents of p are just\n\ - \032 the string specifying where the link points.\n\ - \032 * If p refers to a directory, then the contents of p are just the\n\ - \032 token \"DIRECTORY\" plus the current permission bits of the\n\ - \032 directory.\n\ - \032 * If p does not refer to anything in this replica, then the contents\n\ - \032 of p are the token \"ABSENT.\"\n\ - \n\ - \032 Unison keeps a record of the contents of each path after each\n\ - \032 successful synchronization of that path (i.e., it remembers the\n\ - \032 contents at the last moment when they were the same in the two\n\ - \032 replicas).\n\ - \n\ - \032 We say that a path is updated (in some replica) if its current\n\ - \032 contents are different from its contents the last time it was\n\ - \032 successfully synchronized. Note that whether a path is updated has\n\ - \032 nothing to do with its last modification time--Unison considers only\n\ - \032 the contents when determining whether an update has occurred. This\n\ - \032 means that touching a file without changing its contents will not be\n\ - \032 recognized as an update. A file can even be changed several times and\n\ - \032 then changed back to its original contents; as long as Unison is only\n\ - \032 run at the end of this process, no update will be recognized.\n\ - \n\ - \032 What Unison actually calculates is a close approximation to this\n\ - \032 definition; see the section \"Caveats and Shortcomings\" .\n\ - \n\ - What is a Conflict?\n\ - \n\ - \032 A path is said to be conflicting if the following conditions all hold:\n\ - \032 1. it has been updated in one replica,\n\ - \032 2. it or any of its descendants has been updated in the other\n\ - \032 replica, and\n\ - \032 3. its contents in the two replicas are not identical.\n\ - \n\ - Reconciliation\n\ - \n\ - \032 Unison operates in several distinct stages:\n\ - \032 1. On each host, it compares its archive file (which records the\n\ - \032 state of each path in the replica when it was last synchronized)\n\ - \032 with the current contents of the replica, to determine which paths\n\ - \032 have been updated.\n\ - \032 2. It checks for \"false conflicts\" -- paths that have been updated on\n\ - \032 both replicas, but whose current values are identical. These paths\n\ - \032 are silently marked as synchronized in the archive files in both\n\ - \032 replicas.\n\ - \032 3. It displays all the updated paths to the user. For updates that do\n\ - \032 not conflict, it suggests a default action (propagating the new\n\ - \032 contents from the updated replica to the other). Conflicting\n\ - \032 updates are just displayed. The user is given an opportunity to\n\ - \032 examine the current state of affairs, change the default actions\n\ - \032 for nonconflicting updates, and choose actions for conflicting\n\ - \032 updates.\n\ - \032 4. It performs the selected actions, one at a time. Each action is\n\ - \032 performed by first transferring the new contents to a temporary\n\ - \032 file on the receiving host, then atomically moving them into\n\ - \032 place.\n\ - \032 5. It updates its archive files to reflect the new state of the\n\ - \032 replicas.\n\ - \n\ - ")) -:: - ("failures", ("Invariants", - "Invariants\n\ - \n\ - \032 Given the importance and delicacy of the job that it performs, it is\n\ - \032 important to understand both what a synchronizer does under normal\n\ - \032 conditions and what can happen under unusual conditions such as system\n\ - \032 crashes and communication failures.\n\ - \n\ - \032 Unison is careful to protect both its internal state and the state of\n\ - \032 the replicas at every point in this process. Specifically, the\n\ - \032 following guarantees are enforced:\n\ - \032 * At every moment, each path in each replica has either (1) its\n\ - \032 original contents (i.e., no change at all has been made to this\n\ - \032 path), or (2) its correct final contents (i.e., the value that the\n\ - \032 user expected to be propagated from the other replica).\n\ - \032 * At every moment, the information stored on disk about Unison's\n\ - \032 private state can be either (1) unchanged, or (2) updated to\n\ - \032 reflect those paths that have been successfully synchronized.\n\ - \n\ - \032 The upshot is that it is safe to interrupt Unison at any time, either\n\ - \032 manually or accidentally. [Caveat: the above is almost true there are\n\ - \032 occasionally brief periods where it is not (and, because of\n\ - \032 shortcoming of the Posix filesystem API, cannot be); in particular,\n\ - \032 when it is copying a file onto a directory or vice versa, it must\n\ - \032 first move the original contents out of the way. If Unison gets\n\ - \032 interrupted during one of these periods, some manual cleanup may be\n\ - \032 required. In this case, a file called DANGER.README will be left in\n\ - \032 your home directory, containing information about the operation that\n\ - \032 was interrupted. The next time you try to run Unison, it will notice\n\ - \032 this file and warn you about it.]\n\ - \n\ - \032 If an interruption happens while it is propagating updates, then there\n\ - \032 may be some paths for which an update has been propagated but which\n\ - \032 have not been marked as synchronized in Unison's archives. This is no\n\ - \032 problem: the next time Unison runs, it will detect changes to these\n\ - \032 paths in both replicas, notice that the contents are now equal, and\n\ - \032 mark the paths as successfully updated when it writes back its private\n\ - \032 state at the end of this run.\n\ - \n\ - \032 If Unison is interrupted, it may sometimes leave temporary working\n\ - \032 files (with suffix .tmp) in the replicas. It is safe to delete these\n\ - \032 files. Also, if the backups flag is set, Unison will leave around old\n\ - \032 versions of files that it overwrites, with names like\n\ - \032 file.0.unison.bak. These can be deleted safely when they are no longer\n\ - \032 wanted.\n\ - \n\ - \032 Unison is not bothered by clock skew between the different hosts on\n\ - \032 which it is running. It only performs comparisons between timestamps\n\ - \032 obtained from the same host, and the only assumption it makes about\n\ - \032 them is that the clock on each system always runs forward.\n\ - \n\ - \032 If Unison finds that its archive files have been deleted (or that the\n\ - \032 archive format has changed and they cannot be read, or that they don't\n\ - \032 exist because this is the first run of Unison on these particular\n\ - \032 roots), it takes a conservative approach: it behaves as though the\n\ - \032 replicas had both been completely empty at the point of the last\n\ - \032 synchronization. The effect of this is that, on the first run, files\n\ - \032 that exist in only one replica will be propagated to the other, while\n\ - \032 files that exist in both replicas but are unequal will be marked as\n\ - \032 conflicting.\n\ - \n\ - \032 Touching a file without changing its contents should never affect\n\ - \032 whether or not Unison does an update. (When running with the fastcheck\n\ - \032 preference set to true--the default on Unix systems--Unison uses file\n\ - \032 modtimes for a quick first pass to tell which files have definitely\n\ - \032 not changed; then, for each file that might have changed, it computes\n\ - \032 a fingerprint of the file's contents and compares it against the\n\ - \032 last-synchronized contents. Also, the -times option allows you to\n\ - \032 synchronize file times, but it does not cause identical files to be\n\ - \032 changed; Unison will only modify the file times.)\n\ - \n\ - \032 It is safe to \"brainwash\" Unison by deleting its archive files on both\n\ - \032 replicas. The next time it runs, it will assume that all the files it\n\ - \032 sees in the replicas are new.\n\ - \n\ - \032 It is safe to modify files while Unison is working. If Unison\n\ - \032 discovers that it has propagated an out-of-date change, or that the\n\ - \032 file it is updating has changed on the target replica, it will signal\n\ - \032 a failure for that file. Run Unison again to propagate the latest\n\ - \032 change.\n\ - \n\ - \032 Changes to the ignore patterns from the user interface (e.g., using\n\ - \032 the `i' key) are immediately reflected in the current profile.\n\ - \n\ - Caveats and Shortcomings\n\ - \n\ - \032 Here are some things to be careful of when using Unison.\n\ - \032 * In the interests of speed, the update detection algorithm may\n\ - \032 (depending on which OS architecture that you run Unison on)\n\ - \032 actually use an approximation to the definition given in the\n\ - \032 section \"What is an Update?\" .\n\ - \032 In particular, the Unix implementation does not compare the actual\n\ - \032 contents of files to their previous contents, but simply looks at\n\ - \032 each file's inode number and modtime; if neither of these have\n\ - \032 changed, then it concludes that the file has not been changed.\n\ - \032 Under normal circumstances, this approximation is safe, in the\n\ - \032 sense that it may sometimes detect \"false updates\" will never miss\n\ - \032 a real one. However, it is possible to fool it, for example by\n\ - \032 using retouch to change a file's modtime back to a time in the\n\ - \032 past.\n\ - \032 * If you synchronize between a single-user filesystem and a shared\n\ - \032 Unix server, you should pay attention to your permission bits: by\n\ - \032 default, Unison will synchronize permissions verbatim, which may\n\ - \032 leave group-writable files on the server that could be written\n\ - \032 over by a lot of people.\n\ - \032 You can control this by setting your umask on both computers to\n\ - \032 something like 022, masking out the \"world write\" and \"group\n\ - \032 write\" permission bits.\n\ - \032 Unison does not synchronize the setuid and setgid bits, for\n\ - \032 security.\n\ - \032 * The graphical user interface is single-threaded. This means that\n\ - \032 if Unison is performing some long-running operation, the display\n\ - \032 will not be repainted until it finishes. We recommend not trying\n\ - \032 to do anything with the user interface while Unison is in the\n\ - \032 middle of detecting changes or propagating files.\n\ - \032 * Unison does not understand hard links.\n\ - \032 * It is important to be a little careful when renaming directories\n\ - \032 containing \"ignore\"d files.\n\ - \032 For example, suppose Unison is synchronizing directory A between\n\ - \032 the two machines called the \"local\" and the \"remote\" machine;\n\ - \032 suppose directory A contains a subdirectory D; and suppose D on\n\ - \032 the local machine contains a file or subdirectory P that matches\n\ - \032 an ignore directive in the profile used to synchronize. Thus path\n\ - \032 A/D/P exists on the local machine but not on the remote machine.\n\ - \032 If D is renamed to D' on the remote machine, and this change is\n\ - \032 propagated to the local machine, all such files or subdirectories\n\ - \032 P will be deleted. This is because Unison sees the rename as a\n\ - \032 delete and a separate create: it deletes the old directory\n\ - \032 (including the ignored files) and creates a new one (not including\n\ - \032 the ignored files, since they are completely invisible to it).\n\ - \n\ - ")) -:: - ("", ("Reference Guide", - "Reference Guide\n\ - \n\ - \032 This section covers the features of Unison in detail.\n\ - \n\ - ")) -:: - ("running", ("Running Unison", - "Running Unison\n\ - \n\ - \032 There are several ways to start Unison.\n\ - \032 * Typing \"unison profile\" on the command line. Unison will look for\n\ - \032 a file profile.prf in the .unison directory. If this file does not\n\ - \032 specify a pair of roots, Unison will prompt for them and add them\n\ - \032 to the information specified by the profile.\n\ - \032 * Typing \"unison profile root1 root2\" on the command line. In this\n\ - \032 case, Unison will use profile, which should not contain any root\n\ - \032 directives.\n\ - \032 * Typing \"unison root1 root2\" on the command line. This has the same\n\ - \032 effect as typing \"unison default root1 root2.\"\n\ - \032 * Typing just \"unison\" (or invoking Unison by clicking on a desktop\n\ - \032 icon). In this case, Unison will ask for the profile to use for\n\ - \032 synchronization (or create a new one, if necessary).\n\ - \n\ - The .unison Directory\n\ - \n\ - \032 Unison stores a variety of information in a private directory on each\n\ - \032 host. If the environment variable UNISON is defined, then its value\n\ - \032 will be used as the name of this directory. If UNISON is not defined,\n\ - \032 then the name of the directory depends on which operating system you\n\ - \032 are using. In Unix, the default is to use $HOME/.unison. In Windows,\n\ - \032 if the environment variable USERPROFILE is defined, then the directory\n\ - \032 will be $USERPROFILE\\.unison; otherwise if HOME is defined, it will be\n\ - \032 $HOME\\.unison; otherwise, it will be c:\\.unison.\n\ - \n\ - \032 The archive file for each replica is found in the .unison directory on\n\ - \032 that replica's host. Profiles (described below) are always taken from\n\ - \032 the .unison directory on the client host.\n\ - \n\ - \032 Note that Unison maintains a completely different set of archive files\n\ - \032 for each pair of roots.\n\ - \n\ - \032 We do not recommend synchronizing the whole .unison directory, as this\n\ - \032 will involve frequent propagation of large archive files. It should be\n\ - \032 safe to do it, though, if you really want to. Synchronizing just the\n\ - \032 profile files in the .unison directory is definitely OK.\n\ - \n\ - Archive Files\n\ - \n\ - \032 The name of the archive file on each replica is calculated from\n\ - \032 * the canonical names of all the hosts (short names like saul are\n\ - \032 converted into full addresses like saul.cis.upenn.edu),\n\ - \032 * the paths to the replicas on all the hosts (again, relative\n\ - \032 pathnames, symbolic links, etc. are converted into full, absolute\n\ - \032 paths), and\n\ - \032 * an internal version number that is changed whenever a new Unison\n\ - \032 release changes the format of the information stored in the\n\ - \032 archive.\n\ - \n\ - \032 This method should work well for most users. However, it is\n\ - \032 occasionally useful to change the way archive names are generated.\n\ - \032 Unison provides two ways of doing this.\n\ - \n\ - \032 The function that finds the canonical hostname of the local host\n\ - \032 (which is used, for example, in calculating the name of the archive\n\ - \032 file used to remember which files have been synchronized) normally\n\ - \032 uses the gethostname operating system call. However, if the\n\ - \032 environment variable UNISONLOCALHOSTNAME is set, its value will be\n\ - \032 used instead. This makes it easier to use Unison in situations where a\n\ - \032 machine's name changes frequently (e.g., because it is a laptop and\n\ - \032 gets moved around a lot).\n\ - \n\ - \032 A more powerful way of changing archive names is provided by the\n\ - \032 rootalias preference. The preference file may contain any number of\n\ - \032 lines of the form:\n\ - \032 rootalias = //hostnameA//path-to-replicaA -> //hostnameB//path-to-replicaB\n\ - \n\ - \032 When calculating the name of the archive files for a given pair of\n\ - \032 roots, Unison replaces any root that matches the left-hand side of any\n\ - \032 rootalias rule by the corresponding right-hand side.\n\ - \n\ - \032 So, if you need to relocate a root on one of the hosts, you can add a\n\ - \032 rule of the form:\n\ - \032 rootalias = //new-hostname//new-path -> //old-hostname//old-path\n\ - \n\ - \032 Warning: The rootalias option is dangerous and should only be used if\n\ - \032 you are sure you know what you're doing. In particular, it should only\n\ - \032 be used if you are positive that either (1) both the original root and\n\ - \032 the new alias refer to the same set of files, or (2) the files have\n\ - \032 been relocated so that the original name is now invalid and will never\n\ - \032 be used again. (If the original root and the alias refer to different\n\ - \032 sets of files, Unison's update detector could get confused.) After\n\ - \032 introducing a new rootalias, it is a good idea to run Unison a few\n\ - \032 times interactively (with the batch flag off, etc.) and carefully\n\ - \032 check that things look reasonable--in particular, that update\n\ - \032 detection is working as expected.\n\ - \n\ - Preferences\n\ - \n\ - \032 Many details of Unison's behavior are configurable by user-settable\n\ - \032 \"preferences.\"\n\ - \n\ - \032 Some preferences are boolean-valued; these are often called flags.\n\ - \032 Others take numeric or string arguments, indicated in the preferences\n\ - \032 list by n or xxx. Most of the string preferences can be given several\n\ - \032 times; the arguments are accumulated into a list internally.\n\ - \n\ - \032 There are two ways to set the values of preferences: temporarily, by\n\ - \032 providing command-line arguments to a particular run of Unison, or\n\ - \032 permanently, by adding commands to a profile in the .unison directory\n\ - \032 on the client host. The order of preferences (either on the command\n\ - \032 line or in preference files) is not significant. On the command line,\n\ - \032 preferences and other arguments (the profile name and roots) can be\n\ - \032 intermixed in any order.\n\ - \n\ - \032 To set the value of a preference p from the command line, add an\n\ - \032 argument -p (for a boolean flag) or -p n or -p xxx (for a numeric or\n\ - \032 string preference) anywhere on the command line. To set a boolean flag\n\ - \032 to false on the command line, use -p=false.\n\ - \n\ - \032 Here are all the preferences supported by Unison. This list can be\n\ - \032 obtained by typing unison -help.\n\ - \n\ - Usage: unison [options]\n\ - \032 or unison root1 root2 [options]\n\ - \032 or unison profilename [options]\n\ - \n\ - Basic options:\n\ - \032-auto automatically accept default (nonconflicting) actions\n\ - \032-batch batch mode: ask no questions at all\n\ - \032-doc xxx show documentation ('-doc topics' lists topics)\n\ - \032-follow xxx add a pattern to the follow list\n\ - \032-force xxx force changes from this replica to the other\n\ - \032-group synchronize group attributes\n\ - \032-ignore xxx add a pattern to the ignore list\n\ - \032-ignorenot xxx add a pattern to the ignorenot list\n\ - \032-owner synchronize owner\n\ - \032-path xxx path to synchronize\n\ - \032-perms n part of the permissions which is synchronized\n\ - \032-prefer xxx choose this replica's version for conflicting changes\n\ - \032-root xxx root of a replica (should be used exactly twice)\n\ - \032-silent print nothing except error messages\n\ - \032-terse suppress status messages\n\ - \032-testserver exit immediately after the connection to the server\n\ - \032-times synchronize modification times\n\ - \032-version print version and exit\n\ - \n\ - Advanced options:\n\ - \032-addprefsto xxx file to add new prefs to\n\ - \032-addversionno add version number to name of unison on server\n\ - \032-backup xxx add a pattern to the backup list\n\ - \032-backupcurr xxx add a pattern to the backupcurr list\n\ - \032-backupcurrnot xxx add a pattern to the backupcurrnot list\n\ - \032-backupdir xxx directory for storing centralized backups\n\ - \032-backuploc xxx where backups are stored ('local' or 'central')\n\ - \032-backupnot xxx add a pattern to the backupnot list\n\ - \032-backupprefix xxx prefix for the names of backup files\n\ - \032-backups keep backup copies of all files (see also 'backup')\n\ - \032-backupsuffix xxx a suffix to be added to names of backup files\n\ - \032-confirmbigdel ask about whole-replica (or path) deletes (default true)\n\ - \032-confirmmerge ask for confirmation before commiting results of a merge\n\ - \032-contactquietly suppress the 'contacting server' message during startup\n\ - \032-copyprog xxx external program for copying large files\n\ - \032-copyprogrest xxx variant of copyprog for resuming partial transfers\n\ - \032-copyquoterem xxx add quotes to remote file name for copyprog (true/false/def\n\ - ault)\n\ - \032-copythreshold n use copyprog on files bigger than this (if >=0, in Kb)\n\ - \032-debug xxx debug module xxx ('all' -> everything, 'verbose' -> more)\n\ - \032-diff xxx command for showing differences between files\n\ - \032-dontchmod When set, never use the chmod system call\n\ - \032-dumbtty do not change terminal settings in text UI (default true)\n\ - \032-fastcheck xxx do fast update detection (true/false/default)\n\ - \032-forcepartial xxx add a pattern to the forcepartial list\n\ - \032-height n height (in lines) of main window in graphical interface\n\ - \032-host xxx bind the socket to this host name in server socket mode\n\ - \032-ignorecase xxx identify upper/lowercase filenames (true/false/default)\n\ - \032-ignorelocks ignore locks left over from previous run (dangerous!)\n\ - \032-immutable xxx add a pattern to the immutable list\n\ - \032-immutablenot xxx add a pattern to the immutablenot list\n\ - \032-key xxx define a keyboard shortcut for this profile (in some UIs)\n\ - \032-killserver kill server when done (even when using sockets)\n\ - \032-label xxx provide a descriptive string label for this profile\n\ - \032-log record actions in logfile (default true)\n\ - \032-logfile xxx logfile name\n\ - \032-maxbackups n number of backed up versions of a file\n\ - \032-maxthreads n maximum number of simultaneous file transfers\n\ - \032-merge xxx add a pattern to the merge list\n\ - \032-mountpoint xxx abort if this path does not exist\n\ - \032-numericids don't map uid/gid values by user/group names\n\ - \032-preferpartial xxx add a pattern to the preferpartial list\n\ - \032-pretendwin Use creation times for detecting updates\n\ - \032-repeat xxx synchronize repeatedly (text interface only)\n\ - \032-retry n re-try failed synchronizations N times (text ui only)\n\ - \032-rootalias xxx register alias for canonical root names\n\ - \032-rsrc xxx synchronize resource forks (true/false/default)\n\ - \032-rsync activate the rsync transfer mode (default true)\n\ - \032-selftest run internal tests and exit\n\ - \032-servercmd xxx name of unison executable on remote server\n\ - \032-showarchive show 'true names' (for rootalias) of roots and archive\n\ - \032-socket xxx act as a server on a socket\n\ - \032-sortbysize list changed files by size, not name\n\ - \032-sortfirst xxx add a pattern to the sortfirst list\n\ - \032-sortlast xxx add a pattern to the sortlast list\n\ - \032-sortnewfirst list new before changed files\n\ - \032-sshargs xxx other arguments (if any) for remote shell command\n\ - \032-sshcmd xxx path to the ssh executable\n\ - \032-ui xxx select UI ('text' or 'graphic'); command-line only\n\ - \032-xferbycopying optimize transfers using local copies (default true)\n\ - \n\ - \032 Here, in more detail, is what they do. Many are discussed in greater\n\ - \032 detail in other sections of the manual.\n\ - \032 addprefsto xxx\n\ - \032 By default, new preferences added by Unison (e.g., new ignore\n\ - \032 clauses) will be appended to whatever preference file Unison\n\ - \032 was told to load at the beginning of the run. Setting the\n\ - \032 preference addprefsto filename makes Unison add new preferences\n\ - \032 to the file named filename instead.\n\ - \032 addversionno \n\ - \032 When this flag is set to true, Unison will use\n\ - \032 unison-currentversionnumber instead of just unison as the\n\ - \032 remote server command. This allows multiple binaries for\n\ - \032 different versions of unison to coexist conveniently on the\n\ - \032 same server: whichever version is run on the client, the same\n\ - \032 version will be selected on the server.\n\ - \032 auto \n\ - \032 When set to true, this flag causes the user interface to skip\n\ - \032 asking for confirmations on non-conflicting changes. (More\n\ - \032 precisely, when the user interface is done setting the\n\ - \032 propagation direction for one entry and is about to move to the\n\ - \032 next, it will skip over all non-conflicting entries and go\n\ - \032 directly to the next conflict.)\n\ - \032 backup xxx\n\ - \032 Including the preference -backup pathspec causes Unison to keep\n\ - \032 backup files for each path that matches pathspec. These backup\n\ - \032 files are kept in the directory specified by the backuplocation\n\ - \032 preference. The backups are named according to the backupprefix\n\ - \032 and backupsuffix preferences. The number of versions that are\n\ - \032 kept is determined by the maxbackups preference.\n\ - \032 The syntax of pathspec is described in the section \"Path\n\ - \032 Specification\" .\n\ - \032 backupcurr xxx\n\ - \032 Including the preference -backupcurr pathspec causes Unison to\n\ - \032 keep a backup of the current version of every file matching\n\ - \032 pathspec. This file will be saved as a backup with version\n\ - \032 number 000. Such backups can be used as inputs to external\n\ - \032 merging programs, for instance. See the documentatation for the\n\ - \032 merge preference. For more details, see the section \"Merging\n\ - \032 Conflicting Versions\" .\n\ - \032 The syntax of pathspec is described in the section \"Path\n\ - \032 Specification\" .\n\ - \032 backupcurrnot xxx\n\ - \032 Exceptions to backupcurr, like the ignorenot preference.\n\ - \032 backupdir xxx\n\ - \032 If this preference is set, Unison will use it as the name of\n\ - \032 the directory used to store backup files specified by the\n\ - \032 backup preference, when backuplocation is set to central. It is\n\ - \032 checked after the UNISONBACKUPDIR environment variable.\n\ - \032 backuploc xxx\n\ - \032 This preference determines whether backups should be kept\n\ - \032 locally, near the original files, or in a central directory\n\ - \032 specified by the backupdir preference. If set to local, backups\n\ - \032 will be kept in the same directory as the original files, and\n\ - \032 if set to central, backupdir will be used instead.\n\ - \032 backupnot xxx\n\ - \032 The values of this preference specify paths or individual files\n\ - \032 or regular expressions that should not be backed up, even if\n\ - \032 the backup preference selects them--i.e., it selectively\n\ - \032 overrides backup. The same caveats apply here as with ignore\n\ - \032 and t ignorenot.\n\ - \032 backupprefix xxx\n\ - \032 When a backup for a file NAME is created, it is stored in a\n\ - \032 directory specified by backuplocation, in a file called\n\ - \032 backupprefixNAMEbackupsuffix. backupprefix can include a\n\ - \032 directory name (causing Unison to keep all backup files for a\n\ - \032 given directory in a subdirectory with this name), and both\n\ - \032 backupprefix and backupsuffix can contain the string$VERSION,\n\ - \032 which will be replaced by the age of the backup (1 for the most\n\ - \032 recent, 2 for the second most recent, and so on...). This\n\ - \032 keyword is ignored if it appears in a directory name in the\n\ - \032 prefix; if it does not appear anywhere in the prefix or the\n\ - \032 suffix, it will be automatically placed at the beginning of the\n\ - \032 suffix.\n\ - \032 One thing to be careful of: If the backuploc preference is set\n\ - \032 to local, Unison will automatically ignore all files whose\n\ - \032 prefix and suffix match backupprefix and backupsuffix. So be\n\ - \032 careful to choose values for these preferences that are\n\ - \032 sufficiently different from the names of your real files.\n\ - \032 backups \n\ - \032 Setting this flag to true is equivalent to setting\n\ - \032 backuplocation to local and backup to Name *.\n\ - \032 backupsuffix xxx\n\ - \032 See backupprefix for full documentation.\n\ - \032 batch \n\ - \032 When this is set to true, the user interface will ask no\n\ - \032 questions at all. Non-conflicting changes will be propagated;\n\ - \032 conflicts will be skipped.\n\ - \032 confirmbigdel \n\ - \032 !When this is set to true, Unison will request an extra\n\ - \032 confirmation if it appears that the entire replica has been\n\ - \032 deleted, before propagating the change. If the batch flag is\n\ - \032 also set, synchronization will be aborted. When the path\n\ - \032 preference is used, the same confirmation will be requested for\n\ - \032 top-level paths. (At the moment, this flag only affects the\n\ - \032 text user interface.) See also the mountpoint preference.\n\ - \032 confirmmerge \n\ - \032 Setting this preference causes both the text and graphical\n\ - \032 interfaces to ask the user if the results of a merge command\n\ - \032 may be commited to the replica or not. Since the merge command\n\ - \032 works on temporary files, the user can then cancel all the\n\ - \032 effects of applying the merge if it turns out that the result\n\ - \032 is not satisfactory. In batch-mode, this preference has no\n\ - \032 effect. Default is false.\n\ - \032 contactquietly \n\ - \032 If this flag is set, Unison will skip displaying the\n\ - \032 `Contacting server' message (which some users find annoying)\n\ - \032 during startup.\n\ - \032 copyprog xxx\n\ - \032 A string giving the name of an external program that can be\n\ - \032 used to copy large files efficiently (plus command-line\n\ - \032 switches telling it to copy files in-place). The default\n\ - \032 setting invokes rsync with appropriate options--most users\n\ - \032 should not need to change it.\n\ - \032 copyprogrest xxx\n\ - \032 A variant of copyprog that names an external program that\n\ - \032 should be used to continue the transfer of a large file that\n\ - \032 has already been partially transferred. Typically, copyprogrest\n\ - \032 will just be copyprog with one extra option (e.g., -partial,\n\ - \032 for rsync). The default setting invokes rsync with appropriate\n\ - \032 options--most users should not need to change it.\n\ - \032 copyquoterem xxx\n\ - \032 When set to true, this flag causes Unison to add an extra layer\n\ - \032 of quotes to the remote path passed to the external copy\n\ - \032 program. This is needed by rsync, for example, which internally\n\ - \032 uses an ssh connection requiring an extra level of quoting for\n\ - \032 paths containing spaces. When this flag is set to default,\n\ - \032 extra quotes are added if the value of copyprog contains the\n\ - \032 string rsync.\n\ - \032 copythreshold n\n\ - \032 A number indicating above what filesize (in kilobytes) Unison\n\ - \032 should use the external copying utility specified by copyprog.\n\ - \032 Specifying 0 will cause all copies to use the external program;\n\ - \032 a negative number will prevent any files from using it. The\n\ - \032 default is -1. See the section \"Making Unison Faster on Large\n\ - \032 Files\" for more information.\n\ - \032 debug xxx\n\ - \032 This preference is used to make Unison print various sorts of\n\ - \032 information about what it is doing internally on the standard\n\ - \032 error stream. It can be used many times, each time with the\n\ - \032 name of a module for which debugging information should be\n\ - \032 printed. Possible arguments for debug can be found by looking\n\ - \032 for calls to Util.debug in the sources (using, e.g., grep).\n\ - \032 Setting -debug all causes information from all modules to be\n\ - \032 printed (this mode of usage is the first one to try, if you are\n\ - \032 trying to understand something that Unison seems to be doing\n\ - \032 wrong); -debug verbose turns on some additional debugging\n\ - \032 output from some modules (e.g., it will show exactly what bytes\n\ - \032 are being sent across the network).\n\ - \032 diff xxx\n\ - \032 This preference can be used to control the name and\n\ - \032 command-line arguments of the system utility used to generate\n\ - \032 displays of file differences. The default is `diff -u CURRENT2\n\ - \032 CURRENT1'. If the value of this preference contains the\n\ - \032 substrings CURRENT1 and CURRENT2, these will be replaced by the\n\ - \032 names of the files to be diffed. If not, the two filenames will\n\ - \032 be appended to the command. In both cases, the filenames are\n\ - \032 suitably quoted.\n\ - \032 doc xxx\n\ - \032 The command-line argument -doc secname causes unison to display\n\ - \032 section secname of the manual on the standard output and then\n\ - \032 exit. Use -doc all to display the whole manual, which includes\n\ - \032 exactly the same information as the printed and HTML manuals,\n\ - \032 modulo formatting. Use -doc topics to obtain a list of the\n\ - \032 names of the various sections that can be printed.\n\ - \032 dontchmod \n\ - \032 By default, Unison uses the 'chmod' system call to set the\n\ - \032 permission bits of files after it has copied them. But in some\n\ - \032 circumstances (and under some operating systems), the chmod\n\ - \032 call always fails. Setting this preference completely prevents\n\ - \032 Unison from ever calling chmod.\n\ - \032 dumbtty \n\ - \032 When set to true, this flag makes the text mode user interface\n\ - \032 avoid trying to change any of the terminal settings. (Normally,\n\ - \032 Unison puts the terminal in `raw mode', so that it can do\n\ - \032 things like overwriting the current line.) This is useful, for\n\ - \032 example, when Unison runs in a shell inside of Emacs.\n\ - \032 When dumbtty is set, commands to the user interface need to be\n\ - \032 followed by a carriage return before Unison will execute them.\n\ - \032 (When it is off, Unison recognizes keystrokes as soon as they\n\ - \032 are typed.)\n\ - \032 This preference has no effect on the graphical user interface.\n\ - \032 dumparchives \n\ - \032 When this preference is set, Unison will create a file\n\ - \032 unison.dump on each host, containing a text summary of the\n\ - \032 archive, immediately after loading it.\n\ - \032 fastcheck xxx\n\ - \032 When this preference is set to true, Unison will use the\n\ - \032 modification time and length of a file as a `pseudo inode\n\ - \032 number' when scanning replicas for updates, instead of reading\n\ - \032 the full contents of every file. Under Windows, this may cause\n\ - \032 Unison to miss propagating an update if the modification time\n\ - \032 and length of the file are both unchanged by the update.\n\ - \032 However, Unison will never overwrite such an update with a\n\ - \032 change from the other replica, since it always does a safe\n\ - \032 check for updates just before propagating a change. Thus, it is\n\ - \032 reasonable to use this switch under Windows most of the time\n\ - \032 and occasionally run Unison once with fastcheck set to false,\n\ - \032 if you are worried that Unison may have overlooked an update.\n\ - \032 The default value of the preference is auto, which causes\n\ - \032 Unison to use fast checking on Unix replicas (where it is safe)\n\ - \032 and slow checking on Windows replicas. For backward\n\ - \032 compatibility, yes, no, and default can be used in place of\n\ - \032 true, false, and auto. See the section \"Fast Checking\" for more\n\ - \032 information.\n\ - \032 follow xxx\n\ - \032 Including the preference -follow pathspec causes Unison to\n\ - \032 treat symbolic links matching pathspec as `invisible' and\n\ - \032 behave as if the object pointed to by the link had appeared\n\ - \032 literally at this position in the replica. See the section\n\ - \032 \"Symbolic Links\" for more details. The syntax of pathspec> is\n\ - \032 described in the section \"Path Specification\" .\n\ - \032 force xxx\n\ - \032 Including the preference -force root causes Unison to resolve\n\ - \032 all differences (even non-conflicting changes) in favor of\n\ - \032 root. This effectively changes Unison from a synchronizer into\n\ - \032 a mirroring utility.\n\ - \032 You can also specify -force newer (or -force older) to force\n\ - \032 Unison to choose the file with the later (earlier) modtime. In\n\ - \032 this case, the -times preference must also be enabled.\n\ - \032 This preference is overridden by the forcepartial preference.\n\ - \032 This preference should be used only if you are sure you know\n\ - \032 what you are doing!\n\ - \032 forcepartial xxx\n\ - \032 Including the preference forcepartial PATHSPEC -> root causes\n\ - \032 Unison to resolve all differences (even non-conflicting\n\ - \032 changes) in favor of root for the files in PATHSPEC (see the\n\ - \032 section \"Path Specification\" for more information). This\n\ - \032 effectively changes Unison from a synchronizer into a mirroring\n\ - \032 utility.\n\ - \032 You can also specify forcepartial PATHSPEC -> newer (or\n\ - \032 forcepartial PATHSPEC older) to force Unison to choose the file\n\ - \032 with the later (earlier) modtime. In this case, the -times\n\ - \032 preference must also be enabled.\n\ - \032 This preference should be used only if you are sure you know\n\ - \032 what you are doing!\n\ - \032 group \n\ - \032 When this flag is set to true, the group attributes of the\n\ - \032 files are synchronized. Whether the group names or the group\n\ - \032 identifiers are synchronizeddepends on the preference numerids.\n\ - \032 height n\n\ - \032 Used to set the height (in lines) of the main window in the\n\ - \032 graphical user interface.\n\ - \032 ignore xxx\n\ - \032 Including the preference -ignore pathspec causes Unison to\n\ - \032 completely ignore paths that match pathspec (as well as their\n\ - \032 children). This is useful for avoiding synchronizing temporary\n\ - \032 files, object files, etc. The syntax of pathspec is described\n\ - \032 in the section \"Path Specification\" , and further details on\n\ - \032 ignoring paths is found in the section \"Ignoring Paths\" .\n\ - \032 ignorecase xxx\n\ - \032 When set to true, this flag causes Unison to treat filenames as\n\ - \032 case insensitive--i.e., files in the two replicas whose names\n\ - \032 differ in (upper- and lower-case) `spelling' are treated as the\n\ - \032 same file. When the flag is set to false, Unison will treat all\n\ - \032 filenames as case sensitive. Ordinarily, when the flag is set\n\ - \032 to default, filenames are automatically taken to be\n\ - \032 case-insensitive if either host is running Windows or OSX. In\n\ - \032 rare circumstances it is useful to set the flag manually (e.g.\n\ - \032 when running Unison on a Unix system with a FAT [Windows]\n\ - \032 volume mounted).\n\ - \032 ignorelocks \n\ - \032 When this preference is set, Unison will ignore any lock files\n\ - \032 that may have been left over from a previous run of Unison that\n\ - \032 was interrupted while reading or writing archive files; by\n\ - \032 default, when Unison sees these lock files it will stop and\n\ - \032 request manualintervention. This option should be set only if\n\ - \032 you are positive that no other instance of Unison might be\n\ - \032 concurrently accessing the same archive files (e.g., because\n\ - \032 there was only one instance of unison running and it has just\n\ - \032 crashed or you have just killed it). It is probably not a good\n\ - \032 idea to set this option in a profile: it is intended for\n\ - \032 command-line use.\n\ - \032 ignorenot xxx\n\ - \032 This preference overrides the preference ignore. It gives a\n\ - \032 list of patterns (in the same format as ignore) for paths that\n\ - \032 should definitely not be ignored, whether or not they happen to\n\ - \032 match one of the ignore patterns.\n\ - \032 Note that the semantics of ignore and ignorenot is a little\n\ - \032 counter-intuitive. When detecting updates, Unison examines\n\ - \032 paths in depth-first order, starting from the roots of the\n\ - \032 replicas and working downwards. Before examining each path, it\n\ - \032 checks whether it matches ignore and does not match ignorenot;\n\ - \032 in this case it skips this path and all its descendants. This\n\ - \032 means that, if some parent of a given path matches an ignore\n\ - \032 pattern, then it will be skipped even if the path itself\n\ - \032 matches an ignorenot pattern. In particular, putting ignore =\n\ - \032 Path * in your profile and then using t ignorenot to select\n\ - \032 particular paths to be synchronized will not work. Instead, you\n\ - \032 should use the path preference to choose particular paths to\n\ - \032 synchronize.\n\ - \032 immutable xxx\n\ - \032 This preference specifies paths for directories whose immediate\n\ - \032 children are all immutable files -- i.e., once a file has been\n\ - \032 created, its contents never changes. When scanning for updates,\n\ - \032 Unison does not check whether these files have been modified;\n\ - \032 this can speed update detection significantly (in particular,\n\ - \032 for mail directories).\n\ - \032 immutablenot xxx\n\ - \032 This preference overrides immutable.\n\ - \032 key xxx\n\ - \032 Used in a profile to define a numeric key (0-9) that can be\n\ - \032 used in the graphical user interface to switch immediately to\n\ - \032 this profile.\n\ - \032 killserver \n\ - \032 When set to true, this flag causes Unison to kill the remote\n\ - \032 server process when the synchronization is finished. This\n\ - \032 behavior is the default for ssh connections, so this preference\n\ - \032 is not normally needed when running over ssh; it is provided so\n\ - \032 that socket-mode servers can be killed off after a single run\n\ - \032 of Unison, rather than waiting to accept future connections.\n\ - \032 (Some users prefer to start a remote socket server for each run\n\ - \032 of Unison, rather than leaving one running all the time.)\n\ - \032 label xxx\n\ - \032 Used in a profile to provide a descriptive string documenting\n\ - \032 its settings. (This is useful for users that switch between\n\ - \032 several profiles, especially using the `fast switch' feature of\n\ - \032 the graphical user interface.)\n\ - \032 log \n\ - \032 When this flag is set, Unison will log all changes to the\n\ - \032 filesystems on a file.\n\ - \032 logfile xxx\n\ - \032 By default, logging messages will be appended to the file\n\ - \032 unison.log in your HOME directory. Set this preference if you\n\ - \032 prefer another file.\n\ - \032 maxbackups n\n\ - \032 This preference specifies the number of backup versions that\n\ - \032 will be kept by unison, for each path that matches the\n\ - \032 predicate backup. The default is 2.\n\ - \032 maxthreads n\n\ - \032 This preference controls how much concurrency is allowed during\n\ - \032 the transport phase. Normally, it should be set reasonably high\n\ - \032 (default is 20) to maximize performance, but when Unison is\n\ - \032 used over a low-bandwidth link it may be helpful to set it\n\ - \032 lower (e.g. to 1) so that Unison doesn't soak up all the\n\ - \032 available bandwidth.\n\ - \032 merge xxx\n\ - \032 This preference can be used to run a merge program which will\n\ - \032 create a new version for each of the files and the backup, with\n\ - \032 the last backup and the both replicas. Setting the merge\n\ - \032 preference for a path will also cause this path to be backed\n\ - \032 up, just like t backup. The syntax of pathspec>cmd is described\n\ - \032 in the section \"Path Specification\" , and further details on\n\ - \032 Merging functions are present in the section \"Merging files\" .\n\ - \032 mountpoint xxx\n\ - \032 Including the preference -mountpoint PATH causes Unison to\n\ - \032 double-check, at the end of update detection, that PATH exists\n\ - \032 and abort if it does not. This is useful when Unison is used to\n\ - \032 synchronize removable media. This preference can be given more\n\ - \032 than once. See the section \"Mount Points\" .\n\ - \032 numericids \n\ - \032 When this flag is set to true, groups and users are\n\ - \032 synchronized numerically, rather than by name.\n\ - \032 The special uid 0 and the special group 0 are never mapped via\n\ - \032 user/group names even if this preference is not set.\n\ - \032 owner \n\ - \032 When this flag is set to true, the owner attributes of the\n\ - \032 files are synchronized. Whether the owner names or the owner\n\ - \032 identifiers are synchronizeddepends on the preference\n\ - \032 extttnumerids.\n\ - \032 path xxx\n\ - \032 When no path preference is given, Unison will simply\n\ - \032 synchronize the two entire replicas, beginning from the given\n\ - \032 pair of roots. If one or more path preferences are given, then\n\ - \032 Unison will synchronize only these paths and their children.\n\ - \032 (This is useful for doing a fast sync of just one directory,\n\ - \032 for example.) Note that path preferences are intepreted\n\ - \032 literally--they are not regular expressions.\n\ - \032 perms n\n\ - \032 The integer value of this preference is a mask indicating which\n\ - \032 permission bits should be synchronized. It is set by default to\n\ - \032 0o1777: all bits but the set-uid and set-gid bits are\n\ - \032 synchronised (synchronizing theses latter bits can be a\n\ - \032 security hazard). If you want to synchronize all bits, you can\n\ - \032 set the value of this preference to -1.\n\ - \032 prefer xxx\n\ - \032 Including the preference -prefer root causes Unison always to\n\ - \032 resolve conflicts in favor of root, rather than asking for\n\ - \032 guidance from the user. (The syntax of root is the same as for\n\ - \032 the root preference, plus the special values newer and older.)\n\ - \032 This preference is overridden by the preferpartial preference.\n\ - \032 This preference should be used only if you are sure you know\n\ - \032 what you are doing!\n\ - \032 preferpartial xxx\n\ - \032 Including the preference preferpartial PATHSPEC -> root causes\n\ - \032 Unison always to resolve conflicts in favor of root, rather\n\ - \032 than asking for guidance from the user, for the files in\n\ - \032 PATHSPEC (see the section \"Path Specification\" for more\n\ - \032 information). (The syntax of root is the same as for the root\n\ - \032 preference, plus the special values newer and older.)\n\ - \032 This preference should be used only if you are sure you know\n\ - \032 what you are doing!\n\ - \032 pretendwin \n\ - \032 When set to true, this preference makes Unison use\n\ - \032 Windows-style fast update detection (using file creation times\n\ - \032 as \"pseudo-inode-numbers\"), even when running on a Unix system.\n\ - \032 This switch should be used with care, as it is less safe than\n\ - \032 the standard update detection method, but it can be useful for\n\ - \032 synchronizing VFAT filesystems (which do not support inode\n\ - \032 numbers) mounted on Unix systems. The fastcheck option should\n\ - \032 also be set to true.\n\ - \032 repeat xxx\n\ - \032 Setting this preference causes the text-mode interface to\n\ - \032 synchronize repeatedly, rather than doing it just once and\n\ - \032 stopping. If the argument is a number, Unison will pause for\n\ - \032 that many seconds before beginning again.\n\ - \032 retry n\n\ - \032 Setting this preference causes the text-mode interface to try\n\ - \032 again to synchronize updated paths where synchronization fails.\n\ - \032 Each such path will be tried N times.\n\ - \032 root xxx\n\ - \032 Each use of this preference names the root of one of the\n\ - \032 replicas for Unison to synchronize. Exactly two roots are\n\ - \032 needed, so normal modes of usage are either to give two values\n\ - \032 for root in the profile, or to give no values in the profile\n\ - \032 and provide two on the command line. Details of the syntax of\n\ - \032 roots can be found in the section \"Roots\" .\n\ - \032 The two roots can be given in either order; Unison will sort\n\ - \032 them into a canonical order before doing anything else. It also\n\ - \032 tries to `canonize' the machine names and paths that appear in\n\ - \032 the roots, so that, if Unison is invoked later with a slightly\n\ - \032 different name for the same root, it will be able to locate the\n\ - \032 correct archives.\n\ - \032 rootalias xxx\n\ - \032 When calculating the name of the archive files for a given pair\n\ - \032 of roots, Unison replaces any roots matching the left-hand side\n\ - \032 of any rootalias rule by the corresponding right-hand side.\n\ - \032 rshargs xxx\n\ - \032 The string value of this preference will be passed as\n\ - \032 additional arguments (besides the host name and the name of the\n\ - \032 Unison executable on the remote system) to the rsh command used\n\ - \032 to invoke the remote server.\n\ - \032 rshcmd xxx\n\ - \032 This preference can be used to explicitly set the name of the\n\ - \032 rsh executable (e.g., giving a full path name), if necessary.\n\ - \032 rsrc xxx\n\ - \032 When set to true, this flag causes Unison to synchronize\n\ - \032 resource forks and HFS meta-data. On filesystems that do not\n\ - \032 natively support resource forks, this data is stored in\n\ - \032 Carbon-compatible ._ AppleDouble files. When the flag is set to\n\ - \032 false, Unison will not synchronize these data. Ordinarily, the\n\ - \032 flag is set to default, and these data are automatically\n\ - \032 synchronized if either host is running OSX. In rare\n\ - \032 circumstances it is useful to set the flag manually.\n\ - \032 rsync \n\ - \032 Unison uses the 'rsync algorithm' for 'diffs-only' transfer of\n\ - \032 updates to large files. Setting this flag to false makes Unison\n\ - \032 use whole-file transfers instead. Under normal circumstances,\n\ - \032 there is no reason to do this, but if you are having trouble\n\ - \032 with repeated 'rsync failure' errors, setting it to false\n\ - \032 should permit you to synchronize the offending files.\n\ - \032 selftest \n\ - \032 Run internal tests and exit. This option is mostly for\n\ - \032 developers and must be used carefully: in particular, it will\n\ - \032 delete the contents of both roots, so that it can install its\n\ - \032 own files for testing. This flag only makes sense on the\n\ - \032 command line. When it is provided, no preference file is read:\n\ - \032 all preferences must be specified on thecommand line. Also,\n\ - \032 since the self-test procedure involves overwriting the roots\n\ - \032 and backup directory, the names of the roots and of the\n\ - \032 backupdir preference must include the string \"test\" or else the\n\ - \032 tests will be aborted. (If these are not given on the command\n\ - \032 line, dummy subdirectories in the current directory will be\n\ - \032 created automatically.)\n\ - \032 servercmd xxx\n\ - \032 This preference can be used to explicitly set the name of the\n\ - \032 Unison executable on the remote server (e.g., giving a full\n\ - \032 path name), if necessary.\n\ - \032 showarchive \n\ - \032 When this preference is set, Unison will print out the 'true\n\ - \032 names'of the roots, in the same form as is expected by the\n\ - \032 rootaliaspreference.\n\ - \032 silent \n\ - \032 When this preference is set to true, the textual user interface\n\ - \032 will print nothing at all, except in the case of errors.\n\ - \032 Setting silent to true automatically sets the batch preference\n\ - \032 to true.\n\ - \032 sortbysize \n\ - \032 When this flag is set, the user interface will list changed\n\ - \032 files by size (smallest first) rather than by name. This is\n\ - \032 useful, for example, for synchronizing over slow links, since\n\ - \032 it puts very large files at the end of the list where they will\n\ - \032 not prevent smaller files from being transferred quickly.\n\ - \032 This preference (as well as the other sorting flags, but not\n\ - \032 the sorting preferences that require patterns as arguments) can\n\ - \032 be set interactively and temporarily using the 'Sort' menu in\n\ - \032 the graphical user interface.\n\ - \032 sortfirst xxx\n\ - \032 Each argument to sortfirst is a pattern pathspec, which\n\ - \032 describes a set of paths. Files matching any of these patterns\n\ - \032 will be listed first in the user interface. The syntax of\n\ - \032 pathspec is described in the section \"Path Specification\" .\n\ - \032 sortlast xxx\n\ - \032 Similar to sortfirst, except that files matching one of these\n\ - \032 patterns will be listed at the very end.\n\ - \032 sortnewfirst \n\ - \032 When this flag is set, the user interface will list newly\n\ - \032 created files before all others. This is useful, for example,\n\ - \032 for checking that newly created files are not `junk', i.e.,\n\ - \032 ones that should be ignored or deleted rather than\n\ - \032 synchronized.\n\ - \032 sshargs xxx\n\ - \032 The string value of this preference will be passed as\n\ - \032 additional arguments (besides the host name and the name of the\n\ - \032 Unison executable on the remote system) to the ssh command used\n\ - \032 to invoke the remote server.\n\ - \032 sshcmd xxx\n\ - \032 This preference can be used to explicitly set the name of the\n\ - \032 ssh executable (e.g., giving a full path name), if necessary.\n\ - \032 sshversion xxx\n\ - \032 This preference can be used to control which version of ssh\n\ - \032 should be used to connect to the server. Legal values are 1 and\n\ - \032 2, which will cause unison to try to use ssh1 orssh2 instead of\n\ - \032 just ssh to invoke ssh. The default value is empty, which will\n\ - \032 make unison use whatever version of ssh is installed as the\n\ - \032 default `ssh' command.\n\ - \032 terse \n\ - \032 When this preference is set to true, the user interface will\n\ - \032 not print status messages.\n\ - \032 testserver \n\ - \032 Setting this flag on the command line causes Unison to attempt\n\ - \032 to connect to the remote server and, if successful, print a\n\ - \032 message and immediately exit. Useful for debugging installation\n\ - \032 problems. Should not be set in preference files.\n\ - \032 times \n\ - \032 When this flag is set to true, file modification times (but not\n\ - \032 directory modtimes) are propagated.\n\ - \032 ui xxx\n\ - \032 This preference selects either the graphical or the textual\n\ - \032 user interface. Legal values are graphic or text.\n\ - \032 Because this option is processed specially during Unison's\n\ - \032 start-up sequence, it can only be used on the command line. In\n\ - \032 preference files it has no effect.\n\ - \032 If the Unison executable was compiled with only a textual\n\ - \032 interface, this option has no effect. (The pre-compiled\n\ - \032 binaries are all compiled with both interfaces available.)\n\ - \032 version \n\ - \032 Print the current version number and exit. (This option only\n\ - \032 makes sense on the command line.)\n\ - \032 xferbycopying \n\ - \032 When this preference is set, Unison will try to avoid\n\ - \032 transferring file contents across the network by recognizing\n\ - \032 when a file with the required contents already exists in the\n\ - \032 target replica. This usually allows file moves to be propagated\n\ - \032 very quickly. The default value istrue.\n\ - \n\ - Profiles\n\ - \n\ - \032 A profile is a text file that specifies permanent settings for roots,\n\ - \032 paths, ignore patterns, and other preferences, so that they do not\n\ - \032 need to be typed at the command line every time Unison is run.\n\ - \032 Profiles should reside in the .unison directory on the client machine.\n\ - \032 If Unison is started with just one argument name on the command line,\n\ - \032 it looks for a profile called name.prf in the .unison directory. If it\n\ - \032 is started with no arguments, it scans the .unison directory for files\n\ - \032 whose names end in .prf and offers a menu (provided that the Unison\n\ - \032 executable is compiled with the graphical user interface). If a file\n\ - \032 named default.prf is found, its settings will be offered as the\n\ - \032 default choices.\n\ - \n\ - \032 To set the value of a preference p permanently, add to the appropriate\n\ - \032 profile a line of the form\n\ - \032 p = true\n\ - \n\ - \032 for a boolean flag or\n\ - \032 p = \n\ - \n\ - \032 for a preference of any other type.\n\ - \n\ - \032 Whitespaces around p and xxx are ignored. A profile may also include\n\ - \032 blank lines and lines beginning with #; both are ignored.\n\ - \n\ - \032 When Unison starts, it first reads the profile and then the command\n\ - \032 line, so command-line options will override settings from the profile.\n\ - \n\ - \032 Profiles may also include lines of the form include name, which will\n\ - \032 cause the file name (or name.prf, if name does not exist in the\n\ - \032 .unison directory) to be read at the point, and included as if its\n\ - \032 contents, instead of the include line, was part of the profile.\n\ - \032 Include lines allows settings common to several profiles to be stored\n\ - \032 in one place.\n\ - \n\ - \032 A profile may include a preference `label = desc' to provide a\n\ - \032 description of the options selected in this profile. The string desc\n\ - \032 is listed along with the profile name in the profile selection dialog,\n\ - \032 and displayed in the top-right corner of the main Unison window in the\n\ - \032 graphical user interface.\n\ - \n\ - \032 The graphical user-interface also supports one-key shortcuts for\n\ - \032 commonly used profiles. If a profile contains a preference of the form\n\ - \032 `key = n', where n is a single digit, then pressing this digit key\n\ - \032 will cause Unison to immediately switch to this profile and begin\n\ - \032 synchronization again from scratch. In this case, all actions that\n\ - \032 have been selected for a set of changes currently being displayed will\n\ - \032 be discarded.\n\ - \n\ - Sample Profiles\n\ - \n\ - A Minimal Profile\n\ - \n\ - \032 Here is a very minimal profile file, such as might be found in\n\ - \032 .unison/default.prf:\n\ - \032 # Roots of the synchronization\n\ - \032 root = /home/bcpierce\n\ - \032 root = ssh://saul//home/bcpierce\n\ - \n\ - \032 # Paths to synchronize\n\ - \032 path = current\n\ - \032 path = common\n\ - \032 path = .netscape/bookmarks.html\n\ - \n\ - A Basic Profile\n\ - \n\ - \032 Here is a more sophisticated profile, illustrating some other useful\n\ - \032 features.\n\ - \032 # Roots of the synchronization\n\ - \032 root = /home/bcpierce\n\ - \032 root = ssh://saul//home/bcpierce\n\ - \n\ - \032 # Paths to synchronize\n\ - \032 path = current\n\ - \032 path = common\n\ - \032 path = .netscape/bookmarks.html\n\ - \n\ - \032 # Some regexps specifying names and paths to ignore\n\ - \032 ignore = Name temp.*\n\ - \032 ignore = Name *~\n\ - \032 ignore = Name .*~\n\ - \032 ignore = Path */pilot/backup/Archive_*\n\ - \032 ignore = Name *.o\n\ - \032 ignore = Name *.tmp\n\ - \n\ - \032 # Window height\n\ - \032 height = 37\n\ - \n\ - \032 # Keep a backup copy of every file in a central location\n\ - \032 backuplocation = central\n\ - \032 backupdir = /home/bcpierce/backups\n\ - \032 backup = Name *\n\ - \032 backupprefix = $VERSION.\n\ - \032 backupsuffix =\n\ - \n\ - \032 # Use this command for displaying diffs\n\ - \032 diff = diff -y -W 79 --suppress-common-lines\n\ - \n\ - \032 # Log actions to the terminal\n\ - \032 log = true\n\ - \n\ - A Power-User Profile\n\ - \n\ - \032 When Unison is used with large replicas, it is often convenient to be\n\ - \032 able to synchronize just a part of the replicas on a given run (this\n\ - \032 saves the time of detecting updates in the other parts). This can be\n\ - \032 accomplished by splitting up the profile into several parts -- a\n\ - \032 common part containing most of the preference settings, plus one\n\ - \032 \"top-level\" file for each set of paths that need to be synchronized.\n\ - \032 (The include mechanism can also be used to allow the same set of\n\ - \032 preference settings to be used with different roots.)\n\ - \n\ - \032 The collection of profiles implementing this scheme might look as\n\ - \032 follows. The file default.prf is empty except for an include\n\ - \032 directive:\n\ - \032 # Include the contents of the file common\n\ - \032 include common\n\ - \n\ - \032 Note that the name of the common file is common, not common.prf; this\n\ - \032 prevents Unison from offering common as one of the list of profiles in\n\ - \032 the opening dialog (in the graphical UI).\n\ - \n\ - \032 The file common contains the real preferences:\n\ - \032 # Roots of the synchronization\n\ - \032 root = /home/bcpierce\n\ - \032 root = ssh://saul//home/bcpierce\n\ - \n\ - \032 # (... other preferences ...)\n\ - \n\ - \032 # If any new preferences are added by Unison (e.g. 'ignore'\n\ - \032 # preferences added via the graphical UI), then store them in the\n\ - \032 # file 'common' rathen than in the top-level preference file\n\ - \032 addprefsto = common\n\ - \n\ - \032 # Names and paths to ignore:\n\ - \032 ignore = Name temp.*\n\ - \032 ignore = Name *~\n\ - \032 ignore = Name .*~\n\ - \032 ignore = Path */pilot/backup/Archive_*\n\ - \032 ignore = Name *.o\n\ - \032 ignore = Name *.tmp\n\ - \n\ - \032 Note that there are no path preferences in common. This means that,\n\ - \032 when we invoke Unison with the default profile (e.g., by typing\n\ - \032 'unison default' or just 'unison' on the command line), the whole\n\ - \032 replicas will be synchronized. (If we never want to synchronize the\n\ - \032 whole replicas, then default.prf would instead include settings for\n\ - \032 all the paths that are usually synchronized.)\n\ - \n\ - \032 To synchronize just part of the replicas, Unison is invoked with an\n\ - \032 alternate preference file--e.g., doing 'unison workingset', where the\n\ - \032 preference file workingset.prf contains\n\ - \032 path = current/papers\n\ - \032 path = Mail/inbox\n\ - \032 path = Mail/drafts\n\ - \032 include common\n\ - \n\ - \032 causes Unison to synchronize just the listed subdirectories.\n\ - \n\ - \032 The key preference can be used in combination with the graphical UI to\n\ - \032 quickly switch between different sets of paths. For example, if the\n\ - \032 file mail.prf contains\n\ - \032 path = Mail\n\ - \032 batch = true\n\ - \032 key = 2\n\ - \032 include common\n\ - \n\ - \032 then pressing 2 will cause Unison to look for updates in the Mail\n\ - \032 subdirectory and (because the batch flag is set) immediately propagate\n\ - \032 any that it finds.\n\ - \n\ - Keeping Backups\n\ - \n\ - \032 When Unison overwrites a file or directory by propagating a new\n\ - \032 version from the other replica, it can keep the old version around as\n\ - \032 a backup. There are several preferences that control precisely where\n\ - \032 these backups are stored and how they are named.\n\ - \n\ - \032 To enable backups, you must give one or more backup preferences. Each\n\ - \032 of these has the form\n\ - \032 backup = \n\ - \n\ - \032 where has the same form as for the ignore preference. For\n\ - \032 example,\n\ - \032 backup = Name *\n\ - \n\ - \032 causes Unison to keep backups of all files and directories. The\n\ - \032 backupnot preference can be used to give a few exceptions: it\n\ - \032 specifies which files and directories should not be backed up, even if\n\ - \032 they match the backup pathspec.\n\ - \n\ - \032 It is important to note that the pathspec is matched against the path\n\ - \032 that is being updated by Unison, not its descendants. For example, if\n\ - \032 you set backup = Name *.txt and then delete a whole directory named\n\ - \032 foo containing some text files, these files will not be backed up\n\ - \032 because Unison will just check that foo does not match *.txt.\n\ - \032 Similarly, if the directory itself happened to be called foo.txt, then\n\ - \032 the whole directory and all the files in it will be backed up,\n\ - \032 regardless of their names.\n\ - \n\ - \032 Backup files can be stored either centrally or locally. This behavior\n\ - \032 is controlled by the preference backuplocation, whose value must be\n\ - \032 either central or local. (The default is central.)\n\ - \n\ - \032 When backups are stored locally, they are kept in the same directory\n\ - \032 as the original.\n\ - \n\ - \032 When backups are stored centrally, the directory used to hold them is\n\ - \032 controlled by the preference backupdir and the environment variable\n\ - \032 UNISONBACKUPDIR. (The environment variable is checked first.) If\n\ - \032 neither of these are set, then the directory .unison/backup in the\n\ - \032 user's home directory is used.\n\ - \n\ - \032 The preference maxbackups controls how many previous versions of each\n\ - \032 file are kept (including the current version).\n\ - \n\ - \032 By default, backup files are named .bak.VERSION.FILENAME, where\n\ - \032 FILENAME is the original filename and VERSION is the backup number (1\n\ - \032 for the most recent, 2 for the next most recent, etc.). This can be\n\ - \032 changed by setting the preferences backupprefix and/or backupsuffix.\n\ - \032 If desired, backupprefix may include a directory prefix; this can be\n\ - \032 used with backuplocation = local to put all backup files for each\n\ - \032 directory into a single subdirectory. For example, setting\n\ - \032 backuplocation = local\n\ - \032 backupprefix = .unison/$VERSION.\n\ - \032 backupsuffix =\n\ - \n\ - \032 will put all backups in a local subdirectory named .unison. Also, note\n\ - \032 that the string $VERSION in either backupprefix or backupsuffix (it\n\ - \032 must appear in one or the other) is replaced by the version number.\n\ - \032 This can be used, for example, to ensure that backup files retain the\n\ - \032 same extension as the originals.\n\ - \n\ - \032 For backward compatibility, the backups preference is also supported.\n\ - \032 It simply means backup = Name * and backuplocation = local.\n\ - \n\ - Merging Conflicting Versions\n\ - \n\ - \032 Unison can invoke external programs to merge conflicting versions of a\n\ - \032 file. The preference merge controls this process.\n\ - \n\ - \032 The merge preference may be given once or several times in a\n\ - \032 preference file (it can also be given on the command line, of course,\n\ - \032 but this tends to be awkward because of the spaces and special\n\ - \032 characters involved). Each instance of the preference looks like this:\n\ - \032 merge = -> \n\ - \n\ - \032 The here has exactly the same format as for the ignore\n\ - \032 preference (see the section \"Path specification\" ). For example, using\n\ - \032 \"Name *.txt\" as the tells Unison that this command should\n\ - \032 be used whenever a file with extension .txt needs to be merged.\n\ - \n\ - \032 Many external merging programs require as inputs not just the two\n\ - \032 files that need to be merged, but also a file containing the last\n\ - \032 synchronized version. You can ask Unison to keep a copy of the last\n\ - \032 synchronized version for some files using the backupcurrent\n\ - \032 preference. This preference is used in exactly the same way as backup\n\ - \032 and its meaning is similar, except that it causes backups to be kept\n\ - \032 of the current contents of each file after it has been synchronized by\n\ - \032 Unison, rather than the previous contents that Unison overwrote. These\n\ - \032 backups are kept on both replicas in the same place as ordinary backup\n\ - \032 files--i.e. according to the backuplocation and backupdir preferences.\n\ - \032 They are named like the original files if backupslocation is set to\n\ - \032 'central' and otherwise, Unison uses the backupprefix and backupsuffix\n\ - \032 preferences and assumes a version number 000 for these backups.\n\ - \n\ - \032 The part of the preference specifies what external command\n\ - \032 should be invoked to merge files at paths matching the .\n\ - \032 Within this string, several special substrings are recognized; these\n\ - \032 will be substituted with appropriate values before invoking a\n\ - \032 sub-shell to execute the command.\n\ - \032 * CURRENT1 is replaced by the name of (a temporary copy of) the\n\ - \032 local variant of the file.\n\ - \032 * CURRENT2 is replaced by the name of a temporary file, into which\n\ - \032 the contents of the remote variant of the file have been\n\ - \032 transferred by Unison prior to performing the merge.\n\ - \032 * CURRENTARCH is replaced by the name of the backed up copy of the\n\ - \032 original version of the file (i.e., the file saved by Unison if\n\ - \032 the current filename matches the path specifications for the\n\ - \032 backupcurrent preference, as explained above), if one exists. If\n\ - \032 no archive exists and CURRENTARCH appears in the merge command,\n\ - \032 then an error is signalled.\n\ - \032 * CURRENTARCHOPT is replaced by the name of the backed up copy of\n\ - \032 the original version of the file (i.e., its state at the end of\n\ - \032 the last successful run of Unison), if one exists, or the empty\n\ - \032 string if no archive exists.\n\ - \032 * NEW is replaced by the name of a temporary file that Unison\n\ - \032 expects to be written by the merge program when it finishes,\n\ - \032 giving the desired new contents of the file.\n\ - \032 * PATH is replaced by the path (relative to the roots of the\n\ - \032 replicas) of the file being merged.\n\ - \032 * NEW1 and NEW2 are replaced by the names of temporary files that\n\ - \032 Unison expects to be written by the merge program when it is only\n\ - \032 able to partially merge the originals; in this case, NEW1 will be\n\ - \032 written back to the local replica and NEW2 to the remote replica;\n\ - \032 NEWARCH, if present, will be used as the \"last common state\" of\n\ - \032 the replicas. (These three options are provided for later\n\ - \032 compatibility with the Harmony data synchronizer.)\n\ - \n\ - \032 To accomodate the wide variety of programs that users might want to\n\ - \032 use for merging, Unison checks for several possible situations when\n\ - \032 the merge program exits:\n\ - \032 * If the merge program exits with a non-zero status, then merge is\n\ - \032 considered to have failed and the replicas are not changed.\n\ - \032 * If the file NEW has been created, it is written back to both\n\ - \032 replicas (and stored in the backup directory). Similarly, if just\n\ - \032 the file NEW1 has been created, it is written back to both\n\ - \032 replicas.\n\ - \032 * If neither NEW nor NEW1 have been created, then Unison examines\n\ - \032 the temporary files CURRENT1 and CURRENT2 that were given as\n\ - \032 inputs to the merge program. If either has been changed (or both\n\ - \032 have been changed in identical ways), then its new contents are\n\ - \032 written back to both replicas. If either CURRENT1 or CURRENT2 has\n\ - \032 been deleted, then the contents of the other are written back to\n\ - \032 both replicas.\n\ - \032 * If the files NEW1, NEW2, and NEWARCH have all been created, they\n\ - \032 are written back to the local replica, remote replica, and backup\n\ - \032 directory, respectively. If the files NEW1, NEW2 have been\n\ - \032 created, but NEWARCH has not, then these files are written back to\n\ - \032 the local replica and remote replica, respectively. Also, if NEW1\n\ - \032 and NEW2 have identical contents, then the same contents are\n\ - \032 stored as a backup (if the backupcurrent preference is set for\n\ - \032 this path) to reflect the fact that the path is currently in sync.\n\ - \032 * If NEW1 and NEW2 (resp. CURRENT1 and CURRENT2) are created (resp.\n\ - \032 overwritten) with different contents but the merge command did not\n\ - \032 fail (i.e., it exited with status code 0), then we copy NEW1\n\ - \032 (resp. CURRENT1) to the other replica and to the archive.\n\ - \032 This behavior is a design choice made to handle the case where a\n\ - \032 merge command only synchronizes some specific contents between two\n\ - \032 files, skipping some irrelevant information (order between\n\ - \032 entries, for instance). We assume that, if the merge command exits\n\ - \032 normally, then the two resulting files are \"as good as equal.\"\n\ - \032 (The reason we copy one on top of the other is to avoid Unison\n\ - \032 detecting that the files are unequal the next time it is run and\n\ - \032 trying again to merge them when, in fact, the merge program has\n\ - \032 already made them as similar as it is able to.)\n\ - \n\ - \032 If the confirmmerge preference is set and Unison is not run in batch\n\ - \032 mode, then Unison will always ask for confirmation before actually\n\ - \032 committing the results of the merge to the replicas.\n\ - \n\ - \032 A large number of external merging programs are available. For\n\ - \032 example, on Unix systems setting the merge preference to\n\ - \032 merge = Name *.txt -> diff3 -m CURRENT1 CURRENTARCH CURRENT2\n\ - \032 > NEW || echo \"differences detected\"\n\ - \n\ - \032 will tell Unison to use the external diff3 program for merging.\n\ - \032 Alternatively, users of emacs may find the following settings\n\ - \032 convenient:\n\ - \032 merge = Name *.txt -> emacs -q --eval '(ediff-merge-files-with-ancestor\n\ - \032 \"CURRENT1\" \"CURRENT2\" \"CURRENTARCH\" nil \"NEW\")'\n\ - \n\ - \032 (These commands are displayed here on two lines to avoid running off\n\ - \032 the edge of the page. In your preference file, each command should be\n\ - \032 written on a single line.)\n\ - \n\ - \032 Users running emacs under windows may find something like this useful:\n\ - \032 merge = Name * -> C:\\Progra~1\\Emacs\\emacs\\bin\\emacs.exe -q --eval\n\ - \032 \"(ediff-files \"\"\"CURRENT1\"\"\" \"\"\"CURRENT2\"\"\")\"\n\ - \n\ - \032 Users running Mac OS X (you may need the Developer Tools installed to\n\ - \032 get the opendiff utility) may prefer\n\ - \032 merge = Name *.txt -> opendiff CURRENT1 CURRENT2 -ancestor CURRENTARCH -mer\n\ - ge NEW\n\ - \n\ - \032 Here is a slightly more involved hack. The opendiff program can\n\ - \032 operate either with or without an archive file. A merge command of\n\ - \032 this form\n\ - \032 merge = Name *.txt ->\n\ - \032 if [ CURRENTARCHOPTx = x ];\n\ - \032 then opendiff CURRENT1 CURRENT2 -merge NEW;\n\ - \032 else opendiff CURRENT1 CURRENT2 -ancestor CURRENTARCHOPT -merge N\n\ - EW;\n\ - \032 fi\n\ - \n\ - \032 (still all on one line in the preference file!) will test whether an\n\ - \032 archive file exists and use the appropriate variant of the arguments\n\ - \032 to opendiff.\n\ - \n\ - \032 Ordinarily, external merge programs are only invoked when Unison is\n\ - \032 not running in batch mode. To specify an external merge program that\n\ - \032 should be used no matter the setting of the batch flag, use the\n\ - \032 mergebatch preference instead of merge.\n\ - \n\ - \032 Please post suggestions for other useful values of the merge\n\ - \032 preference to the unison-users mailing list--we'd like to give\n\ - \032 several examples here. \n\ - \n\ - The User Interface\n\ - \n\ - \032 Both the textual and the graphical user interfaces are intended to be\n\ - \032 mostly self-explanatory. Here are just a few tricks:\n\ - \032 * By default, when running on Unix the textual user interface will\n\ - \032 try to put the terminal into the \"raw mode\" so that it reads the\n\ - \032 input a character at a time rather than a line at a time. (This\n\ - \032 means you can type just the single keystroke \">\" to tell Unison to\n\ - \032 propagate a file from left to right, rather than \"> Enter.\")\n\ - \032 There are some situations, though, where this will not work -- for\n\ - \032 example, when Unison is running in a shell window inside Emacs.\n\ - \032 Setting the dumbtty preference will force Unison to leave the\n\ - \032 terminal alone and process input a line at a time.\n\ - \n\ - Exit code\n\ - \n\ - \032 When running in the textual mode, Unison returns an exit status, which\n\ - \032 describes whether, and at which level, the synchronization was\n\ - \032 successful. The exit status could be useful when Unison is invoked\n\ - \032 from a script. Currently, there are four possible values for the exit\n\ - \032 status:\n\ - \032 * 0: successful synchronization; everything is up-to-date now.\n\ - \032 * 1: some files were skipped, but all file transfers were\n\ - \032 successful.\n\ - \032 * 2: non-fatal failures occurred during file transfer.\n\ - \032 * 3: a fatal error occurred, or the execution was interrupted.\n\ - \n\ - \032 The graphical interface does not return any useful information through\n\ - \032 the exit status.\n\ - \n\ - Path specification\n\ - \n\ - \032 Several Unison preferences (e.g., ignore/ignorenot, follow,\n\ - \032 sortfirst/sortlast, backup, merge, etc.) specify individual paths or\n\ - \032 sets of paths. These preferences share a common syntax based on\n\ - \032 regular-expressions. Each preference is associated with a list of path\n\ - \032 patterns; the paths specified are those that match any one of the path\n\ - \032 pattern.\n\ - \032 * Pattern preferences can be given on the command line, or, more\n\ - \032 often, stored in profiles, using the same syntax as other\n\ - \032 preferences. For example, a profile line of the form\n\ - \032 ignore = pattern\n\ - \032 adds pattern to the list of patterns to be ignored.\n\ - \032 * Each pattern can have one of three forms. The most general form is\n\ - \032 a Posix extended regular expression introduced by the keyword\n\ - \032 Regex. (The collating sequences and character classes of full\n\ - \032 Posix regexps are not currently supported).\n\ - \032 Regex regexp\n\ - \032 For convenience, two other styles of pattern are also recognized:\n\ - \032 Name name\n\ - \032 matches any path in which the last component matches name, while\n\ - \032 Path path\n\ - \032 matches exactly the path path. The name and path arguments of the\n\ - \032 latter forms of patterns are not regular expressions. Instead,\n\ - \032 standard \"globbing\" conventions can be used in name and path:\n\ - \032 + a * matches any sequence of characters not including / (and\n\ - \032 not beginning with ., when used at the beginning of a name)\n\ - \032 + a ? matches any single character except / (and leading .)\n\ - \032 + [xyz] matches any character from the set {x, y, z }\n\ - \032 + {a,bb,ccc} matches any one of a, bb, or ccc.\n\ - \032 * The path separator in path patterns is always the forward-slash\n\ - \032 character \"/\" -- even when the client or server is running under\n\ - \032 Windows, where the normal separator character is a backslash. This\n\ - \032 makes it possible to use the same set of path patterns for both\n\ - \032 Unix and Windows file systems.\n\ - \n\ - \032 Some examples of path patterns appear in the section \"Ignoring Paths\"\n\ - \032 .\n\ - \n\ - Ignoring Paths\n\ - \n\ - \032 Most users of Unison will find that their replicas contain lots of\n\ - \032 files that they don't ever want to synchronize -- temporary files,\n\ - \032 very large files, old stuff, architecture-specific binaries, etc. They\n\ - \032 can instruct Unison to ignore these paths using patterns introduced in\n\ - \032 the section \"Path Patterns\" .\n\ - \n\ - \032 For example, the following pattern will make Unison ignore any path\n\ - \032 containing the name CVS or a name ending in .cmo:\n\ - \032 ignore = Name {CVS,*.cmo}\n\ - \n\ - \032 The next pattern makes Unison ignore the path a/b:\n\ - \032 ignore = Path a/b\n\ - \n\ - \032 Path patterns do not skip filesnames beginning with . (as Name\n\ - \032 patterns do). For example,\n\ - \032 ignore = Path */tmp\n\ - \n\ - \032 will include .foo/tmp in the set of ignore directories, as it is a\n\ - \032 path, not a name, that is ignored.\n\ - \n\ - \032 The following pattern makes Unison ignore any path beginning with a/b\n\ - \032 and ending with a name ending by .ml.\n\ - \032 ignore = Regex a/b/.*\\.ml\n\ - \n\ - \032 Note that regular expression patterns are \"anchored\": they must match\n\ - \032 the whole path, not just a substring of the path.\n\ - \n\ - \032 Here are a few extra points regarding the ignore preference.\n\ - \032 * If a directory is ignored, all its descendents will be too.\n\ - \032 * The user interface provides some convenient commands for adding\n\ - \032 new patterns to be ignored. To ignore a particular file, select it\n\ - \032 and press \"i\". To ignore all files with the same extension, select\n\ - \032 it and press \"E\" (with the shift key). To ignore all files with\n\ - \032 the same name, no matter what directory they appear in, select it\n\ - \032 and press \"N\". These new patterns become permanent: they are\n\ - \032 immediately added to the current profile on disk.\n\ - \032 * If you use the include directive to include a common collection of\n\ - \032 preferences in several top-level preference files, you will\n\ - \032 probably also want to set the addprefsto preference to the name of\n\ - \032 this file. This will cause any new ignore patterns that you add\n\ - \032 from inside Unison to be appended to this file, instead of\n\ - \032 whichever top-level preference file you started Unison with.\n\ - \032 * Ignore patterns can also be specified on the command line, if you\n\ - \032 like (this is probably not very useful), using an option like\n\ - \032 -ignore 'Name temp.txt'.\n\ - \032 * Be careful about renaming directories containing ignored files.\n\ - \032 Because Unison understands the rename as a delete plus a create,\n\ - \032 any ignored files in the directory will be lost (since they are\n\ - \032 invisible to Unison and therefore they do not get recreated in the\n\ - \032 new version of the directory).\n\ - \032 * There is also an ignorenot preference, which specifies a set of\n\ - \032 patterns for paths that should not be ignored, even if they match\n\ - \032 an ignore pattern. However, the interaction of these two sets of\n\ - \032 patterns can be a little tricky. Here is exactly how it works:\n\ - \032 + Unison starts detecting updates from the root of the\n\ - \032 replicas--i.e., from the empty path. If the empty path\n\ - \032 matches an ignore pattern and does not match an ignorenot\n\ - \032 pattern, then the whole replica will be ignored. (For this\n\ - \032 reason, it is not a good idea to include Name * as an ignore\n\ - \032 pattern. If you want to ignore everything except a certain\n\ - \032 set of files, use Name ?*.)\n\ - \032 + If the root is a directory, Unison continues looking for\n\ - \032 updates in all the immediate children of the root. Again, if\n\ - \032 the name of some child matches an ignore pattern and does not\n\ - \032 match an ignorenot pattern, then this whole path including\n\ - \032 everything below it will be ignored.\n\ - \032 + If any of the non-ignored children are directories, then the\n\ - \032 process continues recursively.\n\ - \n\ - Symbolic Links\n\ - \n\ - \032 Ordinarily, Unison treats symbolic links in Unix replicas as \"opaque\":\n\ - \032 it considers the contents of the link to be just the string specifying\n\ - \032 where the link points, and it will propagate changes in this string to\n\ - \032 the other replica.\n\ - \n\ - \032 It is sometimes useful to treat a symbolic link \"transparently,\"\n\ - \032 acting as though whatever it points to were physically in the replica\n\ - \032 at the point where the symbolic link appears. To tell Unison to treat\n\ - \032 a link in this manner, add a line of the form\n\ - \032 follow = pathspec\n\ - \n\ - \032 to the profile, where pathspec is a path pattern as described in the\n\ - \032 section \"Path Patterns\" .\n\ - \n\ - \032 Windows file systems do not support symbolic links; Unison will refuse\n\ - \032 to propagate an opaque symbolic link from Unix to Windows and flag the\n\ - \032 path as erroneous. When a Unix replica is to be synchronized with a\n\ - \032 Windows system, all symbolic links should match either an ignore\n\ - \032 pattern or a follow pattern.\n\ - \n\ - Permissions\n\ - \n\ - \032 Synchronizing the permission bits of files is slightly tricky when two\n\ - \032 different filesytems are involved (e.g., when synchronizing a Windows\n\ - \032 client and a Unix server). In detail, here's how it works:\n\ - \032 * When the permission bits of an existing file or directory are\n\ - \032 changed, the values of those bits that make sense on both\n\ - \032 operating systems will be propagated to the other replica. The\n\ - \032 other bits will not be changed.\n\ - \032 * When a newly created file is propagated to a remote replica, the\n\ - \032 permission bits that make sense in both operating systems are also\n\ - \032 propagated. The values of the other bits are set to default values\n\ - \032 (they are taken from the current umask, if the receiving host is a\n\ - \032 Unix system).\n\ - \032 * For security reasons, the Unix setuid and setgid bits are not\n\ - \032 propagated.\n\ - \032 * The Unix owner and group ids are not propagated. (What would this\n\ - \032 mean, in general?) All files are created with the owner and group\n\ - \032 of the server process.\n\ - \n\ - Cross-Platform Synchronization\n\ - \n\ - \032 If you use Unison to synchronize files between Windows and Unix\n\ - \032 systems, there are a few special issues to be aware of.\n\ - \n\ - \032 Case conflicts. In Unix, filenames are case sensitive: foo and FOO can\n\ - \032 refer to different files. In Windows, on the other hand, filenames are\n\ - \032 not case sensitive: foo and FOO can only refer to the same file. This\n\ - \032 means that a Unix foo and FOO cannot be synchronized onto a Windows\n\ - \032 system -- Windows won't allow two different files to have the \"same\"\n\ - \032 name. Unison detects this situation for you, and reports that it\n\ - \032 cannot synchronize the files.\n\ - \n\ - \032 You can deal with a case conflict in a couple of ways. If you need to\n\ - \032 have both files on the Windows system, your only choice is to rename\n\ - \032 one of the Unix files to avoid the case conflict, and re-synchronize.\n\ - \032 If you don't need the files on the Windows system, you can simply\n\ - \032 disregard Unison's warning message, and go ahead with the\n\ - \032 synchronization; Unison won't touch those files. If you don't want to\n\ - \032 see the warning on each synchronization, you can tell Unison to ignore\n\ - \032 the files (see the section \"Ignore\" ).\n\ - \n\ - \032 Illegal filenames. Unix allows some filenames that are illegal in\n\ - \032 Windows. For example, colons (`:') are not allowed in Windows\n\ - \032 filenames, but they are legal in Unix filenames. This means that a\n\ - \032 Unix file foo:bar can't be synchronized to a Windows system. As with\n\ - \032 case conflicts, Unison detects this situation for you, and you have\n\ - \032 the same options: you can either rename the Unix file and\n\ - \032 re-synchronize, or you can ignore it.\n\ - \n\ - Slow Links\n\ - \n\ - \032 Unison is built to run well even over relatively slow links such as\n\ - \032 modems and DSL connections.\n\ - \n\ - \032 Unison uses the \"rsync protocol\" designed by Andrew Tridgell and Paul\n\ - \032 Mackerras to greatly speed up transfers of large files in which only\n\ - \032 small changes have been made. More information about the rsync\n\ - \032 protocol can be found at the rsync web site\n\ - \032 (http://samba.anu.edu.au/rsync/).\n\ - \n\ - \032 If you are using Unison with ssh, you may get some speed improvement\n\ - \032 by enabling ssh's compression feature. Do this by adding the option\n\ - \032 \"-rshargs -C\" to the command line or \"rshargs = -C\" to your profile.\n\ - \n\ - Making Unison Faster on Large Files\n\ - \n\ - \032 Unison's built-in implementation of the rsync algorithm makes\n\ - \032 transferring updates to existing files pretty fast. However, for\n\ - \032 whole-file copies of newly created files, the built-in transfer method\n\ - \032 is not highly optimized. Also, if Unison is interrupted in the middle\n\ - \032 of transferring a large file, it will attempt to retransfer the whole\n\ - \032 thing on the next run.\n\ - \n\ - \032 These shortcomings can be addressed with a little extra work by\n\ - \032 telling Unison to use an external file copying utility for whole-file\n\ - \032 transfers. The recommended one is the standalone rsync tool, which is\n\ - \032 available by default on most Unix systems and can easily be installed\n\ - \032 on Windows systems using Cygwin.\n\ - \n\ - \032 If you have rsync installed on both hosts, you can make Unison use it\n\ - \032 simply by setting the copythreshold flag to something non-negative. If\n\ - \032 you set it to 0, Unison will use the external copy utility for all\n\ - \032 whole-file transfers. (This is probably slower than letting Unison\n\ - \032 copy small files by itself, but can be useful for testing.) If you set\n\ - \032 it to a larger value, Unison will use the external utility for all\n\ - \032 files larger than this size (which is given in kilobytes, so setting\n\ - \032 it to 1000 will cause the external tool to be used for all transfers\n\ - \032 larger than a megabyte).\n\ - \n\ - \032 If you want to use a different external copy utility, set both the\n\ - \032 copyprog and copyprogpartial preferences--the former is used for the\n\ - \032 first transfer of a file, while the latter is used when Unison sees a\n\ - \032 partially transferred temp file on the receiving host. Be careful\n\ - \032 here: Your external tool needs to be instructed to copy files in place\n\ - \032 (otherwise if the transfer is interrupted Unison will not notice that\n\ - \032 some of the data has already been transferred, the next time it\n\ - \032 tries). The default values are:\n\ - \032 copyprog = rsync --inplace --compress\n\ - \032 copyprogrest = rsync --partial --inplace --compress\n\ - \n\ - \032 You may also need to set the copyquoterem preference. When it is set\n\ - \032 to true, this causes Unison to add an extra layer of quotes to the\n\ - \032 remote path passed to the external copy program. This is is needed by\n\ - \032 rsync, for example, which internally uses an ssh connection, requiring\n\ - \032 an extra level of quoting for paths containing spaces. When this flag\n\ - \032 is set to default, extra quotes are added if the value of copyprog\n\ - \032 contains the string rsync. The default value is default, naturally.\n\ - \n\ - \032 If a directory transfer is interrupted, the next run of Unison will\n\ - \032 automatically skip any files that were completely transferred before\n\ - \032 the interruption. (This behavior is always on: it does not depend on\n\ - \032 the setting of the copythreshold preference.) Note, though, that the\n\ - \032 new directory will not appear in the destination filesystem until\n\ - \032 everything has been transferred--partially transferred directories are\n\ - \032 kept in a temporary location (with names like .unison.DIRNAME....)\n\ - \032 until the transfer is complete.\n\ - \n\ - Fast Update Detection\n\ - \n\ - \032 If your replicas are large and at least one of them is on a Windows\n\ - \032 system, you may find that Unison's default method for detecting\n\ - \032 changes (which involves scanning the full contents of every file on\n\ - \032 every sync--the only completely safe way to do it under Windows) is\n\ - \032 too slow. Unison provides a preference fastcheck that, when set to\n\ - \032 true, causes it to use file creation times as 'pseudo inode numbers'\n\ - \032 when scanning replicas for updates, instead of reading the full\n\ - \032 contents of every file.\n\ - \n\ - \032 When fastcheck is set to no, Unison will perform slow\n\ - \032 checking--re-scanning the contents of each file on each\n\ - \032 synchronization--on all replicas. When fastcheck is set to default\n\ - \032 (which, naturally, is the default), Unison will use fast checks on\n\ - \032 Unix replicas and slow checks on Windows replicas.\n\ - \n\ - \032 This strategy may cause Unison to miss propagating an update if the\n\ - \032 modification time and length of the file are both unchanged by the\n\ - \032 update. However, Unison will never overwrite such an update with a\n\ - \032 change from the other replica, since it always does a safe check for\n\ - \032 updates just before propagating a change. Thus, it is reasonable to\n\ - \032 use this switch most of the time and occasionally run Unison once with\n\ - \032 fastcheck set to no, if you are worried that Unison may have\n\ - \032 overlooked an update.\n\ - \n\ - \032 Fastcheck is (always) automatically disabled for files with extension\n\ - \032 .xls or .mpp, to prevent Unison from being confused by the habits of\n\ - \032 certain programs (Excel, in particular) of updating files without\n\ - \032 changing their modification times.\n\ - \n\ - Mount Points and Removable Media\n\ - \n\ - \032 Using Unison removable media such as USB drives can be dangerous\n\ - \032 unless you are careful. If you synchronize a directory that is stored\n\ - \032 on removable media when the media is not present, it will look to\n\ - \032 Unison as though the whole directory has been deleted, and it will\n\ - \032 proceed to delete the directory from the other replica--probably not\n\ - \032 what you want!\n\ - \n\ - \032 To prevent accidents, Unison provides a preference called mountpoint.\n\ - \032 Including a line like\n\ - \032 mountpoint = foo\n\ - \n\ - \032 in your preference file will cause Unison to check, after it finishes\n\ - \032 detecting updates, that something actually exists at the path foo on\n\ - \032 both replicas; if it does not, the Unison run will abort.\n\ - \n\ - Click-starting Unison\n\ - \n\ - \032 On Windows NT/2k/XP systems, the graphical version of Unison can be\n\ - \032 invoked directly by clicking on its icon. On Windows 95/98 systems,\n\ - \032 click-starting also works, as long as you are not using ssh. Due to an\n\ - \032 incompatibility with ocaml and Windows 95/98 that is not under our\n\ - \032 control, you must start Unison from a DOS window in Windows 95/98 if\n\ - \032 you want to use ssh.\n\ - \n\ - \032 When you click on the Unison icon, two windows will be created:\n\ - \032 Unison's regular window, plus a console window, which is used only for\n\ - \032 giving your password to ssh (if you do not use ssh to connect, you can\n\ - \032 ignore this window). When your password is requested, you'll need to\n\ - \032 activate the console window (e.g., by clicking in it) before typing.\n\ - \032 If you start Unison from a DOS window, Unison's regular window will\n\ - \032 appear and you will type your password in the DOS window you were\n\ - \032 using.\n\ - \n\ - \032 To use Unison in this mode, you must first create a profile (see the\n\ - \032 section \"Profile\" ). Use your favorite editor for this.\n\ - \n\ - ")) -:: - ("ssh", ("Installing Ssh", - "Installing Ssh\n\ - \n\ - \032 Warning: These instructions may be out of date. More current\n\ - \032 information can be found the Unison Wiki\n\ - \032 (http://alliance.seas.upenn.edu/ bcpierce/wiki/index.php?n=Main.Unison\n\ - \032 FAQOSSpecific).\n\ - \n\ - \032 Your local host will need just an ssh client; the remote host needs an\n\ - \032 ssh server (or daemon), which is available on Unix systems. Unison is\n\ - \032 known to work with ssh version 1.2.27 (Unix) and version 1.2.14\n\ - \032 (Windows); other versions may or may not work.\n\ - \n\ - Unix\n\ - \n\ - \032 Most modern Unix installations come with ssh pre-installed.\n\ - \n\ - Windows\n\ - \n\ - \032 Many Windows implementations of ssh only provide graphical interfaces,\n\ - \032 but Unison requires an ssh client that it can invoke with a\n\ - \032 command-line interface. A suitable version of ssh can be installed as\n\ - \032 follows.\n\ - \032 1. Download an ssh executable.\n\ - \032 Warning: there are many implementations and ports of ssh for\n\ - \032 Windows, and not all of them will work with Unison. We have gotten\n\ - \032 Unison to work with Cygwin's port of openssh, and we suggest you\n\ - \032 try that one first. Here's how to install it:\n\ - \032 a. First, create a new folder on your desktop to hold temporary\n\ - \032 installation files. It can have any name you like, but in\n\ - \032 these instructions we'll assume that you call it Foo.\n\ - \032 b. Direct your web browser to www.cygwin.com, and click on the\n\ - \032 \"Install now!\" link. This will download a file, setup.exe;\n\ - \032 save it in the directory Foo. The file setup.exe is a small\n\ - \032 program that will download the actual install files from the\n\ - \032 Internet when you run it.\n\ - \032 c. Start setup.exe (by double-clicking). This brings up a series\n\ - \032 of dialogs that you will have to go through. Select \"Install\n\ - \032 from Internet.\" For \"Local Package Directory\" select the\n\ - \032 directory Foo. For \"Select install root directory\" we\n\ - \032 recommend that you use the default, C:\\cygwin. The next\n\ - \032 dialog asks you to select the way that you want to connect to\n\ - \032 the network to download the installation files; we have used\n\ - \032 \"Use IE5 Settings\" successfully, but you may need to make a\n\ - \032 different selection depending on your networking setup. The\n\ - \032 next dialog gives a list of mirrors; select one close to you.\n\ - \032 Next you are asked to select which packages to install. The\n\ - \032 default settings in this dialog download a lot of packages\n\ - \032 that are not strictly necessary to run Unison with ssh. If\n\ - \032 you don't want to install a package, click on it until \"skip\"\n\ - \032 is shown. For a minimum installation, select only the\n\ - \032 packages \"cygwin\" and \"openssh,\" which come to about 1900KB;\n\ - \032 the full installation is much larger.\n\ - \n\ - \032 Note that you are plan to build unison using the free CygWin GNU C\n\ - \032 compiler, you need to install essential development packages such\n\ - \032 as \"gcc\", \"make\", \"fileutil\", etc; we refer to the file\n\ - \032 \"INSTALL.win32-cygwin-gnuc\" in the source distribution for further\n\ - \032 details. \n\ - \032 After the packages are downloaded and installed, the next\n\ - \032 dialog allows you to choose whether to \"Create Desktop Icon\"\n\ - \032 and \"Add to Start Menu.\" You make the call.\n\ - \032 d. You can now delete the directory Foo and its contents.\n\ - \032 Some people have reported problems using Cygwin's ssh with Unison.\n\ - \032 If you have trouble, you might try this one instead:\n\ - \032 http://opensores.thebunker.net/pub/mirrors/ssh/contrib/ssh-1.2.14-win32bin.zi\n\ - p\n\ - \032 2. You must set the environment variables HOME and PATH. Ssh will\n\ - \032 create a directory .ssh in the directory given by HOME, so that it\n\ - \032 has a place to keep data like your public and private keys. PATH\n\ - \032 must be set to include the Cygwin bin directory, so that Unison\n\ - \032 can find the ssh executable.\n\ - \032 + On Windows 95/98, add the lines\n\ - \032 set PATH=%PATH%;\n\ - \032 set HOME=\n\ - \032 to the file C:\\AUTOEXEC.BAT, where is the directory\n\ - \032 where you want ssh to create its .ssh directory, and \n\ - \032 is the directory where the executable ssh.exe is stored; if\n\ - \032 you've installed Cygwin in the default location, this is\n\ - \032 C:\\cygwin\\bin. You will have to reboot your computer to take\n\ - \032 the changes into account.\n\ - \032 + On Windows NT/2k/XP, open the environment variables dialog\n\ - \032 box:\n\ - \032 o Windows NT: My Computer/Properties/Environment\n\ - \032 o Windows 2k: My Computer/Properties/Advanced/Environment\n\ - \032 variables\n\ - \032 then select Path and edit its value by appending ; to\n\ - \032 it, where is the full name of the directory that\n\ - \032 includes the ssh executable; if you've installed Cygwin in\n\ - \032 the default location, this is C:\\cygwin\\bin.\n\ - \032 3. Test ssh from a DOS shell by typing\n\ - \032 ssh -l \n\ - \032 You should get a prompt for your password on ,\n\ - \032 followed by a working connection.\n\ - \032 4. Note that ssh-keygen may not work (fails with \"gethostname: no\n\ - \032 such file or directory\") on some systems. This is OK: you can use\n\ - \032 ssh with your regular password for the remote system.\n\ - \032 5. You should now be able to use Unison with an ssh connection. If\n\ - \032 you are logged in with a different user name on the local and\n\ - \032 remote hosts, provide your remote user name when providing the\n\ - \032 remote root (i.e., //username at host/path...).\n\ - \n\ - ")) -:: - ("news", ("Changes in Version 2.32.1", - "Changes in Version 2.32.1\n\ - \n\ - \032 Changes since 2.17:\n\ - \032 * Major rewrite and cleanup of the whole Mac OS X graphical user\n\ - \032 interface by Craig Federighi. Thanks, Craig!!!\n\ - \032 * Small fix to ctime (non-)handling in update detection under\n\ - \032 windows with fastcheck.\n\ - \n\ - \032 Changes since 2.17:\n\ - \032 * Several small fixes to the GTK2 UI to make it work better under\n\ - \032 Windows [thanks to Karl M for these].\n\ - \032 * The backup functionality has been completely rewritten. The\n\ - \032 external interface has not changed, but numerous bugs, irregular\n\ - \032 behaviors, and cross-platform inconsistencies have been corrected.\n\ - \032 * The Unison project now accepts donations via PayPal. If you'd like\n\ - \032 to donate, you can find a link to the donation page on the Unison\n\ - \032 home page (http://www.cis.upenn.edu/ bcpierce/unison/lists.html).\n\ - \032 * Some important safety improvements:\n\ - \032 + Added a new mountpoint preference, which can be used to\n\ - \032 specify a path that must exist in both replicas at the end of\n\ - \032 update detection (otherwise Unison aborts). This can be used\n\ - \032 to avoid potentially dangerous situations when Unison is used\n\ - \032 with removable media such as external hard drives and compact\n\ - \032 flash cards.\n\ - \032 + The confirmation of \"big deletes\" is now controlled by a\n\ - \032 boolean preference confirmbigdeletes. Default is true, which\n\ - \032 gives the same behavior as previously. (This functionality is\n\ - \032 at least partly superceded by the mountpoint preference, but\n\ - \032 it has been left in place in case it is useful to some\n\ - \032 people.)\n\ - \032 + If Unison is asked to \"follow\" a symbolic link but there is\n\ - \032 nothing at the other end of the link, it will now flag this\n\ - \032 path as an error, rather than treating the symlink itself as\n\ - \032 missing or deleted. This avoids a potentially dangerous\n\ - \032 situation where a followed symlink points to an external\n\ - \032 filesystem that might be offline when Unison is run\n\ - \032 (whereupon Unison would cheerfully delete the corresponding\n\ - \032 files in the other replica!).\n\ - \032 * Smaller changes:\n\ - \032 + Added forcepartial and preferpartial preferences, which\n\ - \032 behave like force and prefer but can be specified on a\n\ - \032 per-path basis. [Thanks to Alan Schmitt for this.]\n\ - \032 + A bare-bones self test feature was added, which runs unison\n\ - \032 through some of its paces and checks that the results are as\n\ - \032 expected. The coverage of the tests is still very limited,\n\ - \032 but the facility has already been very useful in debugging\n\ - \032 the new backup functionality (especially in exposing some\n\ - \032 subtle cross-platform issues).\n\ - \032 + Refined debugging code so that the verbosity of individual\n\ - \032 modules can be controlled separately. Instead of just putting\n\ - \032 '-debug verbose' on the command line, you can put '-debug\n\ - \032 update+', which causes all the extra messages in the Update\n\ - \032 module, but not other modules, to be printed. Putting '-debug\n\ - \032 verbose' causes all modules to print with maximum verbosity.\n\ - \032 + Removed mergebatch preference. (It never seemed very useful,\n\ - \032 and its semantics were confusing.)\n\ - \032 + Rewrote some of the merging functionality, for better\n\ - \032 cooperation with external Harmony instances.\n\ - \032 + Changed the temp file prefix from .# to .unison.\n\ - \032 + Compressed the output from the text user interface\n\ - \032 (particularly when run with the -terse flag) to make it\n\ - \032 easier to interpret the results when Unison is run several\n\ - \032 times in succession from a script.\n\ - \032 + Diff and merge functions now work under Windows.\n\ - \032 + Changed the order of arguments to the default diff command\n\ - \032 (so that the + and - annotations in diff's output are\n\ - \032 reversed).\n\ - \032 + Added .mpp files to the \"never fastcheck\" list (like .xls\n\ - \032 files).\n\ - \032 * Many small bugfixes, including:\n\ - \032 + Fixed a longstanding bug regarding fastcheck and daylight\n\ - \032 saving time under Windows when Unison is set up to\n\ - \032 synchronize modification times. (Modification times cannot be\n\ - \032 updated in the archive in this case, so we have to ignore one\n\ - \032 hour differences.)\n\ - \032 + Fixed a bug that would occasionally cause the archives to be\n\ - \032 left in non-identical states on the two hosts after\n\ - \032 synchronization.\n\ - \032 + Fixed a bug that prevented Unison from communicating\n\ - \032 correctly between 32- and 64-bit architectures.\n\ - \032 + On windows, file creation times are no longer used as a proxy\n\ - \032 for inode numbers. (This is unfortunate, as it makes\n\ - \032 fastcheck a little less safe. But it turns out that file\n\ - \032 creation times are not reliable under Windows: if a file is\n\ - \032 removed and a new file is created in its place, the new one\n\ - \032 will sometimes be given the same creation date as the old\n\ - \032 one!)\n\ - \032 + Set read-only file to R/W on OSX before attempting to change\n\ - \032 other attributes.\n\ - \032 + Fixed bug resulting in spurious \"Aborted\" errors during\n\ - \032 transport (thanks to Jerome Vouillon)\n\ - \032 + Enable diff if file contents have changed in one replica, but\n\ - \032 only properties in the other.\n\ - \032 + Removed misleading documentation for 'repeat' preference.\n\ - \032 + Fixed a bug in merging code where Unison could sometimes\n\ - \032 deadlock with the external merge program, if the latter\n\ - \032 produced large amounts of output.\n\ - \032 + Workaround for a bug compiling gtk2 user interface against\n\ - \032 current versions of gtk2+ libraries.\n\ - \032 + Added a better error message for \"ambiguous paths\".\n\ - \032 + Squashed a longstanding bug that would cause file transfer to\n\ - \032 fail with the message \"Failed: Error in readWrite: Is a\n\ - \032 directory.\"\n\ - \032 + Replaced symlinks with copies of their targets in the Growl\n\ - \032 framework in src/uimac. This should make the sources easier\n\ - \032 to check out from the svn repository on WinXP systems.\n\ - \032 + Added a workaround (suggested by Karl M.) for the problem\n\ - \032 discussed on the unison users mailing list where, on the\n\ - \032 Windows platform, the server would hang when transferring\n\ - \032 files. I conjecture that the problem has to do with the RPC\n\ - \032 mechanism, which was used to make a call back from the server\n\ - \032 to the client (inside the Trace.log function) so that the log\n\ - \032 message would be appended to the log file on the client. The\n\ - \032 workaround is to dump these messages (about when\n\ - \032 xferbycopying shortcuts are applied and whether they succeed)\n\ - \032 just to the standard output of the Unison process, not to the\n\ - \032 log file.\n\ - \n\ - \032 Changes since 2.13.0:\n\ - \032 * The features for performing backups and for invoking external\n\ - \032 merge programs have been completely rewritten by Stephane Lescuyer\n\ - \032 (thanks, Stephane!). The user-visible functionality should not\n\ - \032 change, but the internals have been rationalized and there are a\n\ - \032 number of new features. See the manual (in particular, the\n\ - \032 description of the backupXXX preferences) for details.\n\ - \032 * Incorporated patches for ipv6 support, contributed by Samuel\n\ - \032 Thibault. (Note that, due to a bug in the released OCaml 3.08.3\n\ - \032 compiler, this code will not actually work with ipv6 unless\n\ - \032 compiled with the CVS version of the OCaml compiler, where the bug\n\ - \032 has been fixed; however, ipv4 should continue to work normally.)\n\ - \032 * OSX interface:\n\ - \032 + Incorporated Ben Willmore's cool new icon for the Mac UI.\n\ - \032 * Small fixes:\n\ - \032 + Fixed off by one error in month numbers (in printed dates)\n\ - \032 reported by Bob Burger\n\ - \n\ - \032 Changes since 2.12.0:\n\ - \032 * New convention for release numbering: Releases will continue to be\n\ - \032 given numbers of the form X.Y.Z, but, from now on, just the major\n\ - \032 version number (X.Y) will be considered significant when checking\n\ - \032 compatibility between client and server versions. The third\n\ - \032 component of the version number will be used only to identify\n\ - \032 \"patch levels\" of releases.\n\ - \032 This change goes hand in hand with a change to the procedure for\n\ - \032 making new releases. Candidate releases will initially be given\n\ - \032 \"beta release\" status when they are announced for public\n\ - \032 consumption. Any bugs that are discovered will be fixed in a\n\ - \032 separate branch of the source repository (without changing the\n\ - \032 major version number) and new tarballs re-released as needed. When\n\ - \032 this process converges, the patched beta version will be dubbed\n\ - \032 stable.\n\ - \032 * Warning (failure in batch mode) when one path is completely\n\ - \032 emptied. This prevents Unison from deleting everything on one\n\ - \032 replica when the other disappear.\n\ - \032 * Fix diff bug (where no difference is shown the first time the diff\n\ - \032 command is given).\n\ - \032 * User interface changes:\n\ - \032 + Improved workaround for button focus problem (GTK2 UI)\n\ - \032 + Put leading zeroes in date fields\n\ - \032 + More robust handling of character encodings in GTK2 UI\n\ - \032 + Changed format of modification time displays, from modified\n\ - \032 at hh:mm:ss on dd MMM, yyyy to modified on yyyy-mm-dd\n\ - \032 hh:mm:ss\n\ - \032 + Changed time display to include seconds (so that people on\n\ - \032 FAT filesystems will not be confused when Unison tries to\n\ - \032 update a file time to an odd number of seconds and the\n\ - \032 filesystem truncates it to an even number!)\n\ - \032 + Use the diff \"-u\" option by default when showing differences\n\ - \032 between files (the output is more readable)\n\ - \032 + In text mode, pipe the diff output to a pager if the\n\ - \032 environment variable PAGER is set\n\ - \032 + Bug fixes and cleanups in ssh password prompting. Now works\n\ - \032 with the GTK2 UI under Linux. (Hopefully the Mac OS X one is\n\ - \032 not broken!)\n\ - \032 + Include profile name in the GTK2 window name\n\ - \032 + Added bindings ',' (same as '<') and '.' (same as '>') in the\n\ - \032 GTK2 UI\n\ - \032 * Mac GUI:\n\ - \032 + actions like < and > scroll to the next item as necessary.\n\ - \032 + Restart has a menu item and keyboard shortcut (command-R).\n\ - \032 + Added a command-line tool for Mac OS X. It can be installed\n\ - \032 from the Unison menu.\n\ - \032 + New icon.\n\ - \032 + Handle the \"help\" command-line argument properly.\n\ - \032 + Handle profiles given on the command line properly.\n\ - \032 + When a profile has been selected, the profile dialog is\n\ - \032 replaced by a \"connecting\" message while the connection is\n\ - \032 being made. This gives better feedback.\n\ - \032 + Size of left and right columns is now large enough so that\n\ - \032 \"PropsChanged\" is not cut off.\n\ - \032 * Minor changes:\n\ - \032 + Disable multi-threading when both roots are local\n\ - \032 + Improved error handling code. In particular, make sure all\n\ - \032 files are closed in case of a transient failure\n\ - \032 + Under Windows, use $UNISON for home directory as a last\n\ - \032 resort (it was wrongly moved before $HOME and $USERPROFILE in\n\ - \032 Unison 2.12.0)\n\ - \032 + Reopen the logfile if its name changes (profile change)\n\ - \032 + Double-check that permissions and modification times have\n\ - \032 been properly set: there are some combination of OS and\n\ - \032 filesystem on which setting them can fail in a silent way.\n\ - \032 + Check for bad Windows filenames for pure Windows\n\ - \032 synchronization also (not just cross architecture\n\ - \032 synchronization). This way, filenames containing backslashes,\n\ - \032 which are not correctly handled by unison, are rejected right\n\ - \032 away.\n\ - \032 + Attempt to resolve issues with synchronizing modification\n\ - \032 times of read-only files under Windows\n\ - \032 + Ignore chmod failures when deleting files\n\ - \032 + Ignore trailing dots in filenames in case insensitive mode\n\ - \032 + Proper quoting of paths, files and extensions ignored using\n\ - \032 the UI\n\ - \032 + The strings CURRENT1 and CURRENT2 are now correctly\n\ - \032 substitued when they occur in the diff preference\n\ - \032 + Improvements to syncing resource forks between Macs via a\n\ - \032 non-Mac system.\n\ - \n\ - \032 Changes since 2.10.2:\n\ - \032 * INCOMPATIBLE CHANGE: Archive format has changed.\n\ - \032 * Source code availability: The Unison sources are now managed using\n\ - \032 Subversion. One nice side-effect is that anonymous checkout is now\n\ - \032 possible, like this:\n\ - \032 svn co https://cvs.cis.upenn.edu:3690/svnroot/unison/\n\ - \032 We will also continue to export a \"developer tarball\" of the\n\ - \032 current (modulo one day) sources in the web export directory. To\n\ - \032 receive commit logs for changes to the sources, subscribe to the\n\ - \032 unison-hackers list\n\ - \032 (http://www.cis.upenn.edu/ bcpierce/unison/lists.html).\n\ - \032 * Text user interface:\n\ - \032 + Substantial reworking of the internal logic of the text UI to\n\ - \032 make it a bit easier to modify.\n\ - \032 + The dumbtty flag in the text UI is automatically set to true\n\ - \032 if the client is running on a Unix system and the EMACS\n\ - \032 environment variable is set to anything other than the empty\n\ - \032 string.\n\ - \032 * Native OS X gui:\n\ - \032 + Added a synchronize menu item with keyboard shortcut\n\ - \032 + Added a merge menu item, still needs to be debugged\n\ - \032 + Fixes to compile for Panther\n\ - \032 + Miscellaneous improvements and bugfixes\n\ - \032 * Small changes:\n\ - \032 + Changed the filename checking code to apply to Windows only,\n\ - \032 instead of OS X as well.\n\ - \032 + Finder flags now synchronized\n\ - \032 + Fallback in copy.ml for filesystem that do not support O_EXCL\n\ - \032 + Changed buffer size for local file copy (was highly\n\ - \032 inefficient with synchronous writes)\n\ - \032 + Ignore chmod failure when deleting a directory\n\ - \032 + Fixed assertion failure when resolving a conflict content\n\ - \032 change / permission changes in favor of the content change.\n\ - \032 + Workaround for transferring large files using rsync.\n\ - \032 + Use buffered I/O for files (this is the only way to open\n\ - \032 files in binary mode under Cygwin).\n\ - \032 + On non-Cygwin Windows systems, the UNISON environment\n\ - \032 variable is now checked first to determine where to look for\n\ - \032 Unison's archive and preference files, followed by HOME and\n\ - \032 USERPROFILE in that order. On Unix and Cygwin systems, HOME\n\ - \032 is used.\n\ - \032 + Generalized diff preference so that it can be given either as\n\ - \032 just the command name to be used for calculating diffs or\n\ - \032 else a whole command line, containing the strings CURRENT1\n\ - \032 and CURRENT2, which will be replaced by the names of the\n\ - \032 files to be diff'ed before the command is called.\n\ - \032 + Recognize password prompts in some newer versions of ssh.\n\ - \n\ - \032 Changes since 2.9.20:\n\ - \032 * INCOMPATIBLE CHANGE: Archive format has changed.\n\ - \032 * Major functionality changes:\n\ - \032 + Major tidying and enhancement of 'merge' functionality. The\n\ - \032 main user-visible change is that the external merge program\n\ - \032 may either write the merged output to a single new file, as\n\ - \032 before, or it may modify one or both of its input files, or\n\ - \032 it may write two new files. In the latter cases, its\n\ - \032 modifications will be copied back into place on both the\n\ - \032 local and the remote host, and (if the two files are now\n\ - \032 equal) the archive will be updated appropriately. More\n\ - \032 information can be found in the user manual. Thanks to Malo\n\ - \032 Denielou and Alan Schmitt for these improvements.\n\ - \032 Warning: the new merging functionality is not completely\n\ - \032 compatible with old versions! Check the manual for details.\n\ - \032 + Files larger than 2Gb are now supported.\n\ - \032 + Added preliminary (and still somewhat experimental) support\n\ - \032 for the Apple OS X operating system.\n\ - \032 o Resource forks should be transferred correctly. (See the\n\ - \032 manual for details of how this works when synchronizing\n\ - \032 HFS with non-HFS volumes.) Synchronization of file type\n\ - \032 and creator information is also supported.\n\ - \032 o On OSX systems, the name of the directory for storing\n\ - \032 Unison's archives, preference files, etc., is now\n\ - \032 determined as follows:\n\ - \032 # if ~/.unison exists, use it\n\ - \032 # otherwise, use ~/Library/Application\n\ - \032 Support/Unison, creating it if necessary.\n\ - \032 o A preliminary native-Cocoa user interface is under\n\ - \032 construction. This still needs some work, and some users\n\ - \032 experience unpredictable crashes, so it is only for\n\ - \032 hackers for now. Run make with UISTYLE=mac to build this\n\ - \032 interface.\n\ - \032 * Minor functionality changes:\n\ - \032 + Added an ignorelocks preference, which forces Unison to\n\ - \032 override left-over archive locks. (Setting this preference is\n\ - \032 dangerous! Use it only if you are positive you know what you\n\ - \032 are doing.)\n\ - \032 + Added a new preference assumeContentsAreImmutable. If a\n\ - \032 directory matches one of the patterns set in this preference,\n\ - \032 then update detection is skipped for files in this directory.\n\ - \032 (The purpose is to speed update detection for cases like Mail\n\ - \032 folders, which contain lots and lots of immutable files.)\n\ - \032 Also a preference assumeContentsAreImmutableNot, which\n\ - \032 overrides the first, similarly to ignorenot. (Later\n\ - \032 amendment: these preferences are now called immutable and\n\ - \032 immutablenot.)\n\ - \032 + The ignorecase flag has been changed from a boolean to a\n\ - \032 three-valued preference. The default setting, called default,\n\ - \032 checks the operating systems running on the client and server\n\ - \032 and ignores filename case if either of them is OSX or\n\ - \032 Windows. Setting ignorecase to true or false overrides this\n\ - \032 behavior. If you have been setting ignorecase on the command\n\ - \032 line using -ignorecase=true or -ignorecase=false, you will\n\ - \032 need to change to -ignorecase true or -ignorecase false.\n\ - \032 + a new preference, 'repeat', for the text user interface\n\ - \032 (only). If 'repeat' is set to a number, then, after it\n\ - \032 finishes synchronizing, Unison will wait for that many\n\ - \032 seconds and then start over, continuing this way until it is\n\ - \032 killed from outside. Setting repeat to true will\n\ - \032 automatically set the batch preference to true.\n\ - \032 + Excel files are now handled specially, so that the fastcheck\n\ - \032 optimization is skipped even if the fastcheck flag is set.\n\ - \032 (Excel does some naughty things with modtimes, making this\n\ - \032 optimization unreliable and leading to failures during change\n\ - \032 propagation.)\n\ - \032 + The ignorecase flag has been changed from a boolean to a\n\ - \032 three-valued preference. The default setting, called\n\ - \032 'default', checks the operating systems running on the client\n\ - \032 and server and ignores filename case if either of them is OSX\n\ - \032 or Windows. Setting ignorecase to 'true' or 'false' overrides\n\ - \032 this behavior.\n\ - \032 + Added a new preference, 'repeat', for the text user interface\n\ - \032 (only, at the moment). If 'repeat' is set to a number, then,\n\ - \032 after it finishes synchronizing, Unison will wait for that\n\ - \032 many seconds and then start over, continuing this way until\n\ - \032 it is killed from outside. Setting repeat to true will\n\ - \032 automatically set the batch preference to true.\n\ - \032 + The 'rshargs' preference has been split into 'rshargs' and\n\ - \032 'sshargs' (mainly to make the documentation clearer). In\n\ - \032 fact, 'rshargs' is no longer mentioned in the documentation\n\ - \032 at all, since pretty much everybody uses ssh now anyway.\n\ - \032 * Documentation\n\ - \032 + The web pages have been completely redesigned and\n\ - \032 reorganized. (Thanks to Alan Schmitt for help with this.)\n\ - \032 * User interface improvements\n\ - \032 + Added a GTK2 user interface, capable (among other things) of\n\ - \032 displaying filenames in any locale encoding. Kudos to Stephen\n\ - \032 Tse for contributing this code!\n\ - \032 + The text UI now prints a list of failed and skipped transfers\n\ - \032 at the end of synchronization.\n\ - \032 + Restarting update detection from the graphical UI will reload\n\ - \032 the current profile (which in particular will reset the -path\n\ - \032 preference, in case it has been narrowed by using the\n\ - \032 \"Recheck unsynchronized items\" command).\n\ - \032 + Several small improvements to the text user interface,\n\ - \032 including a progress display.\n\ - \032 * Bug fixes (too numerous to count, actually, but here are some):\n\ - \032 + The maxthreads preference works now.\n\ - \032 + Fixed bug where warning message about uname returning an\n\ - \032 unrecognized result was preventing connection to server. (The\n\ - \032 warning is no longer printed, and all systems where 'uname'\n\ - \032 returns anything other than 'Darwin' are assumed not to be\n\ - \032 running OS X.)\n\ - \032 + Fixed a problem on OS X that caused some valid file names\n\ - \032 (e.g., those including colons) to be considered invalid.\n\ - \032 + Patched Path.followLink to follow links under cygwin in\n\ - \032 addition to Unix (suggested by Matt Swift).\n\ - \032 + Small change to the storeRootsName function, suggested by\n\ - \032 bliviero at ichips.intel.com, to fix a problem in unison with\n\ - \032 the `rootalias' option, which allows you to tell unison that\n\ - \032 two roots contain the same files. Rootalias was being applied\n\ - \032 after the hosts were sorted, so it wouldn't work properly in\n\ - \032 all cases.\n\ - \032 + Incorporated a fix by Dmitry Bely for setting utimes of\n\ - \032 read-only files on Win32 systems.\n\ - \032 * Installation / portability:\n\ - \032 + Unison now compiles with OCaml version 3.07 and later out of\n\ - \032 the box.\n\ - \032 + Makefile.OCaml fixed to compile out of the box under OpenBSD.\n\ - \032 + a few additional ports (e.g. OpenBSD, Zaurus/IPAQ) are now\n\ - \032 mentioned in the documentation\n\ - \032 + Unison can now be installed easily on OSX systems using the\n\ - \032 Fink package manager\n\ - \n\ - \032 Changes since 2.9.1:\n\ - \032 * Added a preference maxthreads that can be used to limit the number\n\ - \032 of simultaneous file transfers.\n\ - \032 * Added a backupdir preference, which controls where backup files\n\ - \032 are stored.\n\ - \032 * Basic support added for OSX. In particular, Unison now recognizes\n\ - \032 when one of the hosts being synchronized is running OSX and\n\ - \032 switches to a case-insensitive treatment of filenames (i.e., 'foo'\n\ - \032 and 'FOO' are considered to be the same file). (OSX is not yet\n\ - \032 fully working, however: in particular, files with resource forks\n\ - \032 will not be synchronized correctly.)\n\ - \032 * The same hash used to form the archive name is now also added to\n\ - \032 the names of the temp files created during file transfer. The\n\ - \032 reason for this is that, during update detection, we are going to\n\ - \032 silently delete any old temp files that we find along the way, and\n\ - \032 we want to prevent ourselves from deleting temp files belonging to\n\ - \032 other instances of Unison that may be running in parallel, e.g.\n\ - \032 synchronizing with a different host. Thanks to Ruslan Ermilov for\n\ - \032 this suggestion.\n\ - \032 * Several small user interface improvements\n\ - \032 * Documentation\n\ - \032 + FAQ and bug reporting instructions have been split out as\n\ - \032 separate HTML pages, accessible directly from the unison web\n\ - \032 page.\n\ - \032 + Additions to FAQ, in particular suggestions about performance\n\ - \032 tuning.\n\ - \032 * Makefile\n\ - \032 + Makefile.OCaml now sets UISTYLE=text or UISTYLE=gtk\n\ - \032 automatically, depending on whether it finds lablgtk\n\ - \032 installed\n\ - \032 + Unison should now compile \"out of the box\" under OSX\n\ - \n\ - \032 Changes since 2.8.1:\n\ - \032 * Changing profile works again under Windows\n\ - \032 * File movement optimization: Unison now tries to use local copy\n\ - \032 instead of transfer for moved or copied files. It is controled by\n\ - \032 a boolean option \"xferbycopying\".\n\ - \032 * Network statistics window (transfer rate, amount of data\n\ - \032 transferred). [NB: not available in Windows-Cygwin version.]\n\ - \032 * symlinks work under the cygwin version (which is dynamically\n\ - \032 linked).\n\ - \032 * Fixed potential deadlock when synchronizing between Windows and\n\ - \032 Unix\n\ - \032 * Small improvements:\n\ - \032 + If neither the\n\ - \032 tt USERPROFILE nor the\n\ - \032 tt HOME environment variables are set, then Unison will put\n\ - \032 its temporary commit log (called\n\ - \032 tt DANGER.README) into the directory named by the\n\ - \032 tt UNISON environment variable, if any; otherwise it will use\n\ - \032 tt C:.\n\ - \032 + alternative set of values for fastcheck: yes = true; no =\n\ - \032 false; default = auto.\n\ - \032 + -silent implies -contactquietly\n\ - \032 * Source code:\n\ - \032 + Code reorganization and tidying. (Started breaking up some of\n\ - \032 the basic utility modules so that the non-unison-specific\n\ - \032 stuff can be made available for other projects.)\n\ - \032 + several Makefile and docs changes (for release);\n\ - \032 + further comments in \"update.ml\";\n\ - \032 + connection information is not stored in global variables\n\ - \032 anymore.\n\ - \n\ - \032 Changes since 2.7.78:\n\ - \032 * Small bugfix to textual user interface under Unix (to avoid\n\ - \032 leaving the terminal in a bad state where it would not echo inputs\n\ - \032 after Unison exited).\n\ - \n\ - \032 Changes since 2.7.39:\n\ - \032 * Improvements to the main web page (stable and beta version docs\n\ - \032 are now both accessible).\n\ - \032 * User manual revised.\n\ - \032 * Added some new preferences:\n\ - \032 + \"sshcmd\" and \"rshcmd\" for specifying paths to ssh and rsh\n\ - \032 programs.\n\ - \032 + \"contactquietly\" for suppressing the \"contacting server\"\n\ - \032 message during Unison startup (under the graphical UI).\n\ - \032 * Bug fixes:\n\ - \032 + Fixed small bug in UI that neglected to change the displayed\n\ - \032 column headers if loading a new profile caused the roots to\n\ - \032 change.\n\ - \032 + Fixed a bug that would put the text UI into an infinite loop\n\ - \032 if it encountered a conflict when run in batch mode.\n\ - \032 + Added some code to try to fix the display of non-Ascii\n\ - \032 characters in filenames on Windows systems in the GTK UI.\n\ - \032 (This code is currently untested--if you're one of the people\n\ - \032 that had reported problems with display of non-ascii\n\ - \032 filenames, we'd appreciate knowing if this actually fixes\n\ - \032 things.)\n\ - \032 + `-prefer/-force newer' works properly now. (The bug was\n\ - \032 reported by Sebastian Urbaniak and Sean Fulton.)\n\ - \032 * User interface and Unison behavior:\n\ - \032 + Renamed `Proceed' to `Go' in the graphical UI.\n\ - \032 + Added exit status for the textual user interface.\n\ - \032 + Paths that are not synchronized because of conflicts or\n\ - \032 errors during update detection are now noted in the log file.\n\ - \032 + [END] messages in log now use a briefer format\n\ - \032 + Changed the text UI startup sequence so that\n\ - \032 tt ./unison -ui text will use the default profile instead of\n\ - \032 failing.\n\ - \032 + Made some improvements to the error messages.\n\ - \032 + Added some debugging messages to remote.ml.\n\ - \n\ - \032 Changes since 2.7.7:\n\ - \032 * Incorporated, once again, a multi-threaded transport sub-system.\n\ - \032 It transfers several files at the same time, thereby making much\n\ - \032 more effective use of available network bandwidth. Unlike the\n\ - \032 earlier attempt, this time we do not rely on the native thread\n\ - \032 library of OCaml. Instead, we implement a light-weight,\n\ - \032 non-preemptive multi-thread library in OCaml directly. This\n\ - \032 version appears stable.\n\ - \032 Some adjustments to unison are made to accommodate the\n\ - \032 multi-threaded version. These include, in particular, changes to\n\ - \032 the user interface and logging, for example:\n\ - \032 + Two log entries for each transferring task, one for the\n\ - \032 beginning, one for the end.\n\ - \032 + Suppressed warning messages against removing temp files left\n\ - \032 by a previous unison run, because warning does not work\n\ - \032 nicely under multi-threading. The temp file names are made\n\ - \032 less likely to coincide with the name of a file created by\n\ - \032 the user. They take the form\n\ - \032 .#..unison.tmp. [N.b. This was later\n\ - \032 changed to .unison...unison.tmp.]\n\ - \032 * Added a new command to the GTK user interface: pressing 'f' causes\n\ - \032 Unison to start a new update detection phase, using as paths just\n\ - \032 those paths that have been detected as changed and not yet marked\n\ - \032 as successfully completed. Use this command to quickly restart\n\ - \032 Unison on just the set of paths still needing attention after a\n\ - \032 previous run.\n\ - \032 * Made the ignorecase preference user-visible, and changed the\n\ - \032 initialization code so that it can be manually set to true, even\n\ - \032 if neither host is running Windows. (This may be useful, e.g.,\n\ - \032 when using Unison running on a Unix system with a FAT volume\n\ - \032 mounted.)\n\ - \032 * Small improvements and bug fixes:\n\ - \032 + Errors in preference files now generate fatal errors rather\n\ - \032 than warnings at startup time. (I.e., you can't go on from\n\ - \032 them.) Also, we fixed a bug that was preventing these\n\ - \032 warnings from appearing in the text UI, so some users who\n\ - \032 have been running (unsuspectingly) with garbage in their\n\ - \032 prefs files may now get error reports.\n\ - \032 + Error reporting for preference files now provides file name\n\ - \032 and line number.\n\ - \032 + More intelligible message in the case of identical change to\n\ - \032 the same files: \"Nothing to do: replicas have been changed\n\ - \032 only in identical ways since last sync.\"\n\ - \032 + Files with prefix '.#' excluded when scanning for preference\n\ - \032 files.\n\ - \032 + Rsync instructions are send directly instead of first\n\ - \032 marshaled.\n\ - \032 + Won't try forever to get the fingerprint of a continuously\n\ - \032 changing file: unison will give up after certain number of\n\ - \032 retries.\n\ - \032 + Other bug fixes, including the one reported by Peter Selinger\n\ - \032 (force=older preference not working).\n\ - \032 * Compilation:\n\ - \032 + Upgraded to the new OCaml 3.04 compiler, with the LablGtk\n\ - \032 1.2.3 library (patched version used for compiling under\n\ - \032 Windows).\n\ - \032 + Added the option to compile unison on the Windows platform\n\ - \032 with Cygwin GNU C compiler. This option only supports\n\ - \032 building dynamically linked unison executables.\n\ - \n\ - \032 Changes since 2.7.4:\n\ - \032 * Fixed a silly (but debilitating) bug in the client startup\n\ - \032 sequence.\n\ - \n\ - \032 Changes since 2.7.1:\n\ - \032 * Added addprefsto preference, which (when set) controls which\n\ - \032 preference file new preferences (e.g. new ignore patterns) are\n\ - \032 added to.\n\ - \032 * Bug fix: read the initial connection header one byte at a time, so\n\ - \032 that we don't block if the header is shorter than expected. (This\n\ - \032 bug did not affect normal operation -- it just made it hard to\n\ - \032 tell when you were trying to use Unison incorrectly with an old\n\ - \032 version of the server, since it would hang instead of giving an\n\ - \032 error message.)\n\ - \n\ - \032 Changes since 2.6.59:\n\ - \032 * Changed fastcheck from a boolean to a string preference. Its legal\n\ - \032 values are yes (for a fast check), no (for a safe check), or\n\ - \032 default (for a fast check--which also happens to be safe--when\n\ - \032 running on Unix and a safe check when on Windows). The default is\n\ - \032 default.\n\ - \032 * Several preferences have been renamed for consistency. All\n\ - \032 preference names are now spelled out in lowercase. For backward\n\ - \032 compatibility, the old names still work, but they are not\n\ - \032 mentioned in the manual any more.\n\ - \032 * The temp files created by the 'diff' and 'merge' commands are now\n\ - \032 named by prepending a new prefix to the file name, rather than\n\ - \032 appending a suffix. This should avoid confusing diff/merge\n\ - \032 programs that depend on the suffix to guess the type of the file\n\ - \032 contents.\n\ - \032 * We now set the keepalive option on the server socket, to make sure\n\ - \032 that the server times out if the communication link is\n\ - \032 unexpectedly broken.\n\ - \032 * Bug fixes:\n\ - \032 + When updating small files, Unison now closes the destination\n\ - \032 file.\n\ - \032 + File permissions are properly updated when the file is behind\n\ - \032 a followed link.\n\ - \032 + Several other small fixes.\n\ - \n\ - \032 Changes since 2.6.38:\n\ - \032 * Major Windows performance improvement!\n\ - \032 We've added a preference fastcheck that makes Unison look only at\n\ - \032 a file's creation time and last-modified time to check whether it\n\ - \032 has changed. This should result in a huge speedup when checking\n\ - \032 for updates in large replicas.\n\ - \032 When this switch is set, Unison will use file creation times as\n\ - \032 'pseudo inode numbers' when scanning Windows replicas for updates,\n\ - \032 instead of reading the full contents of every file. This may cause\n\ - \032 Unison to miss propagating an update if the create time,\n\ - \032 modification time, and length of the file are all unchanged by the\n\ - \032 update (this is not easy to achieve, but it can be done). However,\n\ - \032 Unison will never overwrite such an update with a change from the\n\ - \032 other replica, since it always does a safe check for updates just\n\ - \032 before propagating a change. Thus, it is reasonable to use this\n\ - \032 switch most of the time and occasionally run Unison once with\n\ - \032 fastcheck set to false, if you are worried that Unison may have\n\ - \032 overlooked an update.\n\ - \032 Warning: This change is has not yet been thoroughly field-tested.\n\ - \032 If you set the fastcheck preference, pay careful attention to what\n\ - \032 Unison is doing.\n\ - \032 * New functionality: centralized backups and merging\n\ - \032 + This version incorporates two pieces of major new\n\ - \032 functionality, implemented by Sylvain Roy during a summer\n\ - \032 internship at Penn: a centralized backup facility that keeps\n\ - \032 a full backup of (selected files in) each replica, and a\n\ - \032 merging feature that allows Unison to invoke an external\n\ - \032 file-merging tool to resolve conflicting changes to\n\ - \032 individual files.\n\ - \032 + Centralized backups:\n\ - \032 o Unison now maintains full backups of the\n\ - \032 last-synchronized versions of (some of) the files in\n\ - \032 each replica; these function both as backups in the\n\ - \032 usual sense and as the \"common version\" when invoking\n\ - \032 external merge programs.\n\ - \032 o The backed up files are stored in a directory\n\ - \032 /.unison/backup on each host. (The name of this\n\ - \032 directory can be changed by setting the environment\n\ - \032 variable UNISONBACKUPDIR.)\n\ - \032 o The predicate backup controls which files are actually\n\ - \032 backed up: giving the preference 'backup = Path *'\n\ - \032 causes backing up of all files.\n\ - \032 o Files are added to the backup directory whenever unison\n\ - \032 updates its archive. This means that\n\ - \032 # When unison reconstructs its archive from scratch\n\ - \032 (e.g., because of an upgrade, or because the\n\ - \032 archive files have been manually deleted), all\n\ - \032 files will be backed up.\n\ - \032 # Otherwise, each file will be backed up the first\n\ - \032 time unison propagates an update for it.\n\ - \032 o The preference backupversions controls how many previous\n\ - \032 versions of each file are kept. The default is 2 (i.e.,\n\ - \032 the last synchronized version plus one backup).\n\ - \032 o For backward compatibility, the backups preference is\n\ - \032 also still supported, but backup is now preferred.\n\ - \032 o It is OK to manually delete files from the backup\n\ - \032 directory (or to throw away the directory itself).\n\ - \032 Before unison uses any of these files for anything\n\ - \032 important, it checks that its fingerprint matches the\n\ - \032 one that it expects.\n\ - \032 + Merging:\n\ - \032 o Both user interfaces offer a new 'merge' command,\n\ - \032 invoked by pressing 'm' (with a changed file selected).\n\ - \032 o The actual merging is performed by an external program.\n\ - \032 The preferences merge and merge2 control how this\n\ - \032 program is invoked. If a backup exists for this file\n\ - \032 (see the backup preference), then the merge preference\n\ - \032 is used for this purpose; otherwise merge2 is used. In\n\ - \032 both cases, the value of the preference should be a\n\ - \032 string representing the command that should be passed to\n\ - \032 a shell to invoke the merge program. Within this string,\n\ - \032 the special substrings CURRENT1, CURRENT2, NEW, and OLD\n\ - \032 may appear at any point. Unison will substitute these as\n\ - \032 follows before invoking the command:\n\ - \032 # CURRENT1 is replaced by the name of the local copy\n\ - \032 of the file;\n\ - \032 # CURRENT2 is replaced by the name of a temporary\n\ - \032 file, into which the contents of the remote copy of\n\ - \032 the file have been transferred by Unison prior to\n\ - \032 performing the merge;\n\ - \032 # NEW is replaced by the name of a temporary file\n\ - \032 that Unison expects to be written by the merge\n\ - \032 program when it finishes, giving the desired new\n\ - \032 contents of the file; and\n\ - \032 # OLD is replaced by the name of the backed up copy\n\ - \032 of the original version of the file (i.e., its\n\ - \032 state at the end of the last successful run of\n\ - \032 Unison), if one exists (applies only to merge, not\n\ - \032 merge2).\n\ - \032 For example, on Unix systems setting the merge\n\ - \032 preference to\n\ - \032 merge = diff3 -m CURRENT1 OLD CURRENT2 > NEW\n\ - \032 will tell Unison to use the external diff3 program for\n\ - \032 merging.\n\ - \032 A large number of external merging programs are\n\ - \032 available. For example, emacs users may find the\n\ - \032 following convenient:\n\ - \032 merge2 = emacs -q --eval '(ediff-merge-files \"CURRENT1\" \"CURRENT2\"\n\ - \032 nil \"NEW\")'\n\ - \032 merge = emacs -q --eval '(ediff-merge-files-with-ancestor\n\ - \032 \"CURRENT1\" \"CURRENT2\" \"OLD\" nil \"NEW\")'\n\ - \032 (These commands are displayed here on two lines to avoid\n\ - \032 running off the edge of the page. In your preference\n\ - \032 file, each should be written on a single line.)\n\ - \032 o If the external program exits without leaving any file\n\ - \032 at the path NEW, Unison considers the merge to have\n\ - \032 failed. If the merge program writes a file called NEW\n\ - \032 but exits with a non-zero status code, then Unison\n\ - \032 considers the merge to have succeeded but to have\n\ - \032 generated conflicts. In this case, it attempts to invoke\n\ - \032 an external editor so that the user can resolve the\n\ - \032 conflicts. The value of the editor preference controls\n\ - \032 what editor is invoked by Unison. The default is emacs.\n\ - \032 o Please send us suggestions for other useful values of\n\ - \032 the merge2 and merge preferences - we'd like to give\n\ - \032 several examples in the manual.\n\ - \032 * Smaller changes:\n\ - \032 + When one preference file includes another, unison no longer\n\ - \032 adds the suffix '.prf' to the included file by default. If a\n\ - \032 file with precisely the given name exists in the .unison\n\ - \032 directory, it will be used; otherwise Unison will add .prf,\n\ - \032 as it did before. (This change means that included preference\n\ - \032 files can be named blah.include instead of blah.prf, so that\n\ - \032 unison will not offer them in its 'choose a preference file'\n\ - \032 dialog.)\n\ - \032 + For Linux systems, we now offer both a statically linked and\n\ - \032 a dynamically linked executable. The static one is larger,\n\ - \032 but will probably run on more systems, since it doesn't\n\ - \032 depend on the same versions of dynamically linked library\n\ - \032 modules being available.\n\ - \032 + Fixed the force and prefer preferences, which were getting\n\ - \032 the propagation direction exactly backwards.\n\ - \032 + Fixed a bug in the startup code that would cause unison to\n\ - \032 crash when the default profile (~/.unison/default.prf) does\n\ - \032 not exist.\n\ - \032 + Fixed a bug where, on the run when a profile is first\n\ - \032 created, Unison would confusingly display the roots in\n\ - \032 reverse order in the user interface.\n\ - \032 * For developers:\n\ - \032 + We've added a module dependency diagram to the source\n\ - \032 distribution, in src/DEPENDENCIES.ps, to help new prospective\n\ - \032 developers with navigating the code.\n\ - \n\ - \032 Changes since 2.6.11:\n\ - \032 * INCOMPATIBLE CHANGE: Archive format has changed.\n\ - \032 * INCOMPATIBLE CHANGE: The startup sequence has been completely\n\ - \032 rewritten and greatly simplified. The main user-visible change is\n\ - \032 that the defaultpath preference has been removed. Its effect can\n\ - \032 be approximated by using multiple profiles, with include\n\ - \032 directives to incorporate common settings. All uses of defaultpath\n\ - \032 in existing profiles should be changed to path.\n\ - \032 Another change in startup behavior that will affect some users is\n\ - \032 that it is no longer possible to specify roots both in the profile\n\ - \032 and on the command line.\n\ - \032 You can achieve a similar effect, though, by breaking your profile\n\ - \032 into two:\n\ - \n\ - \032 default.prf =\n\ - \032 root = blah\n\ - \032 root = foo\n\ - \032 include common\n\ - \n\ - \032 common.prf =\n\ - \032 \n\ - \032 Now do\n\ - \032 unison common root1 root2\n\ - \032 when you want to specify roots explicitly.\n\ - \032 * The -prefer and -force options have been extended to allow users\n\ - \032 to specify that files with more recent modtimes should be\n\ - \032 propagated, writing either -prefer newer or -force newer. (For\n\ - \032 symmetry, Unison will also accept -prefer older or -force older.)\n\ - \032 The -force older/newer options can only be used when -times is\n\ - \032 also set.\n\ - \032 The graphical user interface provides access to these facilities\n\ - \032 on a one-off basis via the Actions menu.\n\ - \032 * Names of roots can now be \"aliased\" to allow replicas to be\n\ - \032 relocated without changing the name of the archive file where\n\ - \032 Unison stores information between runs. (This feature is for\n\ - \032 experts only. See the \"Archive Files\" section of the manual for\n\ - \032 more information.)\n\ - \032 * Graphical user-interface:\n\ - \032 + A new command is provided in the Synchronization menu for\n\ - \032 switching to a new profile without restarting Unison from\n\ - \032 scratch.\n\ - \032 + The GUI also supports one-key shortcuts for commonly used\n\ - \032 profiles. If a profile contains a preference of the form 'key\n\ - \032 = n', where n is a single digit, then pressing this key will\n\ - \032 cause Unison to immediately switch to this profile and begin\n\ - \032 synchronization again from scratch. (Any actions that may\n\ - \032 have been selected for a set of changes currently being\n\ - \032 displayed will be discarded.)\n\ - \032 + Each profile may include a preference 'label = '\n\ - \032 giving a descriptive string that described the options\n\ - \032 selected in this profile. The string is listed along with the\n\ - \032 profile name in the profile selection dialog, and displayed\n\ - \032 in the top-right corner of the main Unison window.\n\ - \032 * Minor:\n\ - \032 + Fixed a bug that would sometimes cause the 'diff' display to\n\ - \032 order the files backwards relative to the main user\n\ - \032 interface. (Thanks to Pascal Brisset for this fix.)\n\ - \032 + On Unix systems, the graphical version of Unison will check\n\ - \032 the DISPLAY variable and, if it is not set, automatically\n\ - \032 fall back to the textual user interface.\n\ - \032 + Synchronization paths (path preferences) are now matched\n\ - \032 against the ignore preferences. So if a path is both\n\ - \032 specified in a path preference and ignored, it will be\n\ - \032 skipped.\n\ - \032 + Numerous other bugfixes and small improvements.\n\ - \n\ - \032 Changes since 2.6.1:\n\ - \032 * The synchronization of modification times has been disabled for\n\ - \032 directories.\n\ - \032 * Preference files may now include lines of the form include ,\n\ - \032 which will cause name.prf to be read at that point.\n\ - \032 * The synchronization of permission between Windows and Unix now\n\ - \032 works properly.\n\ - \032 * A binding CYGWIN=binmode in now added to the environment so that\n\ - \032 the Cygwin port of OpenSSH works properly in a non-Cygwin context.\n\ - \032 * The servercmd and addversionno preferences can now be used\n\ - \032 together: -addversionno appends an appropriate -NNN to the server\n\ - \032 command, which is found by using the value of the -servercmd\n\ - \032 preference if there is one, or else just unison.\n\ - \032 * Both '-pref=val' and '-pref val' are now allowed for boolean\n\ - \032 values. (The former can be used to set a preference to false.)\n\ - \032 * Lot of small bugs fixed.\n\ - \n\ - \032 Changes since 2.5.31:\n\ - \032 * The log preference is now set to true by default, since the log\n\ - \032 file seems useful for most users.\n\ - \032 * Several miscellaneous bugfixes (most involving symlinks).\n\ - \n\ - \032 Changes since 2.5.25:\n\ - \032 * INCOMPATIBLE CHANGE: Archive format has changed (again).\n\ - \032 * Several significant bugs introduced in 2.5.25 have been fixed.\n\ - \n\ - \032 Changes since 2.5.1:\n\ - \032 * INCOMPATIBLE CHANGE: Archive format has changed. Make sure you\n\ - \032 synchronize your replicas before upgrading, to avoid spurious\n\ - \032 conflicts. The first sync after upgrading will be slow.\n\ - \032 * New functionality:\n\ - \032 + Unison now synchronizes file modtimes, user-ids, and\n\ - \032 group-ids.\n\ - \032 These new features are controlled by a set of new\n\ - \032 preferences, all of which are currently false by default.\n\ - \032 o When the times preference is set to true, file\n\ - \032 modification times are propaged. (Because the\n\ - \032 representations of time may not have the same\n\ - \032 granularity on both replicas, Unison may not always be\n\ - \032 able to make the modtimes precisely equal, but it will\n\ - \032 get them as close as the operating systems involved\n\ - \032 allow.)\n\ - \032 o When the owner preference is set to true, file ownership\n\ - \032 information is synchronized.\n\ - \032 o When the group preference is set to true, group\n\ - \032 information is synchronized.\n\ - \032 o When the numericIds preference is set to true, owner and\n\ - \032 group information is synchronized numerically. By\n\ - \032 default, owner and group numbers are converted to names\n\ - \032 on each replica and these names are synchronized. (The\n\ - \032 special user id 0 and the special group 0 are never\n\ - \032 mapped via user/group names even if this preference is\n\ - \032 not set.)\n\ - \032 + Added an integer-valued preference perms that can be used to\n\ - \032 control the propagation of permission bits. The value of this\n\ - \032 preference is a mask indicating which permission bits should\n\ - \032 be synchronized. It is set by default to 0o1777: all bits but\n\ - \032 the set-uid and set-gid bits are synchronised (synchronizing\n\ - \032 theses latter bits can be a security hazard). If you want to\n\ - \032 synchronize all bits, you can set the value of this\n\ - \032 preference to -1.\n\ - \032 + Added a log preference (default false), which makes Unison\n\ - \032 keep a complete record of the changes it makes to the\n\ - \032 replicas. By default, this record is written to a file called\n\ - \032 unison.log in the user's home directory (the value of the\n\ - \032 HOME environment variable). If you want it someplace else,\n\ - \032 set the logfile preference to the full pathname you want\n\ - \032 Unison to use.\n\ - \032 + Added an ignorenot preference that maintains a set of\n\ - \032 patterns for paths that should definitely not be ignored,\n\ - \032 whether or not they match an ignore pattern. (That is, a path\n\ - \032 will now be ignored iff it matches an ignore pattern and does\n\ - \032 not match any ignorenot patterns.)\n\ - \032 * User-interface improvements:\n\ - \032 + Roots are now displayed in the user interface in the same\n\ - \032 order as they were given on the command line or in the\n\ - \032 preferences file.\n\ - \032 + When the batch preference is set, the graphical user\n\ - \032 interface no longer waits for user confirmation when it\n\ - \032 displays a warning message: it simply pops up an advisory\n\ - \032 window with a Dismiss button at the bottom and keeps on\n\ - \032 going.\n\ - \032 + Added a new preference for controlling how many status\n\ - \032 messages are printed during update detection: statusdepth\n\ - \032 controls the maximum depth for paths on the local machine\n\ - \032 (longer paths are not displayed, nor are non-directory\n\ - \032 paths). The value should be an integer; default is 1.\n\ - \032 + Removed the trace and silent preferences. They did not seem\n\ - \032 very useful, and there were too many preferences for\n\ - \032 controlling output in various ways.\n\ - \032 + The text UI now displays just the default command (the one\n\ - \032 that will be used if the user just types ) instead of\n\ - \032 all available commands. Typing ? will print the full list of\n\ - \032 possibilities.\n\ - \032 + The function that finds the canonical hostname of the local\n\ - \032 host (which is used, for example, in calculating the name of\n\ - \032 the archive file used to remember which files have been\n\ - \032 synchronized) normally uses the gethostname operating system\n\ - \032 call. However, if the environment variable\n\ - \032 UNISONLOCALHOSTNAME is set, its value will now be used\n\ - \032 instead. This makes it easier to use Unison in situations\n\ - \032 where a machine's name changes frequently (e.g., because it\n\ - \032 is a laptop and gets moved around a lot).\n\ - \032 + File owner and group are now displayed in the \"detail window\"\n\ - \032 at the bottom of the screen, when unison is configured to\n\ - \032 synchronize them.\n\ - \032 * For hackers:\n\ - \032 + Updated to Jacques Garrigue's new version of lablgtk, which\n\ - \032 means we can throw away our local patched version.\n\ - \032 If you're compiling the GTK version of unison from sources,\n\ - \032 you'll need to update your copy of lablgtk to the developers\n\ - \032 release. (Warning: installing lablgtk under Windows is\n\ - \032 currently a bit challenging.)\n\ - \032 + The TODO.txt file (in the source distribution) has been\n\ - \032 cleaned up and reorganized. The list of pending tasks should\n\ - \032 be much easier to make sense of, for people that may want to\n\ - \032 contribute their programming energies. There is also a\n\ - \032 separate file BUGS.txt for open bugs.\n\ - \032 + The Tk user interface has been removed (it was not being\n\ - \032 maintained and no longer compiles).\n\ - \032 + The debug preference now prints quite a bit of additional\n\ - \032 information that should be useful for identifying sources of\n\ - \032 problems.\n\ - \032 + The version number of the remote server is now checked right\n\ - \032 away during the connection setup handshake, rather than\n\ - \032 later. (Somebody sent a bug report of a server crash that\n\ - \032 turned out to come from using inconsistent versions: better\n\ - \032 to check this earlier and in a way that can't crash either\n\ - \032 client or server.)\n\ - \032 + Unison now runs correctly on 64-bit architectures (e.g. Alpha\n\ - \032 linux). We will not be distributing binaries for these\n\ - \032 architectures ourselves (at least for a while) but if someone\n\ - \032 would like to make them available, we'll be glad to provide a\n\ - \032 link to them.\n\ - \032 * Bug fixes:\n\ - \032 + Pattern matching (e.g. for ignore) is now case-insensitive\n\ - \032 when Unison is in case-insensitive mode (i.e., when one of\n\ - \032 the replicas is on a windows machine).\n\ - \032 + Some people had trouble with mysterious failures during\n\ - \032 propagation of updates, where files would be falsely reported\n\ - \032 as having changed during synchronization. This should be\n\ - \032 fixed.\n\ - \032 + Numerous smaller fixes.\n\ - \n\ - \032 Changes since 2.4.1:\n\ - \032 * Added a number of 'sorting modes' for the user interface. By\n\ - \032 default, conflicting changes are displayed at the top, and the\n\ - \032 rest of the entries are sorted in alphabetical order. This\n\ - \032 behavior can be changed in the following ways:\n\ - \032 + Setting the sortnewfirst preference to true causes newly\n\ - \032 created files to be displayed before changed files.\n\ - \032 + Setting sortbysize causes files to be displayed in increasing\n\ - \032 order of size.\n\ - \032 + Giving the preference sortfirst= (where is\n\ - \032 a path descriptor in the same format as 'ignore' and 'follow'\n\ - \032 patterns, causes paths matching this pattern to be displayed\n\ - \032 first.\n\ - \032 + Similarly, giving the preference sortlast= causes\n\ - \032 paths matching this pattern to be displayed last.\n\ - \032 The sorting preferences are described in more detail in the user\n\ - \032 manual. The sortnewfirst and sortbysize flags can also be accessed\n\ - \032 from the 'Sort' menu in the grpahical user interface.\n\ - \032 * Added two new preferences that can be used to change unison's\n\ - \032 fundamental behavior to make it more like a mirroring tool instead\n\ - \032 of a synchronizer.\n\ - \032 + Giving the preference prefer with argument (by adding\n\ - \032 -prefer to the command line or prefer=) to your\n\ - \032 profile) means that, if there is a conflict, the contents of\n\ - \032 should be propagated to the other replica (with no\n\ - \032 questions asked). Non-conflicting changes are treated as\n\ - \032 usual.\n\ - \032 + Giving the preference force with argument will make\n\ - \032 unison resolve all differences in favor of the given root,\n\ - \032 even if it was the other replica that was changed.\n\ - \032 These options should be used with care! (More information is\n\ - \032 available in the manual.)\n\ - \032 * Small changes:\n\ - \032 + Changed default answer to 'Yes' in all two-button dialogs in\n\ - \032 the graphical interface (this seems more intuitive).\n\ - \032 + The rsync preference has been removed (it was used to\n\ - \032 activate rsync compression for file transfers, but rsync\n\ - \032 compression is now enabled by default).\n\ - \032 + In the text user interface, the arrows indicating which\n\ - \032 direction changes are being propagated are printed\n\ - \032 differently when the user has overridded Unison's default\n\ - \032 recommendation (====> instead of ---->). This matches the\n\ - \032 behavior of the graphical interface, which displays such\n\ - \032 arrows in a different color.\n\ - \032 + Carriage returns (Control-M's) are ignored at the ends of\n\ - \032 lines in profiles, for Windows compatibility.\n\ - \032 + All preferences are now fully documented in the user manual.\n\ - \n\ - \032 Changes since 2.3.12:\n\ - \032 * INCOMPATIBLE CHANGE: Archive format has changed. Make sure you\n\ - \032 synchronize your replicas before upgrading, to avoid spurious\n\ - \032 conflicts. The first sync after upgrading will be slow.\n\ - \032 * New/improved functionality:\n\ - \032 + A new preference -sortbysize controls the order in which\n\ - \032 changes are displayed to the user: when it is set to true,\n\ - \032 the smallest changed files are displayed first. (The default\n\ - \032 setting is false.)\n\ - \032 + A new preference -sortnewfirst causes newly created files to\n\ - \032 be listed before other updates in the user interface.\n\ - \032 + We now allow the ssh protocol to specify a port.\n\ - \032 + Incompatible change: The unison: protocol is deprecated, and\n\ - \032 we added file: and socket:. You may have to modify your\n\ - \032 profiles in the .unison directory. If a replica is specified\n\ - \032 without an explicit protocol, we now assume it refers to a\n\ - \032 file. (Previously \"//saul/foo\" meant to use SSH to connect to\n\ - \032 saul, then access the foo directory. Now it means to access\n\ - \032 saul via a remote file mechanism such as samba; the old\n\ - \032 effect is now achieved by writing ssh://saul/foo.)\n\ - \032 + Changed the startup sequence for the case where roots are\n\ - \032 given but no profile is given on the command line. The new\n\ - \032 behavior is to use the default profile (creating it if it\n\ - \032 does not exist), and temporarily override its roots. The\n\ - \032 manual claimed that this case would work by reading no\n\ - \032 profile at all, but AFAIK this was never true.\n\ - \032 + In all user interfaces, files with conflicts are always\n\ - \032 listed first\n\ - \032 + A new preference 'sshversion' can be used to control which\n\ - \032 version of ssh should be used to connect to the server. Legal\n\ - \032 values are 1 and 2. (Default is empty, which will make unison\n\ - \032 use whatever version of ssh is installed as the default 'ssh'\n\ - \032 command.)\n\ - \032 + The situation when the permissions of a file was updated the\n\ - \032 same on both side is now handled correctly (we used to report\n\ - \032 a spurious conflict)\n\ - \032 * Improvements for the Windows version:\n\ - \032 + The fact that filenames are treated case-insensitively under\n\ - \032 Windows should now be handled correctly. The exact behavior\n\ - \032 is described in the cross-platform section of the manual.\n\ - \032 + It should be possible to synchronize with Windows shares,\n\ - \032 e.g., //host/drive/path.\n\ - \032 + Workarounds to the bug in syncing root directories in\n\ - \032 Windows. The most difficult thing to fix is an ocaml bug:\n\ - \032 Unix.opendir fails on c: in some versions of Windows.\n\ - \032 * Improvements to the GTK user interface (the Tk interface is no\n\ - \032 longer being maintained):\n\ - \032 + The UI now displays actions differently (in blue) when they\n\ - \032 have been explicitly changed by the user from Unison's\n\ - \032 default recommendation.\n\ - \032 + More colorful appearance.\n\ - \032 + The initial profile selection window works better.\n\ - \032 + If any transfers failed, a message to this effect is\n\ - \032 displayed along with 'Synchronization complete' at the end of\n\ - \032 the transfer phase (in case they may have scrolled off the\n\ - \032 top).\n\ - \032 + Added a global progress meter, displaying the percentage of\n\ - \032 total bytes that have been transferred so far.\n\ - \032 * Improvements to the text user interface:\n\ - \032 + The file details will be displayed automatically when a\n\ - \032 conflict is been detected.\n\ - \032 + when a warning is generated (e.g. for a temporary file left\n\ - \032 over from a previous run of unison) Unison will no longer\n\ - \032 wait for a response if it is running in -batch mode.\n\ - \032 + The UI now displays a short list of possible inputs each time\n\ - \032 it waits for user interaction.\n\ - \032 + The UI now quits immediately (rather than looping back and\n\ - \032 starting the interaction again) if the user presses 'q' when\n\ - \032 asked whether to propagate changes.\n\ - \032 + Pressing 'g' in the text user interface will proceed\n\ - \032 immediately with propagating updates, without asking any more\n\ - \032 questions.\n\ - \032 * Documentation and installation changes:\n\ - \032 + The manual now includes a FAQ, plus sections on common\n\ - \032 problems and on tricks contributed by users.\n\ - \032 + Both the download page and the download directory explicitly\n\ - \032 say what are the current stable and beta-test version\n\ - \032 numbers.\n\ - \032 + The OCaml sources for the up-to-the-minute developers'\n\ - \032 version (not guaranteed to be stable, or even to compile, at\n\ - \032 any given time!) are now available from the download page.\n\ - \032 + Added a subsection to the manual describing cross-platform\n\ - \032 issues (case conflicts, illegal filenames)\n\ - \032 * Many small bug fixes and random improvements.\n\ - \n\ - \032 Changes since 2.3.1:\n\ - \032 * Several bug fixes. The most important is a bug in the rsync module\n\ - \032 that would occasionally cause change propagation to fail with a\n\ - \032 'rename' error.\n\ - \n\ - \032 Changes since 2.2:\n\ - \032 * The multi-threaded transport system is now disabled by default.\n\ - \032 (It is not stable enough yet.)\n\ - \032 * Various bug fixes.\n\ - \032 * A new experimental feature:\n\ - \032 The final component of a -path argument may now be the wildcard\n\ - \032 specifier *. When Unison sees such a path, it expands this path on\n\ - \032 the client into into the corresponding list of paths by listing\n\ - \032 the contents of that directory.\n\ - \032 Note that if you use wildcard paths from the command line, you\n\ - \032 will probably need to use quotes or a backslash to prevent the *\n\ - \032 from being interpreted by your shell.\n\ - \032 If both roots are local, the contents of the first one will be\n\ - \032 used for expanding wildcard paths. (Nb: this is the first one\n\ - \032 after the canonization step - i.e., the one that is listed first\n\ - \032 in the user interface - not the one listed first on the command\n\ - \032 line or in the preferences file.)\n\ - \n\ - \032 Changes since 2.1:\n\ - \032 * The transport subsystem now includes an implementation by Sylvain\n\ - \032 Gommier and Norman Ramsey of Tridgell and Mackerras's rsync\n\ - \032 protocol. This protocol achieves much faster transfers when only a\n\ - \032 small part of a large file has been changed by sending just diffs.\n\ - \032 This feature is mainly helpful for transfers over slow links--on\n\ - \032 fast local area networks it can actually degrade performance--so\n\ - \032 we have left it off by default. Start unison with the -rsync\n\ - \032 option (or put rsync=true in your preferences file) to turn it on.\n\ - \032 * \"Progress bars\" are now diplayed during remote file transfers,\n\ - \032 showing what percentage of each file has been transferred so far.\n\ - \032 * The version numbering scheme has changed. New releases will now be\n\ - \032 have numbers like 2.2.30, where the second component is\n\ - \032 incremented on every significant public release and the third\n\ - \032 component is the \"patch level.\"\n\ - \032 * Miscellaneous improvements to the GTK-based user interface.\n\ - \032 * The manual is now available in PDF format.\n\ - \032 * We are experimenting with using a multi-threaded transport\n\ - \032 subsystem to transfer several files at the same time, making much\n\ - \032 more effective use of available network bandwidth. This feature is\n\ - \032 not completely stable yet, so by default it is disabled in the\n\ - \032 release version of Unison.\n\ - \032 If you want to play with the multi-threaded version, you'll need\n\ - \032 to recompile Unison from sources (as described in the\n\ - \032 documentation), setting the THREADS flag in Makefile.OCaml to\n\ - \032 true. Make sure that your OCaml compiler has been installed with\n\ - \032 the -with-pthreads configuration option. (You can verify this by\n\ - \032 checking whether the file threads/threads.cma in the OCaml\n\ - \032 standard library directory contains the string -lpthread near the\n\ - \032 end.)\n\ - \n\ - \032 Changes since 1.292:\n\ - \032 * Reduced memory footprint (this is especially important during the\n\ - \032 first run of unison, where it has to gather information about all\n\ - \032 the files in both repositories).\n\ - \032 * Fixed a bug that would cause the socket server under NT to fail\n\ - \032 after the client exits.\n\ - \032 * Added a SHIFT modifier to the Ignore menu shortcut keys in GTK\n\ - \032 interface (to avoid hitting them accidentally).\n\ - \n\ - \032 Changes since 1.231:\n\ - \032 * Tunneling over ssh is now supported in the Windows version. See\n\ - \032 the installation section of the manual for detailed instructions.\n\ - \032 * The transport subsystem now includes an implementation of the\n\ - \032 rsync protocol, built by Sylvain Gommier and Norman Ramsey. This\n\ - \032 protocol achieves much faster transfers when only a small part of\n\ - \032 a large file has been changed by sending just diffs. The rsync\n\ - \032 feature is off by default in the current version. Use the -rsync\n\ - \032 switch to turn it on. (Nb. We still have a lot of tuning to do:\n\ - \032 you may not notice much speedup yet.)\n\ - \032 * We're experimenting with a multi-threaded transport subsystem,\n\ - \032 written by Jerome Vouillon. The downloadable binaries are still\n\ - \032 single-threaded: if you want to try the multi-threaded version,\n\ - \032 you'll need to recompile from sources. (Say make THREADS=true.)\n\ - \032 Native thread support from the compiler is required. Use the\n\ - \032 option -threads N to select the maximal number of concurrent\n\ - \032 threads (default is 5). Multi-threaded and single-threaded\n\ - \032 clients/servers can interoperate.\n\ - \032 * A new GTK-based user interface is now available, thanks to Jacques\n\ - \032 Garrigue. The Tk user interface still works, but we'll be shifting\n\ - \032 development effort to the GTK interface from now on.\n\ - \032 * OCaml 3.00 is now required for compiling Unison from sources. The\n\ - \032 modules uitk and myfileselect have been changed to use labltk\n\ - \032 instead of camltk. To compile the Tk interface in Windows, you\n\ - \032 must have ocaml-3.00 and tk8.3. When installing tk8.3, put it in\n\ - \032 c:\\Tcl rather than the suggested c:\\Program Files\\Tcl, and be sure\n\ - \032 to install the headers and libraries (which are not installed by\n\ - \032 default).\n\ - \032 * Added a new -addversionno switch, which causes unison to use\n\ - \032 unison- instead of just unison as the remote\n\ - \032 server command. This allows multiple versions of unison to coexist\n\ - \032 conveniently on the same server: whichever version is run on the\n\ - \032 client, the same version will be selected on the server.\n\ - \n\ - \032 Changes since 1.219:\n\ - \032 * INCOMPATIBLE CHANGE: Archive format has changed. Make sure you\n\ - \032 synchronize your replicas before upgrading, to avoid spurious\n\ - \032 conflicts. The first sync after upgrading will be slow.\n\ - \032 * This version fixes several annoying bugs, including:\n\ - \032 + Some cases where propagation of file permissions was not\n\ - \032 working.\n\ - \032 + umask is now ignored when creating directories\n\ - \032 + directories are create writable, so that a read-only\n\ - \032 directory and its contents can be propagated.\n\ - \032 + Handling of warnings generated by the server.\n\ - \032 + Synchronizing a path whose parent is not a directory on both\n\ - \032 sides is now flagged as erroneous.\n\ - \032 + Fixed some bugs related to symnbolic links and nonexistant\n\ - \032 roots.\n\ - \032 o When a change (deletion or new contents) is propagated\n\ - \032 onto a 'follow'ed symlink, the file pointed to by the\n\ - \032 link is now changed. (We used to change the link itself,\n\ - \032 which doesn't fit our assertion that 'follow' means the\n\ - \032 link is completely invisible)\n\ - \032 o When one root did not exist, propagating the other root\n\ - \032 on top of it used to fail, becuase unison could not\n\ - \032 calculate the working directory into which to write\n\ - \032 changes. This should be fixed.\n\ - \032 * A human-readable timestamp has been added to Unison's archive\n\ - \032 files.\n\ - \032 * The semantics of Path and Name regular expressions now correspond\n\ - \032 better.\n\ - \032 * Some minor improvements to the text UI (e.g. a command for going\n\ - \032 back to previous items)\n\ - \032 * The organization of the export directory has changed -- should be\n\ - \032 easier to find / download things now.\n\ - \n\ - \032 Changes since 1.200:\n\ - \032 * INCOMPATIBLE CHANGE: Archive format has changed. Make sure you\n\ - \032 synchronize your replicas before upgrading, to avoid spurious\n\ - \032 conflicts. The first sync after upgrading will be slow.\n\ - \032 * This version has not been tested extensively on Windows.\n\ - \032 * Major internal changes designed to make unison safer to run at the\n\ - \032 same time as the replicas are being changed by the user.\n\ - \032 * Internal performance improvements.\n\ - \n\ - \032 Changes since 1.190:\n\ - \032 * INCOMPATIBLE CHANGE: Archive format has changed. Make sure you\n\ - \032 synchronize your replicas before upgrading, to avoid spurious\n\ - \032 conflicts. The first sync after upgrading will be slow.\n\ - \032 * A number of internal functions have been changed to reduce the\n\ - \032 amount of memory allocation, especially during the first\n\ - \032 synchronization. This should help power users with very big\n\ - \032 replicas.\n\ - \032 * Reimplementation of low-level remote procedure call stuff, in\n\ - \032 preparation for adding rsync-like smart file transfer in a later\n\ - \032 release.\n\ - \032 * Miscellaneous bug fixes.\n\ - \n\ - \032 Changes since 1.180:\n\ - \032 * INCOMPATIBLE CHANGE: Archive format has changed. Make sure you\n\ - \032 synchronize your replicas before upgrading, to avoid spurious\n\ - \032 conflicts. The first sync after upgrading will be slow.\n\ - \032 * Fixed some small bugs in the interpretation of ignore patterns.\n\ - \032 * Fixed some problems that were preventing the Windows version from\n\ - \032 working correctly when click-started.\n\ - \032 * Fixes to treatment of file permissions under Windows, which were\n\ - \032 causing spurious reports of different permissions when\n\ - \032 synchronizing between windows and unix systems.\n\ - \032 * Fixed one more non-tail-recursive list processing function, which\n\ - \032 was causing stack overflows when synchronizing very large\n\ - \032 replicas.\n\ - \n\ - \032 Changes since 1.169:\n\ - \032 * The text user interface now provides commands for ignoring files.\n\ - \032 * We found and fixed some more non-tail-recursive list processing\n\ - \032 functions. Some power users have reported success with very large\n\ - \032 replicas.\n\ - \032 * INCOMPATIBLE CHANGE: Files ending in .tmp are no longer ignored\n\ - \032 automatically. If you want to ignore such files, put an\n\ - \032 appropriate ignore pattern in your profile.\n\ - \032 * INCOMPATIBLE CHANGE: The syntax of ignore and follow patterns has\n\ - \032 changed. Instead of putting a line of the form\n\ - \032 ignore = \n\ - \032 in your profile (.unison/default.prf), you should put:\n\ - \032 ignore = Regexp \n\ - \032 Moreover, two other styles of pattern are also recognized:\n\ - \032 ignore = Name \n\ - \032 matches any path in which one component matches , while\n\ - \032 ignore = Path \n\ - \032 matches exactly the path .\n\ - \032 Standard \"globbing\" conventions can be used in and :\n\ - \032 + a ? matches any single character except /\n\ - \032 + a * matches any sequence of characters not including /\n\ - \032 + [xyz] matches any character from the set {x, y, z }\n\ - \032 + {a,bb,ccc} matches any one of a, bb, or ccc.\n\ - \032 See the user manual for some examples.\n\ - \n\ - \032 Changes since 1.146:\n\ - \032 * Some users were reporting stack overflows when synchronizing huge\n\ - \032 directories. We found and fixed some non-tail-recursive list\n\ - \032 processing functions, which we hope will solve the problem. Please\n\ - \032 give it a try and let us know.\n\ - \032 * Major additions to the documentation.\n\ - \n\ - \032 Changes since 1.142:\n\ - \032 * Major internal tidying and many small bugfixes.\n\ - \032 * Major additions to the user manual.\n\ - \032 * Unison can now be started with no arguments - it will prompt\n\ - \032 automatically for the name of a profile file containing the roots\n\ - \032 to be synchronized. This makes it possible to start the graphical\n\ - \032 UI from a desktop icon.\n\ - \032 * Fixed a small bug where the text UI on NT was raising a 'no such\n\ - \032 signal' exception.\n\ - \n\ - \032 Changes since 1.139:\n\ - \032 * The precompiled windows binary in the last release was compiled\n\ - \032 with an old OCaml compiler, causing propagation of permissions not\n\ - \032 to work (and perhaps leading to some other strange behaviors we've\n\ - \032 heard reports about). This has been corrected. If you're using\n\ - \032 precompiled binaries on Windows, please upgrade.\n\ - \032 * Added a -debug command line flag, which controls debugging of\n\ - \032 various modules. Say -debug XXX to enable debug tracing for module\n\ - \032 XXX, or -debug all to turn on absolutely everything.\n\ - \032 * Fixed a small bug where the text UI on NT was raising a 'no such\n\ - \032 signal' exception.\n\ - \n\ - \032 Changes since 1.111:\n\ - \032 * INCOMPATIBLE CHANGE: The names and formats of the preference files\n\ - \032 in the .unison directory have changed. In particular:\n\ - \032 + the file \"prefs\" should be renamed to default.prf\n\ - \032 + the contents of the file \"ignore\" should be merged into\n\ - \032 default.prf. Each line of the form REGEXP in ignore should\n\ - \032 become a line of the form ignore = REGEXP in default.prf.\n\ - \032 * Unison now handles permission bits and symbolic links. See the\n\ - \032 manual for details.\n\ - \032 * You can now have different preference files in your .unison\n\ - \032 directory. If you start unison like this\n\ - \032 unison profilename\n\ - \032 (i.e. with just one \"anonymous\" command-line argument), then the\n\ - \032 file ~/.unison/profilename.prf will be loaded instead of\n\ - \032 default.prf.\n\ - \032 * Some improvements to terminal handling in the text user interface\n\ - \032 * Added a switch -killServer that terminates the remote server\n\ - \032 process when the unison client is shutting down, even when using\n\ - \032 sockets for communication. (By default, a remote server created\n\ - \032 using ssh/rsh is terminated automatically, while a socket server\n\ - \032 is left running.)\n\ - \032 * When started in 'socket server' mode, unison prints 'server\n\ - \032 started' on stderr when it is ready to accept connections. (This\n\ - \032 may be useful for scripts that want to tell when a socket-mode\n\ - \032 server has finished initalization.)\n\ - \032 * We now make a nightly mirror of our current internal development\n\ - \032 tree, in case anyone wants an up-to-the-minute version to hack\n\ - \032 around with.\n\ - \032 * Added a file CONTRIB with some suggestions for how to help us make\n\ - \032 Unison better.\n\ - \n\ - ")) -:: - ("", ("Junk", - "Junk\n\ - \032 _________________________________________________________________\n\ - \n\ - \032 This document was translated from L^AT[E]X by [2]H^EV^EA.\n\ - \n\ - References\n\ - \n\ - \032 1. file://localhost/Users/bcpierce/current/unison/trunk/doc/temp.html#ssh-win\n\ - \032 2. http://pauillac.inria.fr/~maranget/hevea/index.html\n\ - ")) -:: - [];; - Copied: branches/2.32/src/strings.ml (from rev 321, trunk/src/strings.ml) =================================================================== --- branches/2.32/src/strings.ml (rev 0) +++ branches/2.32/src/strings.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,4044 @@ +(* DO NOT MODIFY. + This file has been automatically generated, see docs.ml. *) + +let docs = + ("about", ("About Unison", + "Unison File Synchronizer\n\ + Version 2.32.7\n\ + \n\ + ")) +:: + ("", ("Overview", + "Overview\n\ + \n\ + \032 Unison is a file-synchronization tool for Unix and Windows. It allows\n\ + \032 two replicas of a collection of files and directories to be stored on\n\ + \032 different hosts (or different disks on the same host), modified\n\ + \032 separately, and then brought up to date by propagating the changes in\n\ + \032 each replica to the other.\n\ + \n\ + \032 Unison shares a number of features with tools such as configuration\n\ + \032 management packages (CVS (http://www.cyclic.com/), PRCS\n\ + \032 (http://www.XCF.Berkeley.EDU/~jmacd/prcs.html), etc.), distributed\n\ + \032 filesystems (Coda (http://www.coda.cs.cmu.edu/), etc.),\n\ + \032 uni-directional mirroring utilities (rsync\n\ + \032 (http://samba.anu.edu.au/rsync/), etc.), and other synchronizers\n\ + \032 (Intellisync (http://www.pumatech.com), Reconcile\n\ + \032 (http://www.merl.com/reports/TR99-14/), etc). However, there are\n\ + \032 several points where it differs:\n\ + \032 * Unison runs on both Windows (95, 98, NT, 2k, and XP) and Unix\n\ + \032 (OSX, Solaris, Linux, etc.) systems. Moreover, Unison works across\n\ + \032 platforms, allowing you to synchronize a Windows laptop with a\n\ + \032 Unix server, for example.\n\ + \032 * Unlike a distributed filesystem, Unison is a user-level program:\n\ + \032 there is no need to modify the kernel or to have superuser\n\ + \032 privileges on either host.\n\ + \032 * Unlike simple mirroring or backup utilities, Unison can deal with\n\ + \032 updates to both replicas of a distributed directory structure.\n\ + \032 Updates that do not conflict are propagated automatically.\n\ + \032 Conflicting updates are detected and displayed.\n\ + \032 * Unison works between any pair of machines connected to the\n\ + \032 internet, communicating over either a direct socket link or\n\ + \032 tunneling over an encrypted ssh connection. It is careful with\n\ + \032 network bandwidth, and runs well over slow links such as PPP\n\ + \032 connections. Transfers of small updates to large files are\n\ + \032 optimized using a compression protocol similar to rsync.\n\ + \032 * Unison has a clear and precise specification, described below.\n\ + \032 * Unison is resilient to failure. It is careful to leave the\n\ + \032 replicas and its own private structures in a sensible state at all\n\ + \032 times, even in case of abnormal termination or communication\n\ + \032 failures.\n\ + \032 * Unison is free; full source code is available under the GNU Public\n\ + \032 License.\n\ + \n\ + ")) +:: + ("", ("Preface", + "Preface\n\ + \n\ + ")) +:: + ("people", ("People", + "People\n\ + \n\ + \032 Benjamin Pierce (http://www.cis.upenn.edu/~bcpierce/) leads the Unison\n\ + \032 project. The current version of Unison was designed and implemented by\n\ + \032 Trevor Jim (http://www.research.att.com/~trevor/), Benjamin Pierce\n\ + \032 (http://www.cis.upenn.edu/~bcpierce/), and J\233r\244me Vouillon\n\ + \032 (http://www.pps.jussieu.fr/~vouillon/), with Alan Schmitt\n\ + \032 (http://alan.petitepomme.net/), Malo Denielou, Zhe Yang\n\ + \032 (http://www.brics.dk/~zheyang/), Sylvain Gommier, and Matthieu Goulay.\n\ + \032 The Mac user interface was started by Trevor Jim and enormously\n\ + \032 improved by Ben Willmore. Our implementation of the rsync\n\ + \032 (http://samba.org/rsync/) protocol was built by Norman Ramsey\n\ + \032 (http://www.eecs.harvard.edu/~nr/) and Sylvain Gommier. It is is based\n\ + \032 on Andrew Tridgell (http://samba.anu.edu.au/~tridge/)'s thesis work\n\ + \032 (http://samba.anu.edu.au/~tridge/phd_thesis.pdf) and inspired by his\n\ + \032 rsync (http://samba.org/rsync/) utility. The mirroring and merging\n\ + \032 functionality was implemented by Sylvain Roy, improved by Malo\n\ + \032 Denielou, and improved yet further by St\233phane Lescuyer. Jacques\n\ + \032 Garrigue (http://wwwfun.kurims.kyoto-u.ac.jp/~garrigue/) contributed\n\ + \032 the original Gtk version of the user interface; the Gtk2 version was\n\ + \032 built by Stephen Tse. Sundar Balasubramaniam helped build a prototype\n\ + \032 implementation of an earlier synchronizer in Java. Insik Shin\n\ + \032 (http://www.cis.upenn.edu/~ishin/) and Insup Lee\n\ + \032 (http://www.cis.upenn.edu/~lee/) contributed design ideas to this\n\ + \032 implementation. Cedric Fournet\n\ + \032 (http://research.microsoft.com/~fournet/) contributed to an even\n\ + \032 earlier prototype.\n\ + \n\ + ")) +:: + ("lists", ("Mailing Lists and Bug Reporting", + "Mailing Lists and Bug Reporting\n\ + \n\ + Mailing Lists:\n\ + \n\ + \032 Moderated mailing lists are available for bug reporting, announcements\n\ + \032 of new versions, discussions among users, and discussions among\n\ + \032 developers. See\n\ + \n\ + \032 http://www.cis.upenn.edu/~bcpierce/unison/lists.html\n\ + \n\ + \032 for more information.\n\ + \n\ + ")) +:: + ("status", ("Development Status", + "Development Status\n\ + \n\ + \032 Unison is no longer under active development as a research project.\n\ + \032 (Our research efforts are now focused on a follow-on project called\n\ + \032 Harmony, described at http://www.cis.upenn.edu/~bcpierce/harmony.) At\n\ + \032 this point, there is no one whose job it is to maintain Unison, fix\n\ + \032 bugs, or answer questions.\n\ + \n\ + \032 However, the original developers are all still using Unison daily. It\n\ + \032 will continue to be maintained and supported for the foreseeable\n\ + \032 future, and we will occasionally release new versions with bug fixes,\n\ + \032 small improvements, and contributed patches.\n\ + \n\ + \032 Reports of bugs affecting correctness or safety are of interest to\n\ + \032 many people and will generally get high priority. Other bug reports\n\ + \032 will be looked at as time permits. Bugs should be reported to the\n\ + \032 users list at unison-users at yahoogroups.com\n\ + \032 (mailto:unison-users at yahoogroups.com).\n\ + \n\ + \032 Feature requests are welcome, but will probably just be added to the\n\ + \032 ever-growing todo list. They should also be sent to\n\ + \032 unison-users at yahoogroups.com (mailto:unison-users at yahoogroups.com).\n\ + \n\ + \032 Patches are even more welcome. They should be sent to\n\ + \032 unison-hackers at lists.seas.upenn.edu\n\ + \032 (mailto:unison-hackers at lists.seas.upenn.edu). (Since safety and\n\ + \032 robustness are Unison's most important properties, patches will be\n\ + \032 held to high standards of clear design and clean coding.) If you want\n\ + \032 to contribute to Unison, start by downloading the developer tarball\n\ + \032 from the download page. For some details on how the code is organized,\n\ + \032 etc., see the file CONTRIB.\n\ + \n\ + ")) +:: + ("copying", ("Copying", + "Copying\n\ + \n\ + \032 This file is part of Unison.\n\ + \n\ + \032 Unison is free software: you can redistribute it and/or modify it\n\ + \032 under the terms of the GNU General Public License as published by the\n\ + \032 Free Software Foundation, either version 3 of the License, or (at your\n\ + \032 option) any later version.\n\ + \n\ + \032 Unison is distributed in the hope that it will be useful, but WITHOUT\n\ + \032 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or\n\ + \032 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License\n\ + \032 for more details.\n\ + \n\ + \032 The GNU Public License can be found at http://www.gnu.org/licenses. A\n\ + \032 copy is also included in the Unison source distribution in the file\n\ + \032 COPYING.\n\ + \n\ + ")) +:: + ("ack", ("Acknowledgements", + "Acknowledgements\n\ + \n\ + \032 Work on Unison has been supported by the National Science Foundation\n\ + \032 under grants CCR-9701826 and ITR-0113226, Principles and Practice of\n\ + \032 Synchronization, and by University of Pennsylvania's Institute for\n\ + \032 Research in Cognitive Science (IRCS).\n\ + \n\ + ")) +:: + ("install", ("Installation", + "Installation\n\ + \n\ + \032 Unison is designed to be easy to install. The following sequence of\n\ + \032 steps should get you a fully working installation in a few minutes. If\n\ + \032 you run into trouble, you may find the suggestions on the Frequently\n\ + \032 Asked Questions page\n\ + \032 (http://www.cis.upenn.edu/~bcpierce/unison/faq.html) helpful.\n\ + \032 Pre-built binaries are available for a variety of platforms.\n\ + \n\ + \032 Unison can be used with either of two user interfaces:\n\ + \032 1. a simple textual interface, suitable for dumb terminals (and\n\ + \032 running from scripts), and\n\ + \032 2. a more sophisticated grapical interface, based on Gtk2.\n\ + \n\ + \032 You will need to install a copy of Unison on every machine that you\n\ + \032 want to synchronize. However, you only need the version with a\n\ + \032 graphical user interface (if you want a GUI at all) on the machine\n\ + \032 where you're actually going to display the interface (the CLIENT\n\ + \032 machine). Other machines that you synchronize with can get along just\n\ + \032 fine with the textual version.\n\ + \n\ + Downloading Unison\n\ + \n\ + \032 The Unison download site lives under\n\ + \032 http://www.cis.upenn.edu/~bcpierce/unison.\n\ + \n\ + \032 If a pre-built binary of Unison is available for the client machine's\n\ + \032 architecture, just download it and put it somewhere in your search\n\ + \032 path (if you're going to invoke it from the command line) or on your\n\ + \032 desktop (if you'll be click-starting it).\n\ + \n\ + \032 The executable file for the graphical version (with a name including\n\ + \032 gtkui) actually provides both interfaces: the graphical one appears by\n\ + \032 default, while the textual interface can be selected by including -ui\n\ + \032 text on the command line. The textui executable provides just the\n\ + \032 textual interface.\n\ + \n\ + \032 If you don't see a pre-built executable for your architecture, you'll\n\ + \032 need to build it yourself. See the section \"Building Unison\" . There\n\ + \032 are also a small number of contributed ports to other architectures\n\ + \032 that are not maintained by us. See the Contributed Ports page\n\ + \032 (http://www.cis.upenn.edu/~bcpierce/unison/download.html) to check\n\ + \032 what's available.\n\ + \n\ + \032 Check to make sure that what you have downloaded is really executable.\n\ + \032 Either click-start it, or type \"unison -version\" at the command line.\n\ + \n\ + \032 Unison can be used in three different modes: with different\n\ + \032 directories on a single machine, with a remote machine over a direct\n\ + \032 socket connection, or with a remote machine using ssh for\n\ + \032 authentication and secure transfer. If you intend to use the last\n\ + \032 option, you may need to install ssh; see the section \"Installing Ssh\"\n\ + \032 .\n\ + \n\ + Running Unison\n\ + \n\ + \032 Once you've got Unison installed on at least one system, read the\n\ + \032 section \"Tutorial\" of the user manual (or type \"unison -doc tutorial\")\n\ + \032 for instructions on how to get started.\n\ + \n\ + Upgrading\n\ + \n\ + \032 Upgrading to a new version of Unison is as simple as throwing away the\n\ + \032 old binary and installing the new one.\n\ + \n\ + \032 Before upgrading, it is a good idea to run the old version one last\n\ + \032 time, to make sure all your replicas are completely synchronized. A\n\ + \032 new version of Unison will sometimes introduce a different format for\n\ + \032 the archive files used to remember information about the previous\n\ + \032 state of the replicas. In this case, the old archive will be ignored\n\ + \032 (not deleted -- if you roll back to the previous version of Unison,\n\ + \032 you will find the old archives intact), which means that any\n\ + \032 differences between the replicas will show up as conflicts that need\n\ + \032 to be resolved manually.\n\ + \n\ + Building Unison from Scratch\n\ + \n\ + \032 If a pre-built image is not available, you will need to compile it\n\ + \032 from scratch; the sources are available from the same place as the\n\ + \032 binaries.\n\ + \n\ + \032 In principle, Unison should work on any platform to which OCaml has\n\ + \032 been ported and on which the Unix module is fully implemented. It has\n\ + \032 been tested on many flavors of Windows (98, NT, 2000, XP) and Unix (OS\n\ + \032 X, Solaris, Linux, FreeBSD), and on both 32- and 64-bit architectures.\n\ + \n\ + Unix\n\ + \n\ + \032 You'll need the Objective Caml compiler (version 3.07 or later), which\n\ + \032 is available from http://caml.inria.fr. Building and installing OCaml\n\ + \032 on Unix systems is very straightforward; just follow the instructions\n\ + \032 in the distribution. You'll probably want to build the native-code\n\ + \032 compiler in addition to the bytecode compiler, as Unison runs much\n\ + \032 faster when compiled to native code, but this is not absolutely\n\ + \032 necessary. (Quick start: on many systems, the following sequence of\n\ + \032 commands will get you a working and installed compiler: first do make\n\ + \032 world opt, then su to root and do make install.)\n\ + \n\ + \032 You'll also need the GNU make utility, standard on many Unix systems.\n\ + \032 (Type \"make -version\" to check that you've got the GNU version.)\n\ + \n\ + \032 Once you've got OCaml installed, grab a copy of the Unison sources,\n\ + \032 unzip and untar them, change to the new \"unison\" directory, and type\n\ + \032 \"make UISTYLE=text.\" The result should be an executable file called\n\ + \032 \"unison\". Type \"./unison\" to make sure the program is executable. You\n\ + \032 should get back a usage message.\n\ + \n\ + \032 If you want to build the graphical user interface, you will need to\n\ + \032 install two additional things:\n\ + \032 * The Gtk2 libraries. These areavailable from http://www.gtk.org and\n\ + \032 are standard on many Unix installations.\n\ + \032 * The lablgtk2 OCaml library. Grab the developers' tarball from\n\ + \n\ + \032 http://wwwfun.kurims.kyoto-u.ac.jp/soft/olabl/lablgtk.html,\n\ + \032 untar it, and follow the instructions to build and install it.\n\ + \032 (Quick start: make configure, then make, then make opt, then su\n\ + \032 and make install.)\n\ + \n\ + \032 Now build unison. If your search paths are set up correctly, simply\n\ + \032 typing make again should build a unison executable with a Gtk2\n\ + \032 graphical interface. (In previous releases of Unison, it was necessary\n\ + \032 to add UISTYLE=gtk2 to the 'make' command above. This requirement has\n\ + \032 been removed: the makefile should detect automatically when lablgtk2\n\ + \032 is present and set this flag automatically.)\n\ + \n\ + \032 Put the unison executable somewhere in your search path, either by\n\ + \032 adding the Unison directory to your PATH variable or by copying the\n\ + \032 executable to some standard directory where executables are stored.\n\ + \n\ + Windows\n\ + \n\ + \032 Although the binary distribution should work on any version of\n\ + \032 Windows, some people may want to build Unison from scratch on those\n\ + \032 systems too.\n\ + \n\ + Bytecode version:\n\ + \n\ + \032 The simpler but slower compilation option to build a Unison executable\n\ + \032 is to build a bytecode version. You need first install Windows version\n\ + \032 of the OCaml compiler (version 3.07 or later, available from\n\ + \032 http://caml.inria.fr). Then grab a copy of Unison sources and type\n\ + \032 make NATIVE=false\n\ + \n\ + \032 to compile the bytecode. The result should be an executable file\n\ + \032 called unison.exe.\n\ + \n\ + Native version:\n\ + \n\ + \032 Building a more efficient, native version of Unison on Windows\n\ + \032 requires a little more work. See the file INSTALL.win32 in the source\n\ + \032 code distribution.\n\ + \n\ + Installation Options\n\ + \n\ + \032 The Makefile in the distribution includes several switches that can be\n\ + \032 used to control how Unison is built. Here are the most useful ones:\n\ + \032 * Building with NATIVE=true uses the native-code OCaml compiler,\n\ + \032 yielding an executable that will run quite a bit faster. We use\n\ + \032 this for building distribution versions.\n\ + \032 * Building with make DEBUGGING=true generates debugging symbols.\n\ + \032 * Building with make STATIC=true generates a (mostly) statically\n\ + \032 linked executable. We use this for building distribution versions,\n\ + \032 for portability.\n\ + \n\ + ")) +:: + ("tutorial", ("Tutorial", + "Tutorial\n\ + \n\ + Preliminaries\n\ + \n\ + \032 Unison can be used with either of two user interfaces:\n\ + \032 1. a straightforward textual interface and\n\ + \032 2. a more sophisticated graphical interface\n\ + \n\ + \032 The textual interface is more convenient for running from scripts and\n\ + \032 works on dumb terminals; the graphical interface is better for most\n\ + \032 interactive use. For this tutorial, you can use either. If you are\n\ + \032 running Unison from the command line, just typing unison will select\n\ + \032 either the text or the graphical interface, depending on which has\n\ + \032 been selected as default when the executable you are running was\n\ + \032 built. You can force the text interface even if graphical is the\n\ + \032 default by adding -ui text. The other command-line arguments to both\n\ + \032 versions are identical.\n\ + \n\ + \032 The graphical version can also be run directly by clicking on its\n\ + \032 icon, but this may require a little set-up (see the section\n\ + \032 \"Click-starting Unison\" ). For this tutorial, we assume that you're\n\ + \032 starting it from the command line.\n\ + \n\ + \032 Unison can synchronize files and directories on a single machine, or\n\ + \032 between two machines on a network. (The same program runs on both\n\ + \032 machines; the only difference is which one is responsible for\n\ + \032 displaying the user interface.) If you're only interested in a\n\ + \032 single-machine setup, then let's call that machine the CLIENT . If\n\ + \032 you're synchronizing two machines, let's call them CLIENT and SERVER .\n\ + \n\ + Local Usage\n\ + \n\ + \032 Let's get the client machine set up first and see how to synchronize\n\ + \032 two directories on a single machine.\n\ + \n\ + \032 Follow the instructions in the section \"Installation\" to either\n\ + \032 download or build an executable version of Unison, and install it\n\ + \032 somewhere on your search path. (If you just want to use the textual\n\ + \032 user interface, download the appropriate textui binary. If you just\n\ + \032 want to the graphical interface--or if you will use both interfaces\n\ + \032 [the gtkui binary actually has both compiled in]--then download the\n\ + \032 gtkui binary.)\n\ + \n\ + \032 Create a small test directory a.tmp containing a couple of files\n\ + \032 and/or subdirectories, e.g.,\n\ + \032 mkdir a.tmp\n\ + \032 touch a.tmp/a a.tmp/b\n\ + \032 mkdir a.tmp/d\n\ + \032 touch a.tmp/d/f\n\ + \n\ + \032 Copy this directory to b.tmp:\n\ + \032 cp -r a.tmp b.tmp\n\ + \n\ + \032 Now try synchronizing a.tmp and b.tmp. (Since they are identical,\n\ + \032 synchronizing them won't propagate any changes, but Unison will\n\ + \032 remember the current state of both directories so that it will be able\n\ + \032 to tell next time what has changed.) Type:\n\ + \032 unison a.tmp b.tmp\n\ + \n\ + \032 Textual Interface:\n\ + \032 * You should see a message notifying you that all the files are\n\ + \032 actually equal and then get returned to the command line.\n\ + \n\ + \032 Graphical Interface:\n\ + \032 * You should get a big empty window with a message at the bottom\n\ + \032 notifying you that all files are identical. Choose the Exit item\n\ + \032 from the File menu to get back to the command line.\n\ + \n\ + \032 Next, make some changes in a.tmp and/or b.tmp. For example:\n\ + \032 rm a.tmp/a\n\ + \032 echo \"Hello\" > a.tmp/b\n\ + \032 echo \"Hello\" > b.tmp/b\n\ + \032 date > b.tmp/c\n\ + \032 echo \"Hi there\" > a.tmp/d/h\n\ + \032 echo \"Hello there\" > b.tmp/d/h\n\ + \n\ + \032 Run Unison again:\n\ + \032 unison a.tmp b.tmp\n\ + \n\ + \032 This time, the user interface will display only the files that have\n\ + \032 changed. If a file has been modified in just one replica, then it will\n\ + \032 be displayed with an arrow indicating the direction that the change\n\ + \032 needs to be propagated. For example,\n\ + \032 <--- new file c [f]\n\ + \n\ + \032 indicates that the file c has been modified only in the second\n\ + \032 replica, and that the default action is therefore to propagate the new\n\ + \032 version to the first replica. To follw Unison's recommendation, press\n\ + \032 the \"f\" at the prompt.\n\ + \n\ + \032 If both replicas are modified and their contents are different, then\n\ + \032 the changes are in conflict: <-?-> is displayed to indicate that\n\ + \032 Unison needs guidance on which replica should override the other.\n\ + \032 new file <-?-> new file d/h []\n\ + \n\ + \032 By default, neither version will be propagated and both replicas will\n\ + \032 remain as they are.\n\ + \n\ + \032 If both replicas have been modified but their new contents are the\n\ + \032 same (as with the file b), then no propagation is necessary and\n\ + \032 nothing is shown. Unison simply notes that the file is up to date.\n\ + \n\ + \032 These display conventions are used by both versions of the user\n\ + \032 interface. The only difference lies in the way in which Unison's\n\ + \032 default actions are either accepted or overriden by the user.\n\ + \n\ + \032 Textual Interface:\n\ + \032 * The status of each modified file is displayed, in turn. When the\n\ + \032 copies of a file in the two replicas are not identical, the user\n\ + \032 interface will ask for instructions as to how to propagate the\n\ + \032 change. If some default action is indicated (by an arrow), you can\n\ + \032 simply press Return to go on to the next changed file. If you want\n\ + \032 to do something different with this file, press \"<\" or \">\" to\n\ + \032 force the change to be propagated from right to left or from left\n\ + \032 to right, or else press \"/\" to skip this file and leave both\n\ + \032 replicas alone. When it reaches the end of the list of modified\n\ + \032 files, Unison will ask you one more time whether it should proceed\n\ + \032 with the updates that have been selected.\n\ + \032 When Unison stops to wait for input from the user, pressing \"?\"\n\ + \032 will always give a list of possible responses and their meanings.\n\ + \n\ + \032 Graphical Interface:\n\ + \032 * The main window shows all the files that have been modified in\n\ + \032 either a.tmp or b.tmp. To override a default action (or to select\n\ + \032 an action in the case when there is no default), first select the\n\ + \032 file, either by clicking on its name or by using the up- and\n\ + \032 down-arrow keys. Then press either the left-arrow or \"<\" key (to\n\ + \032 cause the version in b.tmp to propagate to a.tmp) or the\n\ + \032 right-arrow or \">\" key (which makes the a.tmp version override\n\ + \032 b.tmp).\n\ + \032 Every keyboard command can also be invoked from the menus at the\n\ + \032 top of the user interface. (Conversely, each menu item is\n\ + \032 annotated with its keyboard equivalent, if it has one.)\n\ + \032 When you are satisfied with the directions for the propagation of\n\ + \032 changes as shown in the main window, click the \"Go\" button to set\n\ + \032 them in motion. A check sign will be displayed next to each\n\ + \032 filename when the file has been dealt with.\n\ + \n\ + Remote Usage\n\ + \n\ + \032 Next, we'll get Unison set up to synchronize replicas on two different\n\ + \032 machines.\n\ + \n\ + \032 Follow the instructions in the Installation section to download or\n\ + \032 build an executable version of Unison on the server machine, and\n\ + \032 install it somewhere on your search path. (It doesn't matter whether\n\ + \032 you install the textual or graphical version, since the copy of Unison\n\ + \032 on the server doesn't need to display any user interface at all.)\n\ + \n\ + \032 It is important that the version of Unison installed on the server\n\ + \032 machine is the same as the version of Unison on the client machine.\n\ + \032 But some flexibility on the version of Unison at the client side can\n\ + \032 be achieved by using the -addversionno option; see the section\n\ + \032 \"Preferences\" .\n\ + \n\ + \032 Now there is a decision to be made. Unison provides two methods for\n\ + \032 communicating between the client and the server:\n\ + \032 * Remote shell method: To use this method, you must have some way of\n\ + \032 invoking remote commands on the server from the client's command\n\ + \032 line, using a facility such as ssh. This method is more convenient\n\ + \032 (since there is no need to manually start a \"unison server\"\n\ + \032 process on the server) and also more secure (especially if you use\n\ + \032 ssh).\n\ + \032 * Socket method: This method requires only that you can get TCP\n\ + \032 packets from the client to the server and back. A draconian\n\ + \032 firewall can prevent this, but otherwise it should work anywhere.\n\ + \n\ + \032 Decide which of these you want to try, and continue with the section\n\ + \032 \"Remote Shell Method\" or the section \"Socket Method\" , as appropriate.\n\ + \n\ + Remote Shell Method\n\ + \n\ + \032 The standard remote shell facility on Unix systems is ssh, which\n\ + \032 provides the same functionality as the older rsh but much better\n\ + \032 security. Ssh is available from ftp://ftp.cs.hut.fi/pub/ssh/;\n\ + \032 up-to-date binaries for some architectures can also be found at\n\ + \032 ftp://ftp.faqs.org/ssh/contrib. See section [1]A.2 for installation\n\ + \032 instructions for the Windows version.\n\ + \n\ + \032 Running ssh requires some coordination between the client and server\n\ + \032 machines to establish that the client is allowed to invoke commands on\n\ + \032 the server; please refer to the or ssh documentation for information\n\ + \032 on how to set this up. The examples in this section use ssh, but you\n\ + \032 can substitute rsh for ssh if you wish.\n\ + \n\ + \032 First, test that we can invoke Unison on the server from the client.\n\ + \032 Typing\n\ + \032 ssh remotehostname unison -version\n\ + \n\ + \032 should print the same version information as running\n\ + \032 unison -version\n\ + \n\ + \032 locally on the client. If remote execution fails, then either\n\ + \032 something is wrong with your ssh setup (e.g., \"permission denied\") or\n\ + \032 else the search path that's being used when executing commands on the\n\ + \032 server doesn't contain the unison executable (e.g., \"command not\n\ + \032 found\").\n\ + \n\ + \032 Create a test directory a.tmp in your home directory on the client\n\ + \032 machine.\n\ + \n\ + \032 Test that the local unison client can start and connect to the remote\n\ + \032 server. Type\n\ + \032 unison -testServer a.tmp ssh://remotehostname/a.tmp\n\ + \n\ + \032 Now cd to your home directory and type:\n\ + \032 unison a.tmp ssh://remotehostname/a.tmp\n\ + \n\ + \032 The result should be that the entire directory a.tmp is propagated\n\ + \032 from the client to your home directory on the server.\n\ + \n\ + \032 After finishing the first synchronization, change a few files and try\n\ + \032 synchronizing again. You should see similar results as in the local\n\ + \032 case.\n\ + \n\ + \032 If your user name on the server is not the same as on the client, you\n\ + \032 need to specify it on the command line:\n\ + \032 unison a.tmp ssh://username at remotehostname/a.tmp\n\ + \n\ + \032 Notes:\n\ + \032 * If you want to put a.tmp some place other than your home directory\n\ + \032 on the remote host, you can give an absolute path for it by adding\n\ + \032 an extra slash between remotehostname and the beginning of the\n\ + \032 path:\n\ + \032 unison a.tmp ssh://remotehostname//absolute/path/to/a.tmp\n\ + \032 * You can give an explicit path for the unison executable on the\n\ + \032 server by using the command-line option \"-servercmd\n\ + \032 /full/path/name/of/unison\" or adding\n\ + \032 \"servercmd=/full/path/name/of/unison\" to your profile (see the\n\ + \032 section \"Profile\" ). Similarly, you can specify a explicit path\n\ + \032 for the ssh program using the \"-sshcmd\" option. Extra arguments\n\ + \032 can be passed to ssh by setting the -sshargs preference.\n\ + \n\ + Socket Method\n\ + \n\ + \032 Warning: The socket method is insecure: not only are the texts of\n\ + \032 your changes transmitted over the network in unprotected form, it\n\ + \032 is also possible for anyone in the world to connect to the server\n\ + \032 process and read out the contents of your filesystem! (Of course,\n\ + \032 to do this they must understand the protocol that Unison uses to\n\ + \032 communicate between client and server, but all they need for this\n\ + \032 is a copy of the Unison sources.) The socket method is provided\n\ + \032 only for expert users with specific needs; everyone else should use\n\ + \032 the ssh method.\n\ + \n\ + \032 To run Unison over a socket connection, you must start a Unison daemon\n\ + \032 process on the server. This process runs continuously, waiting for\n\ + \032 connections over a given socket from client machines running Unison\n\ + \032 and processing their requests in turn.\n\ + \n\ + \032 To start the daemon, type\n\ + \032 unison -socket NNNN\n\ + \n\ + \032 on the server machine, where NNNN is the socket number that the daemon\n\ + \032 should listen on for connections from clients. (NNNN can be any large\n\ + \032 number that is not being used by some other program; if NNNN is\n\ + \032 already in use, Unison will exit with an error message.) Note that\n\ + \032 paths specified by the client will be interpreted relative to the\n\ + \032 directory in which you start the server process; this behavior is\n\ + \032 different from the ssh case, where the path is relative to your home\n\ + \032 directory on the server.\n\ + \n\ + \032 Create a test directory a.tmp in your home directory on the client\n\ + \032 machine. Now type:\n\ + \032 unison a.tmp socket://remotehostname:NNNN/a.tmp\n\ + \n\ + \032 The result should be that the entire directory a.tmp is propagated\n\ + \032 from the client to the server (a.tmp will be created on the server in\n\ + \032 the directory that the server was started from). After finishing the\n\ + \032 first synchronization, change a few files and try synchronizing again.\n\ + \032 You should see similar results as in the local case.\n\ + \n\ + \032 Since the socket method is not used by many people, its functionality\n\ + \032 is rather limited. For example, the server can only deal with one\n\ + \032 client at a time.\n\ + \n\ + Using Unison for All Your Files\n\ + \n\ + \032 Once you are comfortable with the basic operation of Unison, you may\n\ + \032 find yourself wanting to use it regularly to synchronize your commonly\n\ + \032 used files. There are several possible ways of going about this:\n\ + \032 1. Synchronize your whole home directory, using the Ignore facility\n\ + \032 (see the section \"Ignore\" ) to avoid synchronizing temporary files\n\ + \032 and things that only belong on one host.\n\ + \032 2. Create a subdirectory called shared (or current, or whatever) in\n\ + \032 your home directory on each host, and put all the files you want\n\ + \032 to synchronize into this directory.\n\ + \032 3. Create a subdirectory called shared (or current, or whatever) in\n\ + \032 your home directory on each host, and put links to all the files\n\ + \032 you want to synchronize into this directory. Use the follow\n\ + \032 preference (see the section \"Symbolic Links\" ) to make Unison\n\ + \032 treat these links as transparent.\n\ + \032 4. Make your home directory the root of the synchronization, but tell\n\ + \032 Unison to synchronize only some of the files and subdirectories\n\ + \032 within it on any given run. This can be accomplished by using the\n\ + \032 -path switch on the command line:\n\ + \032 unison /home/username ssh://remotehost//home/username -path shared\n\ + \032 The -path option can be used as many times as needed, to\n\ + \032 synchronize several files or subdirectories:\n\ + \032 unison /home/username ssh://remotehost//home/username \\\n\ + \032 -path shared \\\n\ + \032 -path pub \\\n\ + \032 -path .netscape/bookmarks.html\n\ + \032 These -path arguments can also be put in your preference file. See\n\ + \032 the section \"Preferences\" for an example.\n\ + \n\ + \032 Most people find that they only need to maintain a profile (or\n\ + \032 profiles) on one of the hosts that they synchronize, since Unison is\n\ + \032 always initiated from this host. (For example, if you're synchronizing\n\ + \032 a laptop with a fileserver, you'll probably always run Unison on the\n\ + \032 laptop.) This is a bit different from the usual situation with\n\ + \032 asymmetric mirroring programs like rdist, where the mirroring\n\ + \032 operation typically needs to be initiated from the machine with the\n\ + \032 most recent changes. the section \"Profile\" covers the syntax of Unison\n\ + \032 profiles, together with some sample profiles.\n\ + \n\ + \032 Some tips on improving Unison's performance can be found on the\n\ + \032 Frequently Asked Questions page\n\ + \032 (http://www.cis.upenn.edu/~bcpierce/unison/faq.html).\n\ + \n\ + Using Unison to Synchronize More Than Two Machines\n\ + \n\ + \032 Unison is designed for synchronizing pairs of replicas. However, it is\n\ + \032 possible to use it to keep larger groups of machines in sync by\n\ + \032 performing multiple pairwise synchronizations.\n\ + \n\ + \032 If you need to do this, the most reliable way to set things up is to\n\ + \032 organize the machines into a \"star topology,\" with one machine\n\ + \032 designated as the \"hub\" and the rest as \"spokes,\" and with each spoke\n\ + \032 machine synchronizing only with the hub. The big advantage of the star\n\ + \032 topology is that it eliminates the possibility of confusing \"spurious\n\ + \032 conflicts\" arising from the fact that a separate archive is maintained\n\ + \032 by Unison for every pair of hosts that it synchronizes.\n\ + \n\ + Going Further\n\ + \n\ + \032 On-line documentation for the various features of Unison can be\n\ + \032 obtained either by typing\n\ + \032 unison -doc topics\n\ + \n\ + \032 at the command line, or by selecting the Help menu in the graphical\n\ + \032 user interface. The same information is also available in a typeset\n\ + \032 User's Manual (HTML or PostScript format) through\n\ + \032 http://www.cis.upenn.edu/~bcpierce/unison.\n\ + \n\ + \032 If you use Unison regularly, you should subscribe to one of the\n\ + \032 mailing lists, to receive announcements of new versions. See the\n\ + \032 section \"Mailing Lists\" .\n\ + \n\ + ")) +:: + ("basics", ("Basic Concepts", + "Basic Concepts\n\ + \n\ + \032 To understand how Unison works, it is necessary to discuss a few\n\ + \032 straightforward concepts. These concepts are developed more rigorously\n\ + \032 and at more length in a number of papers, available at\n\ + \032 http://www.cis.upenn.edu/~bcpierce/papers. But the informal\n\ + \032 presentation here should be enough for most users.\n\ + \n\ + Roots\n\ + \n\ + \032 A replica's root tells Unison where to find a set of files to be\n\ + \032 synchronized, either on the local machine or on a remote host. For\n\ + \032 example,\n\ + \032 relative/path/of/root\n\ + \n\ + \032 specifies a local root relative to the directory where Unison is\n\ + \032 started, while\n\ + \032 /absolute/path/of/root\n\ + \n\ + \032 specifies a root relative to the top of the local filesystem,\n\ + \032 independent of where Unison is running. Remote roots can begin with\n\ + \032 ssh://, rsh:// to indicate that the remote server should be started\n\ + \032 with rsh or ssh:\n\ + \032 ssh://remotehost//absolute/path/of/root\n\ + \032 rsh://user at remotehost/relative/path/of/root\n\ + \n\ + \032 If the remote server is already running (in the socket mode), then the\n\ + \032 syntax\n\ + \032 socket://remotehost:portnum//absolute/path/of/root\n\ + \032 socket://remotehost:portnum/relative/path/of/root\n\ + \n\ + \032 is used to specify the hostname and the port that the client Unison\n\ + \032 should use to contact it.\n\ + \n\ + \032 The syntax for roots is based on that of URIs (described in RFC 2396).\n\ + \032 The full grammar is:\n\ + \032 replica ::= [protocol:]//[user@][host][:port][/path]\n\ + \032 | path\n\ + \n\ + \032 protocol ::= file\n\ + \032 | socket\n\ + \032 | ssh\n\ + \032 | rsh\n\ + \n\ + \032 user ::= [-_a-zA-Z0-9]+\n\ + \n\ + \032 host ::= [-_a-zA-Z0-9.]+\n\ + \n\ + \032 port ::= [0-9]+\n\ + \n\ + \032 When path is given without any protocol prefix, the protocol is\n\ + \032 assumed to be file:. Under Windows, it is possible to synchronize with\n\ + \032 a remote directory using the file: protocol over the Windows Network\n\ + \032 Neighborhood. For example,\n\ + \032 unison foo //host/drive/bar\n\ + \n\ + \032 synchronizes the local directory foo with the directory drive:\\bar on\n\ + \032 the machine host, provided that host is accessible via Network\n\ + \032 Neighborhood. When the file: protocol is used in this way, there is no\n\ + \032 need for a Unison server to be running on the remote host. However,\n\ + \032 running Unison this way is only a good idea if the remote host is\n\ + \032 reached by a very fast network connection, since the full contents of\n\ + \032 every file in the remote replica will have to be transferred to the\n\ + \032 local machine to detect updates.\n\ + \n\ + \032 The names of roots are canonized by Unison before it uses them to\n\ + \032 compute the names of the corresponding archive files, so\n\ + \032 //saul//home/bcpierce/common and //saul.cis.upenn.edu/common will be\n\ + \032 recognized as the same replica under different names.\n\ + \n\ + Paths\n\ + \n\ + \032 A path refers to a point within a set of files being synchronized; it\n\ + \032 is specified relative to the root of the replica.\n\ + \n\ + \032 Formally, a path is just a sequence of names, separated by /. Note\n\ + \032 that the path separator character is always a forward slash, no matter\n\ + \032 what operating system Unison is running on. Forward slashes are\n\ + \032 converted to backslashes as necessary when paths are converted to\n\ + \032 filenames in the local filesystem on a particular host. (For example,\n\ + \032 suppose that we run Unison on a Windows system, synchronizing the\n\ + \032 local root c:\\pierce with the root\n\ + \032 ssh://saul.cis.upenn.edu/home/bcpierce on a Unix server. Then the path\n\ + \032 current/todo.txt refers to the file c:\\pierce\\current\\todo.txt on the\n\ + \032 client and /home/bcpierce/current/todo.txt on the server.)\n\ + \n\ + \032 The empty path (i.e., the empty sequence of names) denotes the whole\n\ + \032 replica. Unison displays the empty path as \"[root].\"\n\ + \n\ + \032 If p is a path and q is a path beginning with p, then q is said to be\n\ + \032 a descendant of p. (Each path is also a descendant of itself.)\n\ + \n\ + What is an Update?\n\ + \n\ + \032 The contents of a path p in a particular replica could be a file, a\n\ + \032 directory, a symbolic link, or absent (if p does not refer to anything\n\ + \032 at all in that replica). More specifically:\n\ + \032 * If p refers to an ordinary file, then the contents of p are the\n\ + \032 actual contents of this file (a string of bytes) plus the current\n\ + \032 permission bits of the file.\n\ + \032 * If p refers to a symbolic link, then the contents of p are just\n\ + \032 the string specifying where the link points.\n\ + \032 * If p refers to a directory, then the contents of p are just the\n\ + \032 token \"DIRECTORY\" plus the current permission bits of the\n\ + \032 directory.\n\ + \032 * If p does not refer to anything in this replica, then the contents\n\ + \032 of p are the token \"ABSENT.\"\n\ + \n\ + \032 Unison keeps a record of the contents of each path after each\n\ + \032 successful synchronization of that path (i.e., it remembers the\n\ + \032 contents at the last moment when they were the same in the two\n\ + \032 replicas).\n\ + \n\ + \032 We say that a path is updated (in some replica) if its current\n\ + \032 contents are different from its contents the last time it was\n\ + \032 successfully synchronized. Note that whether a path is updated has\n\ + \032 nothing to do with its last modification time--Unison considers only\n\ + \032 the contents when determining whether an update has occurred. This\n\ + \032 means that touching a file without changing its contents will not be\n\ + \032 recognized as an update. A file can even be changed several times and\n\ + \032 then changed back to its original contents; as long as Unison is only\n\ + \032 run at the end of this process, no update will be recognized.\n\ + \n\ + \032 What Unison actually calculates is a close approximation to this\n\ + \032 definition; see the section \"Caveats and Shortcomings\" .\n\ + \n\ + What is a Conflict?\n\ + \n\ + \032 A path is said to be conflicting if the following conditions all hold:\n\ + \032 1. it has been updated in one replica,\n\ + \032 2. it or any of its descendants has been updated in the other\n\ + \032 replica, and\n\ + \032 3. its contents in the two replicas are not identical.\n\ + \n\ + Reconciliation\n\ + \n\ + \032 Unison operates in several distinct stages:\n\ + \032 1. On each host, it compares its archive file (which records the\n\ + \032 state of each path in the replica when it was last synchronized)\n\ + \032 with the current contents of the replica, to determine which paths\n\ + \032 have been updated.\n\ + \032 2. It checks for \"false conflicts\" -- paths that have been updated on\n\ + \032 both replicas, but whose current values are identical. These paths\n\ + \032 are silently marked as synchronized in the archive files in both\n\ + \032 replicas.\n\ + \032 3. It displays all the updated paths to the user. For updates that do\n\ + \032 not conflict, it suggests a default action (propagating the new\n\ + \032 contents from the updated replica to the other). Conflicting\n\ + \032 updates are just displayed. The user is given an opportunity to\n\ + \032 examine the current state of affairs, change the default actions\n\ + \032 for nonconflicting updates, and choose actions for conflicting\n\ + \032 updates.\n\ + \032 4. It performs the selected actions, one at a time. Each action is\n\ + \032 performed by first transferring the new contents to a temporary\n\ + \032 file on the receiving host, then atomically moving them into\n\ + \032 place.\n\ + \032 5. It updates its archive files to reflect the new state of the\n\ + \032 replicas.\n\ + \n\ + ")) +:: + ("failures", ("Invariants", + "Invariants\n\ + \n\ + \032 Given the importance and delicacy of the job that it performs, it is\n\ + \032 important to understand both what a synchronizer does under normal\n\ + \032 conditions and what can happen under unusual conditions such as system\n\ + \032 crashes and communication failures.\n\ + \n\ + \032 Unison is careful to protect both its internal state and the state of\n\ + \032 the replicas at every point in this process. Specifically, the\n\ + \032 following guarantees are enforced:\n\ + \032 * At every moment, each path in each replica has either (1) its\n\ + \032 original contents (i.e., no change at all has been made to this\n\ + \032 path), or (2) its correct final contents (i.e., the value that the\n\ + \032 user expected to be propagated from the other replica).\n\ + \032 * At every moment, the information stored on disk about Unison's\n\ + \032 private state can be either (1) unchanged, or (2) updated to\n\ + \032 reflect those paths that have been successfully synchronized.\n\ + \n\ + \032 The upshot is that it is safe to interrupt Unison at any time, either\n\ + \032 manually or accidentally. [Caveat: the above is almost true there are\n\ + \032 occasionally brief periods where it is not (and, because of\n\ + \032 shortcoming of the Posix filesystem API, cannot be); in particular,\n\ + \032 when it is copying a file onto a directory or vice versa, it must\n\ + \032 first move the original contents out of the way. If Unison gets\n\ + \032 interrupted during one of these periods, some manual cleanup may be\n\ + \032 required. In this case, a file called DANGER.README will be left in\n\ + \032 your home directory, containing information about the operation that\n\ + \032 was interrupted. The next time you try to run Unison, it will notice\n\ + \032 this file and warn you about it.]\n\ + \n\ + \032 If an interruption happens while it is propagating updates, then there\n\ + \032 may be some paths for which an update has been propagated but which\n\ + \032 have not been marked as synchronized in Unison's archives. This is no\n\ + \032 problem: the next time Unison runs, it will detect changes to these\n\ + \032 paths in both replicas, notice that the contents are now equal, and\n\ + \032 mark the paths as successfully updated when it writes back its private\n\ + \032 state at the end of this run.\n\ + \n\ + \032 If Unison is interrupted, it may sometimes leave temporary working\n\ + \032 files (with suffix .tmp) in the replicas. It is safe to delete these\n\ + \032 files. Also, if the backups flag is set, Unison will leave around old\n\ + \032 versions of files that it overwrites, with names like\n\ + \032 file.0.unison.bak. These can be deleted safely when they are no longer\n\ + \032 wanted.\n\ + \n\ + \032 Unison is not bothered by clock skew between the different hosts on\n\ + \032 which it is running. It only performs comparisons between timestamps\n\ + \032 obtained from the same host, and the only assumption it makes about\n\ + \032 them is that the clock on each system always runs forward.\n\ + \n\ + \032 If Unison finds that its archive files have been deleted (or that the\n\ + \032 archive format has changed and they cannot be read, or that they don't\n\ + \032 exist because this is the first run of Unison on these particular\n\ + \032 roots), it takes a conservative approach: it behaves as though the\n\ + \032 replicas had both been completely empty at the point of the last\n\ + \032 synchronization. The effect of this is that, on the first run, files\n\ + \032 that exist in only one replica will be propagated to the other, while\n\ + \032 files that exist in both replicas but are unequal will be marked as\n\ + \032 conflicting.\n\ + \n\ + \032 Touching a file without changing its contents should never affect\n\ + \032 whether or not Unison does an update. (When running with the fastcheck\n\ + \032 preference set to true--the default on Unix systems--Unison uses file\n\ + \032 modtimes for a quick first pass to tell which files have definitely\n\ + \032 not changed; then, for each file that might have changed, it computes\n\ + \032 a fingerprint of the file's contents and compares it against the\n\ + \032 last-synchronized contents. Also, the -times option allows you to\n\ + \032 synchronize file times, but it does not cause identical files to be\n\ + \032 changed; Unison will only modify the file times.)\n\ + \n\ + \032 It is safe to \"brainwash\" Unison by deleting its archive files on both\n\ + \032 replicas. The next time it runs, it will assume that all the files it\n\ + \032 sees in the replicas are new.\n\ + \n\ + \032 It is safe to modify files while Unison is working. If Unison\n\ + \032 discovers that it has propagated an out-of-date change, or that the\n\ + \032 file it is updating has changed on the target replica, it will signal\n\ + \032 a failure for that file. Run Unison again to propagate the latest\n\ + \032 change.\n\ + \n\ + \032 Changes to the ignore patterns from the user interface (e.g., using\n\ + \032 the `i' key) are immediately reflected in the current profile.\n\ + \n\ + Caveats and Shortcomings\n\ + \n\ + \032 Here are some things to be careful of when using Unison.\n\ + \032 * In the interests of speed, the update detection algorithm may\n\ + \032 (depending on which OS architecture that you run Unison on)\n\ + \032 actually use an approximation to the definition given in the\n\ + \032 section \"What is an Update?\" .\n\ + \032 In particular, the Unix implementation does not compare the actual\n\ + \032 contents of files to their previous contents, but simply looks at\n\ + \032 each file's inode number and modtime; if neither of these have\n\ + \032 changed, then it concludes that the file has not been changed.\n\ + \032 Under normal circumstances, this approximation is safe, in the\n\ + \032 sense that it may sometimes detect \"false updates\" will never miss\n\ + \032 a real one. However, it is possible to fool it, for example by\n\ + \032 using retouch to change a file's modtime back to a time in the\n\ + \032 past.\n\ + \032 * If you synchronize between a single-user filesystem and a shared\n\ + \032 Unix server, you should pay attention to your permission bits: by\n\ + \032 default, Unison will synchronize permissions verbatim, which may\n\ + \032 leave group-writable files on the server that could be written\n\ + \032 over by a lot of people.\n\ + \032 You can control this by setting your umask on both computers to\n\ + \032 something like 022, masking out the \"world write\" and \"group\n\ + \032 write\" permission bits.\n\ + \032 Unison does not synchronize the setuid and setgid bits, for\n\ + \032 security.\n\ + \032 * The graphical user interface is single-threaded. This means that\n\ + \032 if Unison is performing some long-running operation, the display\n\ + \032 will not be repainted until it finishes. We recommend not trying\n\ + \032 to do anything with the user interface while Unison is in the\n\ + \032 middle of detecting changes or propagating files.\n\ + \032 * Unison does not understand hard links.\n\ + \032 * It is important to be a little careful when renaming directories\n\ + \032 containing \"ignore\"d files.\n\ + \032 For example, suppose Unison is synchronizing directory A between\n\ + \032 the two machines called the \"local\" and the \"remote\" machine;\n\ + \032 suppose directory A contains a subdirectory D; and suppose D on\n\ + \032 the local machine contains a file or subdirectory P that matches\n\ + \032 an ignore directive in the profile used to synchronize. Thus path\n\ + \032 A/D/P exists on the local machine but not on the remote machine.\n\ + \032 If D is renamed to D' on the remote machine, and this change is\n\ + \032 propagated to the local machine, all such files or subdirectories\n\ + \032 P will be deleted. This is because Unison sees the rename as a\n\ + \032 delete and a separate create: it deletes the old directory\n\ + \032 (including the ignored files) and creates a new one (not including\n\ + \032 the ignored files, since they are completely invisible to it).\n\ + \n\ + ")) +:: + ("", ("Reference Guide", + "Reference Guide\n\ + \n\ + \032 This section covers the features of Unison in detail.\n\ + \n\ + ")) +:: + ("running", ("Running Unison", + "Running Unison\n\ + \n\ + \032 There are several ways to start Unison.\n\ + \032 * Typing \"unison profile\" on the command line. Unison will look for\n\ + \032 a file profile.prf in the .unison directory. If this file does not\n\ + \032 specify a pair of roots, Unison will prompt for them and add them\n\ + \032 to the information specified by the profile.\n\ + \032 * Typing \"unison profile root1 root2\" on the command line. In this\n\ + \032 case, Unison will use profile, which should not contain any root\n\ + \032 directives.\n\ + \032 * Typing \"unison root1 root2\" on the command line. This has the same\n\ + \032 effect as typing \"unison default root1 root2.\"\n\ + \032 * Typing just \"unison\" (or invoking Unison by clicking on a desktop\n\ + \032 icon). In this case, Unison will ask for the profile to use for\n\ + \032 synchronization (or create a new one, if necessary).\n\ + \n\ + The .unison Directory\n\ + \n\ + \032 Unison stores a variety of information in a private directory on each\n\ + \032 host. If the environment variable UNISON is defined, then its value\n\ + \032 will be used as the name of this directory. If UNISON is not defined,\n\ + \032 then the name of the directory depends on which operating system you\n\ + \032 are using. In Unix, the default is to use $HOME/.unison. In Windows,\n\ + \032 if the environment variable USERPROFILE is defined, then the directory\n\ + \032 will be $USERPROFILE\\.unison; otherwise if HOME is defined, it will be\n\ + \032 $HOME\\.unison; otherwise, it will be c:\\.unison.\n\ + \n\ + \032 The archive file for each replica is found in the .unison directory on\n\ + \032 that replica's host. Profiles (described below) are always taken from\n\ + \032 the .unison directory on the client host.\n\ + \n\ + \032 Note that Unison maintains a completely different set of archive files\n\ + \032 for each pair of roots.\n\ + \n\ + \032 We do not recommend synchronizing the whole .unison directory, as this\n\ + \032 will involve frequent propagation of large archive files. It should be\n\ + \032 safe to do it, though, if you really want to. Synchronizing just the\n\ + \032 profile files in the .unison directory is definitely OK.\n\ + \n\ + Archive Files\n\ + \n\ + \032 The name of the archive file on each replica is calculated from\n\ + \032 * the canonical names of all the hosts (short names like saul are\n\ + \032 converted into full addresses like saul.cis.upenn.edu),\n\ + \032 * the paths to the replicas on all the hosts (again, relative\n\ + \032 pathnames, symbolic links, etc. are converted into full, absolute\n\ + \032 paths), and\n\ + \032 * an internal version number that is changed whenever a new Unison\n\ + \032 release changes the format of the information stored in the\n\ + \032 archive.\n\ + \n\ + \032 This method should work well for most users. However, it is\n\ + \032 occasionally useful to change the way archive names are generated.\n\ + \032 Unison provides two ways of doing this.\n\ + \n\ + \032 The function that finds the canonical hostname of the local host\n\ + \032 (which is used, for example, in calculating the name of the archive\n\ + \032 file used to remember which files have been synchronized) normally\n\ + \032 uses the gethostname operating system call. However, if the\n\ + \032 environment variable UNISONLOCALHOSTNAME is set, its value will be\n\ + \032 used instead. This makes it easier to use Unison in situations where a\n\ + \032 machine's name changes frequently (e.g., because it is a laptop and\n\ + \032 gets moved around a lot).\n\ + \n\ + \032 A more powerful way of changing archive names is provided by the\n\ + \032 rootalias preference. The preference file may contain any number of\n\ + \032 lines of the form:\n\ + \032 rootalias = //hostnameA//path-to-replicaA -> //hostnameB//path-to-replicaB\n\ + \n\ + \032 When calculating the name of the archive files for a given pair of\n\ + \032 roots, Unison replaces any root that matches the left-hand side of any\n\ + \032 rootalias rule by the corresponding right-hand side.\n\ + \n\ + \032 So, if you need to relocate a root on one of the hosts, you can add a\n\ + \032 rule of the form:\n\ + \032 rootalias = //new-hostname//new-path -> //old-hostname//old-path\n\ + \n\ + \032 Warning: The rootalias option is dangerous and should only be used if\n\ + \032 you are sure you know what you're doing. In particular, it should only\n\ + \032 be used if you are positive that either (1) both the original root and\n\ + \032 the new alias refer to the same set of files, or (2) the files have\n\ + \032 been relocated so that the original name is now invalid and will never\n\ + \032 be used again. (If the original root and the alias refer to different\n\ + \032 sets of files, Unison's update detector could get confused.) After\n\ + \032 introducing a new rootalias, it is a good idea to run Unison a few\n\ + \032 times interactively (with the batch flag off, etc.) and carefully\n\ + \032 check that things look reasonable--in particular, that update\n\ + \032 detection is working as expected.\n\ + \n\ + Preferences\n\ + \n\ + \032 Many details of Unison's behavior are configurable by user-settable\n\ + \032 \"preferences.\"\n\ + \n\ + \032 Some preferences are boolean-valued; these are often called flags.\n\ + \032 Others take numeric or string arguments, indicated in the preferences\n\ + \032 list by n or xxx. Most of the string preferences can be given several\n\ + \032 times; the arguments are accumulated into a list internally.\n\ + \n\ + \032 There are two ways to set the values of preferences: temporarily, by\n\ + \032 providing command-line arguments to a particular run of Unison, or\n\ + \032 permanently, by adding commands to a profile in the .unison directory\n\ + \032 on the client host. The order of preferences (either on the command\n\ + \032 line or in preference files) is not significant. On the command line,\n\ + \032 preferences and other arguments (the profile name and roots) can be\n\ + \032 intermixed in any order.\n\ + \n\ + \032 To set the value of a preference p from the command line, add an\n\ + \032 argument -p (for a boolean flag) or -p n or -p xxx (for a numeric or\n\ + \032 string preference) anywhere on the command line. To set a boolean flag\n\ + \032 to false on the command line, use -p=false.\n\ + \n\ + \032 Here are all the preferences supported by Unison. This list can be\n\ + \032 obtained by typing unison -help.\n\ + \n\ + Usage: unison [options]\n\ + \032 or unison root1 root2 [options]\n\ + \032 or unison profilename [options]\n\ + \n\ + Basic options:\n\ + \032-auto automatically accept default (nonconflicting) actions\n\ + \032-batch batch mode: ask no questions at all\n\ + \032-doc xxx show documentation ('-doc topics' lists topics)\n\ + \032-follow xxx add a pattern to the follow list\n\ + \032-force xxx force changes from this replica to the other\n\ + \032-group synchronize group attributes\n\ + \032-ignore xxx add a pattern to the ignore list\n\ + \032-ignorenot xxx add a pattern to the ignorenot list\n\ + \032-owner synchronize owner\n\ + \032-path xxx path to synchronize\n\ + \032-perms n part of the permissions which is synchronized\n\ + \032-prefer xxx choose this replica's version for conflicting changes\n\ + \032-root xxx root of a replica (should be used exactly twice)\n\ + \032-silent print nothing except error messages\n\ + \032-terse suppress status messages\n\ + \032-testserver exit immediately after the connection to the server\n\ + \032-times synchronize modification times\n\ + \032-version print version and exit\n\ + \n\ + Advanced options:\n\ + \032-addprefsto xxx file to add new prefs to\n\ + \032-addversionno add version number to name of unison on server\n\ + \032-backup xxx add a pattern to the backup list\n\ + \032-backupcurr xxx add a pattern to the backupcurr list\n\ + \032-backupcurrnot xxx add a pattern to the backupcurrnot list\n\ + \032-backupdir xxx directory for storing centralized backups\n\ + \032-backuploc xxx where backups are stored ('local' or 'central')\n\ + \032-backupnot xxx add a pattern to the backupnot list\n\ + \032-backupprefix xxx prefix for the names of backup files\n\ + \032-backups keep backup copies of all files (see also 'backup')\n\ + \032-backupsuffix xxx a suffix to be added to names of backup files\n\ + \032-confirmbigdel ask about whole-replica (or path) deletes (default true)\n\ + \032-confirmmerge ask for confirmation before commiting results of a merge\n\ + \032-contactquietly suppress the 'contacting server' message during startup\n\ + \032-copyprog xxx external program for copying large files\n\ + \032-copyprogrest xxx variant of copyprog for resuming partial transfers\n\ + \032-copyquoterem xxx add quotes to remote file name for copyprog (true/false/def\n\ + ault)\n\ + \032-copythreshold n use copyprog on files bigger than this (if >=0, in Kb)\n\ + \032-debug xxx debug module xxx ('all' -> everything, 'verbose' -> more)\n\ + \032-diff xxx command for showing differences between files\n\ + \032-dontchmod When set, never use the chmod system call\n\ + \032-dumbtty do not change terminal settings in text UI\n\ + \032-fastcheck xxx do fast update detection (true/false/default)\n\ + \032-forcepartial xxx add a pattern to the forcepartial list\n\ + \032-height n height (in lines) of main window in graphical interface\n\ + \032-host xxx bind the socket to this host name in server socket mode\n\ + \032-ignorecase xxx identify upper/lowercase filenames (true/false/default)\n\ + \032-ignorelocks ignore locks left over from previous run (dangerous!)\n\ + \032-immutable xxx add a pattern to the immutable list\n\ + \032-immutablenot xxx add a pattern to the immutablenot list\n\ + \032-key xxx define a keyboard shortcut for this profile (in some UIs)\n\ + \032-killserver kill server when done (even when using sockets)\n\ + \032-label xxx provide a descriptive string label for this profile\n\ + \032-log record actions in logfile (default true)\n\ + \032-logfile xxx logfile name\n\ + \032-maxbackups n number of backed up versions of a file\n\ + \032-maxthreads n maximum number of simultaneous file transfers\n\ + \032-merge xxx add a pattern to the merge list\n\ + \032-mountpoint xxx abort if this path does not exist\n\ + \032-numericids don't map uid/gid values by user/group names\n\ + \032-preferpartial xxx add a pattern to the preferpartial list\n\ + \032-pretendwin Use creation times for detecting updates\n\ + \032-repeat xxx synchronize repeatedly (text interface only)\n\ + \032-retry n re-try failed synchronizations N times (text ui only)\n\ + \032-rootalias xxx register alias for canonical root names\n\ + \032-rsrc xxx synchronize resource forks (true/false/default)\n\ + \032-rsync activate the rsync transfer mode (default true)\n\ + \032-selftest run internal tests and exit\n\ + \032-servercmd xxx name of unison executable on remote server\n\ + \032-showarchive show 'true names' (for rootalias) of roots and archive\n\ + \032-socket xxx act as a server on a socket\n\ + \032-sortbysize list changed files by size, not name\n\ + \032-sortfirst xxx add a pattern to the sortfirst list\n\ + \032-sortlast xxx add a pattern to the sortlast list\n\ + \032-sortnewfirst list new before changed files\n\ + \032-sshargs xxx other arguments (if any) for remote shell command\n\ + \032-sshcmd xxx path to the ssh executable\n\ + \032-ui xxx select UI ('text' or 'graphic'); command-line only\n\ + \032-xferbycopying optimize transfers using local copies (default true)\n\ + \n\ + \032 Here, in more detail, is what they do. Many are discussed in greater\n\ + \032 detail in other sections of the manual.\n\ + \032 addprefsto xxx\n\ + \032 By default, new preferences added by Unison (e.g., new ignore\n\ + \032 clauses) will be appended to whatever preference file Unison\n\ + \032 was told to load at the beginning of the run. Setting the\n\ + \032 preference addprefsto filename makes Unison add new preferences\n\ + \032 to the file named filename instead.\n\ + \032 addversionno \n\ + \032 When this flag is set to true, Unison will use\n\ + \032 unison-currentversionnumber instead of just unison as the\n\ + \032 remote server command. This allows multiple binaries for\n\ + \032 different versions of unison to coexist conveniently on the\n\ + \032 same server: whichever version is run on the client, the same\n\ + \032 version will be selected on the server.\n\ + \032 auto \n\ + \032 When set to true, this flag causes the user interface to skip\n\ + \032 asking for confirmations on non-conflicting changes. (More\n\ + \032 precisely, when the user interface is done setting the\n\ + \032 propagation direction for one entry and is about to move to the\n\ + \032 next, it will skip over all non-conflicting entries and go\n\ + \032 directly to the next conflict.)\n\ + \032 backup xxx\n\ + \032 Including the preference -backup pathspec causes Unison to keep\n\ + \032 backup files for each path that matches pathspec. These backup\n\ + \032 files are kept in the directory specified by the backuplocation\n\ + \032 preference. The backups are named according to the backupprefix\n\ + \032 and backupsuffix preferences. The number of versions that are\n\ + \032 kept is determined by the maxbackups preference.\n\ + \032 The syntax of pathspec is described in the section \"Path\n\ + \032 Specification\" .\n\ + \032 backupcurr xxx\n\ + \032 Including the preference -backupcurr pathspec causes Unison to\n\ + \032 keep a backup of the current version of every file matching\n\ + \032 pathspec. This file will be saved as a backup with version\n\ + \032 number 000. Such backups can be used as inputs to external\n\ + \032 merging programs, for instance. See the documentatation for the\n\ + \032 merge preference. For more details, see the section \"Merging\n\ + \032 Conflicting Versions\" .\n\ + \032 The syntax of pathspec is described in the section \"Path\n\ + \032 Specification\" .\n\ + \032 backupcurrnot xxx\n\ + \032 Exceptions to backupcurr, like the ignorenot preference.\n\ + \032 backupdir xxx\n\ + \032 If this preference is set, Unison will use it as the name of\n\ + \032 the directory used to store backup files specified by the\n\ + \032 backup preference, when backuplocation is set to central. It is\n\ + \032 checked after the UNISONBACKUPDIR environment variable.\n\ + \032 backuploc xxx\n\ + \032 This preference determines whether backups should be kept\n\ + \032 locally, near the original files, or in a central directory\n\ + \032 specified by the backupdir preference. If set to local, backups\n\ + \032 will be kept in the same directory as the original files, and\n\ + \032 if set to central, backupdir will be used instead.\n\ + \032 backupnot xxx\n\ + \032 The values of this preference specify paths or individual files\n\ + \032 or regular expressions that should not be backed up, even if\n\ + \032 the backup preference selects them--i.e., it selectively\n\ + \032 overrides backup. The same caveats apply here as with ignore\n\ + \032 and t ignorenot.\n\ + \032 backupprefix xxx\n\ + \032 When a backup for a file NAME is created, it is stored in a\n\ + \032 directory specified by backuplocation, in a file called\n\ + \032 backupprefixNAMEbackupsuffix. backupprefix can include a\n\ + \032 directory name (causing Unison to keep all backup files for a\n\ + \032 given directory in a subdirectory with this name), and both\n\ + \032 backupprefix and backupsuffix can contain the string$VERSION,\n\ + \032 which will be replaced by the age of the backup (1 for the most\n\ + \032 recent, 2 for the second most recent, and so on...). This\n\ + \032 keyword is ignored if it appears in a directory name in the\n\ + \032 prefix; if it does not appear anywhere in the prefix or the\n\ + \032 suffix, it will be automatically placed at the beginning of the\n\ + \032 suffix.\n\ + \032 One thing to be careful of: If the backuploc preference is set\n\ + \032 to local, Unison will automatically ignore all files whose\n\ + \032 prefix and suffix match backupprefix and backupsuffix. So be\n\ + \032 careful to choose values for these preferences that are\n\ + \032 sufficiently different from the names of your real files.\n\ + \032 backups \n\ + \032 Setting this flag to true is equivalent to setting\n\ + \032 backuplocation to local and backup to Name *.\n\ + \032 backupsuffix xxx\n\ + \032 See backupprefix for full documentation.\n\ + \032 batch \n\ + \032 When this is set to true, the user interface will ask no\n\ + \032 questions at all. Non-conflicting changes will be propagated;\n\ + \032 conflicts will be skipped.\n\ + \032 confirmbigdel \n\ + \032 !When this is set to true, Unison will request an extra\n\ + \032 confirmation if it appears that the entire replica has been\n\ + \032 deleted, before propagating the change. If the batch flag is\n\ + \032 also set, synchronization will be aborted. When the path\n\ + \032 preference is used, the same confirmation will be requested for\n\ + \032 top-level paths. (At the moment, this flag only affects the\n\ + \032 text user interface.) See also the mountpoint preference.\n\ + \032 confirmmerge \n\ + \032 Setting this preference causes both the text and graphical\n\ + \032 interfaces to ask the user if the results of a merge command\n\ + \032 may be commited to the replica or not. Since the merge command\n\ + \032 works on temporary files, the user can then cancel all the\n\ + \032 effects of applying the merge if it turns out that the result\n\ + \032 is not satisfactory. In batch-mode, this preference has no\n\ + \032 effect. Default is false.\n\ + \032 contactquietly \n\ + \032 If this flag is set, Unison will skip displaying the\n\ + \032 `Contacting server' message (which some users find annoying)\n\ + \032 during startup.\n\ + \032 copyprog xxx\n\ + \032 A string giving the name of an external program that can be\n\ + \032 used to copy large files efficiently (plus command-line\n\ + \032 switches telling it to copy files in-place). The default\n\ + \032 setting invokes rsync with appropriate options--most users\n\ + \032 should not need to change it.\n\ + \032 copyprogrest xxx\n\ + \032 A variant of copyprog that names an external program that\n\ + \032 should be used to continue the transfer of a large file that\n\ + \032 has already been partially transferred. Typically, copyprogrest\n\ + \032 will just be copyprog with one extra option (e.g., -partial,\n\ + \032 for rsync). The default setting invokes rsync with appropriate\n\ + \032 options--most users should not need to change it.\n\ + \032 copyquoterem xxx\n\ + \032 When set to true, this flag causes Unison to add an extra layer\n\ + \032 of quotes to the remote path passed to the external copy\n\ + \032 program. This is needed by rsync, for example, which internally\n\ + \032 uses an ssh connection requiring an extra level of quoting for\n\ + \032 paths containing spaces. When this flag is set to default,\n\ + \032 extra quotes are added if the value of copyprog contains the\n\ + \032 string rsync.\n\ + \032 copythreshold n\n\ + \032 A number indicating above what filesize (in kilobytes) Unison\n\ + \032 should use the external copying utility specified by copyprog.\n\ + \032 Specifying 0 will cause all copies to use the external program;\n\ + \032 a negative number will prevent any files from using it. The\n\ + \032 default is -1. See the section \"Making Unison Faster on Large\n\ + \032 Files\" for more information.\n\ + \032 debug xxx\n\ + \032 This preference is used to make Unison print various sorts of\n\ + \032 information about what it is doing internally on the standard\n\ + \032 error stream. It can be used many times, each time with the\n\ + \032 name of a module for which debugging information should be\n\ + \032 printed. Possible arguments for debug can be found by looking\n\ + \032 for calls to Util.debug in the sources (using, e.g., grep).\n\ + \032 Setting -debug all causes information from all modules to be\n\ + \032 printed (this mode of usage is the first one to try, if you are\n\ + \032 trying to understand something that Unison seems to be doing\n\ + \032 wrong); -debug verbose turns on some additional debugging\n\ + \032 output from some modules (e.g., it will show exactly what bytes\n\ + \032 are being sent across the network).\n\ + \032 diff xxx\n\ + \032 This preference can be used to control the name and\n\ + \032 command-line arguments of the system utility used to generate\n\ + \032 displays of file differences. The default is `diff -u CURRENT2\n\ + \032 CURRENT1'. If the value of this preference contains the\n\ + \032 substrings CURRENT1 and CURRENT2, these will be replaced by the\n\ + \032 names of the files to be diffed. If not, the two filenames will\n\ + \032 be appended to the command. In both cases, the filenames are\n\ + \032 suitably quoted.\n\ + \032 doc xxx\n\ + \032 The command-line argument -doc secname causes unison to display\n\ + \032 section secname of the manual on the standard output and then\n\ + \032 exit. Use -doc all to display the whole manual, which includes\n\ + \032 exactly the same information as the printed and HTML manuals,\n\ + \032 modulo formatting. Use -doc topics to obtain a list of the\n\ + \032 names of the various sections that can be printed.\n\ + \032 dontchmod \n\ + \032 By default, Unison uses the 'chmod' system call to set the\n\ + \032 permission bits of files after it has copied them. But in some\n\ + \032 circumstances (and under some operating systems), the chmod\n\ + \032 call always fails. Setting this preference completely prevents\n\ + \032 Unison from ever calling chmod.\n\ + \032 dumbtty \n\ + \032 When set to true, this flag makes the text mode user interface\n\ + \032 avoid trying to change any of the terminal settings. (Normally,\n\ + \032 Unison puts the terminal in `raw mode', so that it can do\n\ + \032 things like overwriting the current line.) This is useful, for\n\ + \032 example, when Unison runs in a shell inside of Emacs.\n\ + \032 When dumbtty is set, commands to the user interface need to be\n\ + \032 followed by a carriage return before Unison will execute them.\n\ + \032 (When it is off, Unison recognizes keystrokes as soon as they\n\ + \032 are typed.)\n\ + \032 This preference has no effect on the graphical user interface.\n\ + \032 dumparchives \n\ + \032 When this preference is set, Unison will create a file\n\ + \032 unison.dump on each host, containing a text summary of the\n\ + \032 archive, immediately after loading it.\n\ + \032 fastcheck xxx\n\ + \032 When this preference is set to true, Unison will use the\n\ + \032 modification time and length of a file as a `pseudo inode\n\ + \032 number' when scanning replicas for updates, instead of reading\n\ + \032 the full contents of every file. Under Windows, this may cause\n\ + \032 Unison to miss propagating an update if the modification time\n\ + \032 and length of the file are both unchanged by the update.\n\ + \032 However, Unison will never overwrite such an update with a\n\ + \032 change from the other replica, since it always does a safe\n\ + \032 check for updates just before propagating a change. Thus, it is\n\ + \032 reasonable to use this switch under Windows most of the time\n\ + \032 and occasionally run Unison once with fastcheck set to false,\n\ + \032 if you are worried that Unison may have overlooked an update.\n\ + \032 The default value of the preference is auto, which causes\n\ + \032 Unison to use fast checking on Unix replicas (where it is safe)\n\ + \032 and slow checking on Windows replicas. For backward\n\ + \032 compatibility, yes, no, and default can be used in place of\n\ + \032 true, false, and auto. See the section \"Fast Checking\" for more\n\ + \032 information.\n\ + \032 follow xxx\n\ + \032 Including the preference -follow pathspec causes Unison to\n\ + \032 treat symbolic links matching pathspec as `invisible' and\n\ + \032 behave as if the object pointed to by the link had appeared\n\ + \032 literally at this position in the replica. See the section\n\ + \032 \"Symbolic Links\" for more details. The syntax of pathspec> is\n\ + \032 described in the section \"Path Specification\" .\n\ + \032 force xxx\n\ + \032 Including the preference -force root causes Unison to resolve\n\ + \032 all differences (even non-conflicting changes) in favor of\n\ + \032 root. This effectively changes Unison from a synchronizer into\n\ + \032 a mirroring utility.\n\ + \032 You can also specify -force newer (or -force older) to force\n\ + \032 Unison to choose the file with the later (earlier) modtime. In\n\ + \032 this case, the -times preference must also be enabled.\n\ + \032 This preference is overridden by the forcepartial preference.\n\ + \032 This preference should be used only if you are sure you know\n\ + \032 what you are doing!\n\ + \032 forcepartial xxx\n\ + \032 Including the preference forcepartial PATHSPEC -> root causes\n\ + \032 Unison to resolve all differences (even non-conflicting\n\ + \032 changes) in favor of root for the files in PATHSPEC (see the\n\ + \032 section \"Path Specification\" for more information). This\n\ + \032 effectively changes Unison from a synchronizer into a mirroring\n\ + \032 utility.\n\ + \032 You can also specify forcepartial PATHSPEC -> newer (or\n\ + \032 forcepartial PATHSPEC older) to force Unison to choose the file\n\ + \032 with the later (earlier) modtime. In this case, the -times\n\ + \032 preference must also be enabled.\n\ + \032 This preference should be used only if you are sure you know\n\ + \032 what you are doing!\n\ + \032 group \n\ + \032 When this flag is set to true, the group attributes of the\n\ + \032 files are synchronized. Whether the group names or the group\n\ + \032 identifiers are synchronizeddepends on the preference numerids.\n\ + \032 height n\n\ + \032 Used to set the height (in lines) of the main window in the\n\ + \032 graphical user interface.\n\ + \032 ignore xxx\n\ + \032 Including the preference -ignore pathspec causes Unison to\n\ + \032 completely ignore paths that match pathspec (as well as their\n\ + \032 children). This is useful for avoiding synchronizing temporary\n\ + \032 files, object files, etc. The syntax of pathspec is described\n\ + \032 in the section \"Path Specification\" , and further details on\n\ + \032 ignoring paths is found in the section \"Ignoring Paths\" .\n\ + \032 ignorecase xxx\n\ + \032 When set to true, this flag causes Unison to treat filenames as\n\ + \032 case insensitive--i.e., files in the two replicas whose names\n\ + \032 differ in (upper- and lower-case) `spelling' are treated as the\n\ + \032 same file. When the flag is set to false, Unison will treat all\n\ + \032 filenames as case sensitive. Ordinarily, when the flag is set\n\ + \032 to default, filenames are automatically taken to be\n\ + \032 case-insensitive if either host is running Windows or OSX. In\n\ + \032 rare circumstances it is useful to set the flag manually (e.g.\n\ + \032 when running Unison on a Unix system with a FAT [Windows]\n\ + \032 volume mounted).\n\ + \032 ignorelocks \n\ + \032 When this preference is set, Unison will ignore any lock files\n\ + \032 that may have been left over from a previous run of Unison that\n\ + \032 was interrupted while reading or writing archive files; by\n\ + \032 default, when Unison sees these lock files it will stop and\n\ + \032 request manual intervention. This option should be set only if\n\ + \032 you are positive that no other instance of Unison might be\n\ + \032 concurrently accessing the same archive files (e.g., because\n\ + \032 there was only one instance of unison running and it has just\n\ + \032 crashed or you have just killed it). It is probably not a good\n\ + \032 idea to set this option in a profile: it is intended for\n\ + \032 command-line use.\n\ + \032 ignorenot xxx\n\ + \032 This preference overrides the preference ignore. It gives a\n\ + \032 list of patterns (in the same format as ignore) for paths that\n\ + \032 should definitely not be ignored, whether or not they happen to\n\ + \032 match one of the ignore patterns.\n\ + \032 Note that the semantics of ignore and ignorenot is a little\n\ + \032 counter-intuitive. When detecting updates, Unison examines\n\ + \032 paths in depth-first order, starting from the roots of the\n\ + \032 replicas and working downwards. Before examining each path, it\n\ + \032 checks whether it matches ignore and does not match ignorenot;\n\ + \032 in this case it skips this path and all its descendants. This\n\ + \032 means that, if some parent of a given path matches an ignore\n\ + \032 pattern, then it will be skipped even if the path itself\n\ + \032 matches an ignorenot pattern. In particular, putting ignore =\n\ + \032 Path * in your profile and then using t ignorenot to select\n\ + \032 particular paths to be synchronized will not work. Instead, you\n\ + \032 should use the path preference to choose particular paths to\n\ + \032 synchronize.\n\ + \032 immutable xxx\n\ + \032 This preference specifies paths for directories whose immediate\n\ + \032 children are all immutable files -- i.e., once a file has been\n\ + \032 created, its contents never changes. When scanning for updates,\n\ + \032 Unison does not check whether these files have been modified;\n\ + \032 this can speed update detection significantly (in particular,\n\ + \032 for mail directories).\n\ + \032 immutablenot xxx\n\ + \032 This preference overrides immutable.\n\ + \032 key xxx\n\ + \032 Used in a profile to define a numeric key (0-9) that can be\n\ + \032 used in the graphical user interface to switch immediately to\n\ + \032 this profile.\n\ + \032 killserver \n\ + \032 When set to true, this flag causes Unison to kill the remote\n\ + \032 server process when the synchronization is finished. This\n\ + \032 behavior is the default for ssh connections, so this preference\n\ + \032 is not normally needed when running over ssh; it is provided so\n\ + \032 that socket-mode servers can be killed off after a single run\n\ + \032 of Unison, rather than waiting to accept future connections.\n\ + \032 (Some users prefer to start a remote socket server for each run\n\ + \032 of Unison, rather than leaving one running all the time.)\n\ + \032 label xxx\n\ + \032 Used in a profile to provide a descriptive string documenting\n\ + \032 its settings. (This is useful for users that switch between\n\ + \032 several profiles, especially using the `fast switch' feature of\n\ + \032 the graphical user interface.)\n\ + \032 log \n\ + \032 When this flag is set, Unison will log all changes to the\n\ + \032 filesystems on a file.\n\ + \032 logfile xxx\n\ + \032 By default, logging messages will be appended to the file\n\ + \032 unison.log in your HOME directory. Set this preference if you\n\ + \032 prefer another file.\n\ + \032 maxbackups n\n\ + \032 This preference specifies the number of backup versions that\n\ + \032 will be kept by unison, for each path that matches the\n\ + \032 predicate backup. The default is 2.\n\ + \032 maxthreads n\n\ + \032 This preference controls how much concurrency is allowed during\n\ + \032 the transport phase. Normally, it should be set reasonably high\n\ + \032 (default is 20) to maximize performance, but when Unison is\n\ + \032 used over a low-bandwidth link it may be helpful to set it\n\ + \032 lower (e.g. to 1) so that Unison doesn't soak up all the\n\ + \032 available bandwidth.\n\ + \032 merge xxx\n\ + \032 This preference can be used to run a merge program which will\n\ + \032 create a new version for each of the files and the backup, with\n\ + \032 the last backup and the both replicas. Setting the merge\n\ + \032 preference for a path will also cause this path to be backed\n\ + \032 up, just like t backup. The syntax of pathspec>cmd is described\n\ + \032 in the section \"Path Specification\" , and further details on\n\ + \032 Merging functions are present in the section \"Merging files\" .\n\ + \032 mountpoint xxx\n\ + \032 Including the preference -mountpoint PATH causes Unison to\n\ + \032 double-check, at the end of update detection, that PATH exists\n\ + \032 and abort if it does not. This is useful when Unison is used to\n\ + \032 synchronize removable media. This preference can be given more\n\ + \032 than once. See the section \"Mount Points\" .\n\ + \032 numericids \n\ + \032 When this flag is set to true, groups and users are\n\ + \032 synchronized numerically, rather than by name.\n\ + \032 The special uid 0 and the special group 0 are never mapped via\n\ + \032 user/group names even if this preference is not set.\n\ + \032 owner \n\ + \032 When this flag is set to true, the owner attributes of the\n\ + \032 files are synchronized. Whether the owner names or the owner\n\ + \032 identifiers are synchronizeddepends on the preference\n\ + \032 extttnumerids.\n\ + \032 path xxx\n\ + \032 When no path preference is given, Unison will simply\n\ + \032 synchronize the two entire replicas, beginning from the given\n\ + \032 pair of roots. If one or more path preferences are given, then\n\ + \032 Unison will synchronize only these paths and their children.\n\ + \032 (This is useful for doing a fast sync of just one directory,\n\ + \032 for example.) Note that path preferences are intepreted\n\ + \032 literally--they are not regular expressions.\n\ + \032 perms n\n\ + \032 The integer value of this preference is a mask indicating which\n\ + \032 permission bits should be synchronized. It is set by default to\n\ + \032 0o1777: all bits but the set-uid and set-gid bits are\n\ + \032 synchronised (synchronizing theses latter bits can be a\n\ + \032 security hazard). If you want to synchronize all bits, you can\n\ + \032 set the value of this preference to -1.\n\ + \032 prefer xxx\n\ + \032 Including the preference -prefer root causes Unison always to\n\ + \032 resolve conflicts in favor of root, rather than asking for\n\ + \032 guidance from the user. (The syntax of root is the same as for\n\ + \032 the root preference, plus the special values newer and older.)\n\ + \032 This preference is overridden by the preferpartial preference.\n\ + \032 This preference should be used only if you are sure you know\n\ + \032 what you are doing!\n\ + \032 preferpartial xxx\n\ + \032 Including the preference preferpartial PATHSPEC -> root causes\n\ + \032 Unison always to resolve conflicts in favor of root, rather\n\ + \032 than asking for guidance from the user, for the files in\n\ + \032 PATHSPEC (see the section \"Path Specification\" for more\n\ + \032 information). (The syntax of root is the same as for the root\n\ + \032 preference, plus the special values newer and older.)\n\ + \032 This preference should be used only if you are sure you know\n\ + \032 what you are doing!\n\ + \032 pretendwin \n\ + \032 When set to true, this preference makes Unison use\n\ + \032 Windows-style fast update detection (using file creation times\n\ + \032 as \"pseudo-inode-numbers\"), even when running on a Unix system.\n\ + \032 This switch should be used with care, as it is less safe than\n\ + \032 the standard update detection method, but it can be useful for\n\ + \032 synchronizing VFAT filesystems (which do not support inode\n\ + \032 numbers) mounted on Unix systems. The fastcheck option should\n\ + \032 also be set to true.\n\ + \032 repeat xxx\n\ + \032 Setting this preference causes the text-mode interface to\n\ + \032 synchronize repeatedly, rather than doing it just once and\n\ + \032 stopping. If the argument is a number, Unison will pause for\n\ + \032 that many seconds before beginning again.\n\ + \032 retry n\n\ + \032 Setting this preference causes the text-mode interface to try\n\ + \032 again to synchronize updated paths where synchronization fails.\n\ + \032 Each such path will be tried N times.\n\ + \032 root xxx\n\ + \032 Each use of this preference names the root of one of the\n\ + \032 replicas for Unison to synchronize. Exactly two roots are\n\ + \032 needed, so normal modes of usage are either to give two values\n\ + \032 for root in the profile, or to give no values in the profile\n\ + \032 and provide two on the command line. Details of the syntax of\n\ + \032 roots can be found in the section \"Roots\" .\n\ + \032 The two roots can be given in either order; Unison will sort\n\ + \032 them into a canonical order before doing anything else. It also\n\ + \032 tries to `canonize' the machine names and paths that appear in\n\ + \032 the roots, so that, if Unison is invoked later with a slightly\n\ + \032 different name for the same root, it will be able to locate the\n\ + \032 correct archives.\n\ + \032 rootalias xxx\n\ + \032 When calculating the name of the archive files for a given pair\n\ + \032 of roots, Unison replaces any roots matching the left-hand side\n\ + \032 of any rootalias rule by the corresponding right-hand side.\n\ + \032 rshargs xxx\n\ + \032 The string value of this preference will be passed as\n\ + \032 additional arguments (besides the host name and the name of the\n\ + \032 Unison executable on the remote system) to the rsh command used\n\ + \032 to invoke the remote server.\n\ + \032 rshcmd xxx\n\ + \032 This preference can be used to explicitly set the name of the\n\ + \032 rsh executable (e.g., giving a full path name), if necessary.\n\ + \032 rsrc xxx\n\ + \032 When set to true, this flag causes Unison to synchronize\n\ + \032 resource forks and HFS meta-data. On filesystems that do not\n\ + \032 natively support resource forks, this data is stored in\n\ + \032 Carbon-compatible ._ AppleDouble files. When the flag is set to\n\ + \032 false, Unison will not synchronize these data. Ordinarily, the\n\ + \032 flag is set to default, and these data are automatically\n\ + \032 synchronized if either host is running OSX. In rare\n\ + \032 circumstances it is useful to set the flag manually.\n\ + \032 rsync \n\ + \032 Unison uses the 'rsync algorithm' for 'diffs-only' transfer of\n\ + \032 updates to large files. Setting this flag to false makes Unison\n\ + \032 use whole-file transfers instead. Under normal circumstances,\n\ + \032 there is no reason to do this, but if you are having trouble\n\ + \032 with repeated 'rsync failure' errors, setting it to false\n\ + \032 should permit you to synchronize the offending files.\n\ + \032 selftest \n\ + \032 Run internal tests and exit. This option is mostly for\n\ + \032 developers and must be used carefully: in particular, it will\n\ + \032 delete the contents of both roots, so that it can install its\n\ + \032 own files for testing. This flag only makes sense on the\n\ + \032 command line. When it is provided, no preference file is read:\n\ + \032 all preferences must be specified on thecommand line. Also,\n\ + \032 since the self-test procedure involves overwriting the roots\n\ + \032 and backup directory, the names of the roots and of the\n\ + \032 backupdir preference must include the string \"test\" or else the\n\ + \032 tests will be aborted. (If these are not given on the command\n\ + \032 line, dummy subdirectories in the current directory will be\n\ + \032 created automatically.)\n\ + \032 servercmd xxx\n\ + \032 This preference can be used to explicitly set the name of the\n\ + \032 Unison executable on the remote server (e.g., giving a full\n\ + \032 path name), if necessary.\n\ + \032 showarchive \n\ + \032 When this preference is set, Unison will print out the 'true\n\ + \032 names'of the roots, in the same form as is expected by the\n\ + \032 rootaliaspreference.\n\ + \032 silent \n\ + \032 When this preference is set to true, the textual user interface\n\ + \032 will print nothing at all, except in the case of errors.\n\ + \032 Setting silent to true automatically sets the batch preference\n\ + \032 to true.\n\ + \032 sortbysize \n\ + \032 When this flag is set, the user interface will list changed\n\ + \032 files by size (smallest first) rather than by name. This is\n\ + \032 useful, for example, for synchronizing over slow links, since\n\ + \032 it puts very large files at the end of the list where they will\n\ + \032 not prevent smaller files from being transferred quickly.\n\ + \032 This preference (as well as the other sorting flags, but not\n\ + \032 the sorting preferences that require patterns as arguments) can\n\ + \032 be set interactively and temporarily using the 'Sort' menu in\n\ + \032 the graphical user interface.\n\ + \032 sortfirst xxx\n\ + \032 Each argument to sortfirst is a pattern pathspec, which\n\ + \032 describes a set of paths. Files matching any of these patterns\n\ + \032 will be listed first in the user interface. The syntax of\n\ + \032 pathspec is described in the section \"Path Specification\" .\n\ + \032 sortlast xxx\n\ + \032 Similar to sortfirst, except that files matching one of these\n\ + \032 patterns will be listed at the very end.\n\ + \032 sortnewfirst \n\ + \032 When this flag is set, the user interface will list newly\n\ + \032 created files before all others. This is useful, for example,\n\ + \032 for checking that newly created files are not `junk', i.e.,\n\ + \032 ones that should be ignored or deleted rather than\n\ + \032 synchronized.\n\ + \032 sshargs xxx\n\ + \032 The string value of this preference will be passed as\n\ + \032 additional arguments (besides the host name and the name of the\n\ + \032 Unison executable on the remote system) to the ssh command used\n\ + \032 to invoke the remote server.\n\ + \032 sshcmd xxx\n\ + \032 This preference can be used to explicitly set the name of the\n\ + \032 ssh executable (e.g., giving a full path name), if necessary.\n\ + \032 sshversion xxx\n\ + \032 This preference can be used to control which version of ssh\n\ + \032 should be used to connect to the server. Legal values are 1 and\n\ + \032 2, which will cause unison to try to use ssh1 orssh2 instead of\n\ + \032 just ssh to invoke ssh. The default value is empty, which will\n\ + \032 make unison use whatever version of ssh is installed as the\n\ + \032 default `ssh' command.\n\ + \032 terse \n\ + \032 When this preference is set to true, the user interface will\n\ + \032 not print status messages.\n\ + \032 testserver \n\ + \032 Setting this flag on the command line causes Unison to attempt\n\ + \032 to connect to the remote server and, if successful, print a\n\ + \032 message and immediately exit. Useful for debugging installation\n\ + \032 problems. Should not be set in preference files.\n\ + \032 times \n\ + \032 When this flag is set to true, file modification times (but not\n\ + \032 directory modtimes) are propagated.\n\ + \032 ui xxx\n\ + \032 This preference selects either the graphical or the textual\n\ + \032 user interface. Legal values are graphic or text.\n\ + \032 Because this option is processed specially during Unison's\n\ + \032 start-up sequence, it can only be used on the command line. In\n\ + \032 preference files it has no effect.\n\ + \032 If the Unison executable was compiled with only a textual\n\ + \032 interface, this option has no effect. (The pre-compiled\n\ + \032 binaries are all compiled with both interfaces available.)\n\ + \032 version \n\ + \032 Print the current version number and exit. (This option only\n\ + \032 makes sense on the command line.)\n\ + \032 xferbycopying \n\ + \032 When this preference is set, Unison will try to avoid\n\ + \032 transferring file contents across the network by recognizing\n\ + \032 when a file with the required contents already exists in the\n\ + \032 target replica. This usually allows file moves to be propagated\n\ + \032 very quickly. The default value istrue.\n\ + \n\ + Profiles\n\ + \n\ + \032 A profile is a text file that specifies permanent settings for roots,\n\ + \032 paths, ignore patterns, and other preferences, so that they do not\n\ + \032 need to be typed at the command line every time Unison is run.\n\ + \032 Profiles should reside in the .unison directory on the client machine.\n\ + \032 If Unison is started with just one argument name on the command line,\n\ + \032 it looks for a profile called name.prf in the .unison directory. If it\n\ + \032 is started with no arguments, it scans the .unison directory for files\n\ + \032 whose names end in .prf and offers a menu (provided that the Unison\n\ + \032 executable is compiled with the graphical user interface). If a file\n\ + \032 named default.prf is found, its settings will be offered as the\n\ + \032 default choices.\n\ + \n\ + \032 To set the value of a preference p permanently, add to the appropriate\n\ + \032 profile a line of the form\n\ + \032 p = true\n\ + \n\ + \032 for a boolean flag or\n\ + \032 p = \n\ + \n\ + \032 for a preference of any other type.\n\ + \n\ + \032 Whitespaces around p and xxx are ignored. A profile may also include\n\ + \032 blank lines and lines beginning with #; both are ignored.\n\ + \n\ + \032 When Unison starts, it first reads the profile and then the command\n\ + \032 line, so command-line options will override settings from the profile.\n\ + \n\ + \032 Profiles may also include lines of the form include name, which will\n\ + \032 cause the file name (or name.prf, if name does not exist in the\n\ + \032 .unison directory) to be read at the point, and included as if its\n\ + \032 contents, instead of the include line, was part of the profile.\n\ + \032 Include lines allows settings common to several profiles to be stored\n\ + \032 in one place.\n\ + \n\ + \032 A profile may include a preference `label = desc' to provide a\n\ + \032 description of the options selected in this profile. The string desc\n\ + \032 is listed along with the profile name in the profile selection dialog,\n\ + \032 and displayed in the top-right corner of the main Unison window in the\n\ + \032 graphical user interface.\n\ + \n\ + \032 The graphical user-interface also supports one-key shortcuts for\n\ + \032 commonly used profiles. If a profile contains a preference of the form\n\ + \032 `key = n', where n is a single digit, then pressing this digit key\n\ + \032 will cause Unison to immediately switch to this profile and begin\n\ + \032 synchronization again from scratch. In this case, all actions that\n\ + \032 have been selected for a set of changes currently being displayed will\n\ + \032 be discarded.\n\ + \n\ + Sample Profiles\n\ + \n\ + A Minimal Profile\n\ + \n\ + \032 Here is a very minimal profile file, such as might be found in\n\ + \032 .unison/default.prf:\n\ + \032 # Roots of the synchronization\n\ + \032 root = /home/bcpierce\n\ + \032 root = ssh://saul//home/bcpierce\n\ + \n\ + \032 # Paths to synchronize\n\ + \032 path = current\n\ + \032 path = common\n\ + \032 path = .netscape/bookmarks.html\n\ + \n\ + A Basic Profile\n\ + \n\ + \032 Here is a more sophisticated profile, illustrating some other useful\n\ + \032 features.\n\ + \032 # Roots of the synchronization\n\ + \032 root = /home/bcpierce\n\ + \032 root = ssh://saul//home/bcpierce\n\ + \n\ + \032 # Paths to synchronize\n\ + \032 path = current\n\ + \032 path = common\n\ + \032 path = .netscape/bookmarks.html\n\ + \n\ + \032 # Some regexps specifying names and paths to ignore\n\ + \032 ignore = Name temp.*\n\ + \032 ignore = Name *~\n\ + \032 ignore = Name .*~\n\ + \032 ignore = Path */pilot/backup/Archive_*\n\ + \032 ignore = Name *.o\n\ + \032 ignore = Name *.tmp\n\ + \n\ + \032 # Window height\n\ + \032 height = 37\n\ + \n\ + \032 # Keep a backup copy of every file in a central location\n\ + \032 backuplocation = central\n\ + \032 backupdir = /home/bcpierce/backups\n\ + \032 backup = Name *\n\ + \032 backupprefix = $VERSION.\n\ + \032 backupsuffix =\n\ + \n\ + \032 # Use this command for displaying diffs\n\ + \032 diff = diff -y -W 79 --suppress-common-lines\n\ + \n\ + \032 # Log actions to the terminal\n\ + \032 log = true\n\ + \n\ + A Power-User Profile\n\ + \n\ + \032 When Unison is used with large replicas, it is often convenient to be\n\ + \032 able to synchronize just a part of the replicas on a given run (this\n\ + \032 saves the time of detecting updates in the other parts). This can be\n\ + \032 accomplished by splitting up the profile into several parts -- a\n\ + \032 common part containing most of the preference settings, plus one\n\ + \032 \"top-level\" file for each set of paths that need to be synchronized.\n\ + \032 (The include mechanism can also be used to allow the same set of\n\ + \032 preference settings to be used with different roots.)\n\ + \n\ + \032 The collection of profiles implementing this scheme might look as\n\ + \032 follows. The file default.prf is empty except for an include\n\ + \032 directive:\n\ + \032 # Include the contents of the file common\n\ + \032 include common\n\ + \n\ + \032 Note that the name of the common file is common, not common.prf; this\n\ + \032 prevents Unison from offering common as one of the list of profiles in\n\ + \032 the opening dialog (in the graphical UI).\n\ + \n\ + \032 The file common contains the real preferences:\n\ + \032 # Roots of the synchronization\n\ + \032 root = /home/bcpierce\n\ + \032 root = ssh://saul//home/bcpierce\n\ + \n\ + \032 # (... other preferences ...)\n\ + \n\ + \032 # If any new preferences are added by Unison (e.g. 'ignore'\n\ + \032 # preferences added via the graphical UI), then store them in the\n\ + \032 # file 'common' rathen than in the top-level preference file\n\ + \032 addprefsto = common\n\ + \n\ + \032 # Names and paths to ignore:\n\ + \032 ignore = Name temp.*\n\ + \032 ignore = Name *~\n\ + \032 ignore = Name .*~\n\ + \032 ignore = Path */pilot/backup/Archive_*\n\ + \032 ignore = Name *.o\n\ + \032 ignore = Name *.tmp\n\ + \n\ + \032 Note that there are no path preferences in common. This means that,\n\ + \032 when we invoke Unison with the default profile (e.g., by typing\n\ + \032 'unison default' or just 'unison' on the command line), the whole\n\ + \032 replicas will be synchronized. (If we never want to synchronize the\n\ + \032 whole replicas, then default.prf would instead include settings for\n\ + \032 all the paths that are usually synchronized.)\n\ + \n\ + \032 To synchronize just part of the replicas, Unison is invoked with an\n\ + \032 alternate preference file--e.g., doing 'unison workingset', where the\n\ + \032 preference file workingset.prf contains\n\ + \032 path = current/papers\n\ + \032 path = Mail/inbox\n\ + \032 path = Mail/drafts\n\ + \032 include common\n\ + \n\ + \032 causes Unison to synchronize just the listed subdirectories.\n\ + \n\ + \032 The key preference can be used in combination with the graphical UI to\n\ + \032 quickly switch between different sets of paths. For example, if the\n\ + \032 file mail.prf contains\n\ + \032 path = Mail\n\ + \032 batch = true\n\ + \032 key = 2\n\ + \032 include common\n\ + \n\ + \032 then pressing 2 will cause Unison to look for updates in the Mail\n\ + \032 subdirectory and (because the batch flag is set) immediately propagate\n\ + \032 any that it finds.\n\ + \n\ + Keeping Backups\n\ + \n\ + \032 When Unison overwrites a file or directory by propagating a new\n\ + \032 version from the other replica, it can keep the old version around as\n\ + \032 a backup. There are several preferences that control precisely where\n\ + \032 these backups are stored and how they are named.\n\ + \n\ + \032 To enable backups, you must give one or more backup preferences. Each\n\ + \032 of these has the form\n\ + \032 backup = \n\ + \n\ + \032 where has the same form as for the ignore preference. For\n\ + \032 example,\n\ + \032 backup = Name *\n\ + \n\ + \032 causes Unison to keep backups of all files and directories. The\n\ + \032 backupnot preference can be used to give a few exceptions: it\n\ + \032 specifies which files and directories should not be backed up, even if\n\ + \032 they match the backup pathspec.\n\ + \n\ + \032 It is important to note that the pathspec is matched against the path\n\ + \032 that is being updated by Unison, not its descendants. For example, if\n\ + \032 you set backup = Name *.txt and then delete a whole directory named\n\ + \032 foo containing some text files, these files will not be backed up\n\ + \032 because Unison will just check that foo does not match *.txt.\n\ + \032 Similarly, if the directory itself happened to be called foo.txt, then\n\ + \032 the whole directory and all the files in it will be backed up,\n\ + \032 regardless of their names.\n\ + \n\ + \032 Backup files can be stored either centrally or locally. This behavior\n\ + \032 is controlled by the preference backuplocation, whose value must be\n\ + \032 either central or local. (The default is central.)\n\ + \n\ + \032 When backups are stored locally, they are kept in the same directory\n\ + \032 as the original.\n\ + \n\ + \032 When backups are stored centrally, the directory used to hold them is\n\ + \032 controlled by the preference backupdir and the environment variable\n\ + \032 UNISONBACKUPDIR. (The environment variable is checked first.) If\n\ + \032 neither of these are set, then the directory .unison/backup in the\n\ + \032 user's home directory is used.\n\ + \n\ + \032 The preference maxbackups controls how many previous versions of each\n\ + \032 file are kept (including the current version).\n\ + \n\ + \032 By default, backup files are named .bak.VERSION.FILENAME, where\n\ + \032 FILENAME is the original filename and VERSION is the backup number (1\n\ + \032 for the most recent, 2 for the next most recent, etc.). This can be\n\ + \032 changed by setting the preferences backupprefix and/or backupsuffix.\n\ + \032 If desired, backupprefix may include a directory prefix; this can be\n\ + \032 used with backuplocation = local to put all backup files for each\n\ + \032 directory into a single subdirectory. For example, setting\n\ + \032 backuplocation = local\n\ + \032 backupprefix = .unison/$VERSION.\n\ + \032 backupsuffix =\n\ + \n\ + \032 will put all backups in a local subdirectory named .unison. Also, note\n\ + \032 that the string $VERSION in either backupprefix or backupsuffix (it\n\ + \032 must appear in one or the other) is replaced by the version number.\n\ + \032 This can be used, for example, to ensure that backup files retain the\n\ + \032 same extension as the originals.\n\ + \n\ + \032 For backward compatibility, the backups preference is also supported.\n\ + \032 It simply means backup = Name * and backuplocation = local.\n\ + \n\ + Merging Conflicting Versions\n\ + \n\ + \032 Unison can invoke external programs to merge conflicting versions of a\n\ + \032 file. The preference merge controls this process.\n\ + \n\ + \032 The merge preference may be given once or several times in a\n\ + \032 preference file (it can also be given on the command line, of course,\n\ + \032 but this tends to be awkward because of the spaces and special\n\ + \032 characters involved). Each instance of the preference looks like this:\n\ + \032 merge = -> \n\ + \n\ + \032 The here has exactly the same format as for the ignore\n\ + \032 preference (see the section \"Path specification\" ). For example, using\n\ + \032 \"Name *.txt\" as the tells Unison that this command should\n\ + \032 be used whenever a file with extension .txt needs to be merged.\n\ + \n\ + \032 Many external merging programs require as inputs not just the two\n\ + \032 files that need to be merged, but also a file containing the last\n\ + \032 synchronized version. You can ask Unison to keep a copy of the last\n\ + \032 synchronized version for some files using the backupcurrent\n\ + \032 preference. This preference is used in exactly the same way as backup\n\ + \032 and its meaning is similar, except that it causes backups to be kept\n\ + \032 of the current contents of each file after it has been synchronized by\n\ + \032 Unison, rather than the previous contents that Unison overwrote. These\n\ + \032 backups are kept on both replicas in the same place as ordinary backup\n\ + \032 files--i.e. according to the backuplocation and backupdir preferences.\n\ + \032 They are named like the original files if backupslocation is set to\n\ + \032 'central' and otherwise, Unison uses the backupprefix and backupsuffix\n\ + \032 preferences and assumes a version number 000 for these backups.\n\ + \n\ + \032 The part of the preference specifies what external command\n\ + \032 should be invoked to merge files at paths matching the .\n\ + \032 Within this string, several special substrings are recognized; these\n\ + \032 will be substituted with appropriate values before invoking a\n\ + \032 sub-shell to execute the command.\n\ + \032 * CURRENT1 is replaced by the name of (a temporary copy of) the\n\ + \032 local variant of the file.\n\ + \032 * CURRENT2 is replaced by the name of a temporary file, into which\n\ + \032 the contents of the remote variant of the file have been\n\ + \032 transferred by Unison prior to performing the merge.\n\ + \032 * CURRENTARCH is replaced by the name of the backed up copy of the\n\ + \032 original version of the file (i.e., the file saved by Unison if\n\ + \032 the current filename matches the path specifications for the\n\ + \032 backupcurrent preference, as explained above), if one exists. If\n\ + \032 no archive exists and CURRENTARCH appears in the merge command,\n\ + \032 then an error is signalled.\n\ + \032 * CURRENTARCHOPT is replaced by the name of the backed up copy of\n\ + \032 the original version of the file (i.e., its state at the end of\n\ + \032 the last successful run of Unison), if one exists, or the empty\n\ + \032 string if no archive exists.\n\ + \032 * NEW is replaced by the name of a temporary file that Unison\n\ + \032 expects to be written by the merge program when it finishes,\n\ + \032 giving the desired new contents of the file.\n\ + \032 * PATH is replaced by the path (relative to the roots of the\n\ + \032 replicas) of the file being merged.\n\ + \032 * NEW1 and NEW2 are replaced by the names of temporary files that\n\ + \032 Unison expects to be written by the merge program when it is only\n\ + \032 able to partially merge the originals; in this case, NEW1 will be\n\ + \032 written back to the local replica and NEW2 to the remote replica;\n\ + \032 NEWARCH, if present, will be used as the \"last common state\" of\n\ + \032 the replicas. (These three options are provided for later\n\ + \032 compatibility with the Harmony data synchronizer.)\n\ + \n\ + \032 To accomodate the wide variety of programs that users might want to\n\ + \032 use for merging, Unison checks for several possible situations when\n\ + \032 the merge program exits:\n\ + \032 * If the merge program exits with a non-zero status, then merge is\n\ + \032 considered to have failed and the replicas are not changed.\n\ + \032 * If the file NEW has been created, it is written back to both\n\ + \032 replicas (and stored in the backup directory). Similarly, if just\n\ + \032 the file NEW1 has been created, it is written back to both\n\ + \032 replicas.\n\ + \032 * If neither NEW nor NEW1 have been created, then Unison examines\n\ + \032 the temporary files CURRENT1 and CURRENT2 that were given as\n\ + \032 inputs to the merge program. If either has been changed (or both\n\ + \032 have been changed in identical ways), then its new contents are\n\ + \032 written back to both replicas. If either CURRENT1 or CURRENT2 has\n\ + \032 been deleted, then the contents of the other are written back to\n\ + \032 both replicas.\n\ + \032 * If the files NEW1, NEW2, and NEWARCH have all been created, they\n\ + \032 are written back to the local replica, remote replica, and backup\n\ + \032 directory, respectively. If the files NEW1, NEW2 have been\n\ + \032 created, but NEWARCH has not, then these files are written back to\n\ + \032 the local replica and remote replica, respectively. Also, if NEW1\n\ + \032 and NEW2 have identical contents, then the same contents are\n\ + \032 stored as a backup (if the backupcurrent preference is set for\n\ + \032 this path) to reflect the fact that the path is currently in sync.\n\ + \032 * If NEW1 and NEW2 (resp. CURRENT1 and CURRENT2) are created (resp.\n\ + \032 overwritten) with different contents but the merge command did not\n\ + \032 fail (i.e., it exited with status code 0), then we copy NEW1\n\ + \032 (resp. CURRENT1) to the other replica and to the archive.\n\ + \032 This behavior is a design choice made to handle the case where a\n\ + \032 merge command only synchronizes some specific contents between two\n\ + \032 files, skipping some irrelevant information (order between\n\ + \032 entries, for instance). We assume that, if the merge command exits\n\ + \032 normally, then the two resulting files are \"as good as equal.\"\n\ + \032 (The reason we copy one on top of the other is to avoid Unison\n\ + \032 detecting that the files are unequal the next time it is run and\n\ + \032 trying again to merge them when, in fact, the merge program has\n\ + \032 already made them as similar as it is able to.)\n\ + \n\ + \032 If the confirmmerge preference is set and Unison is not run in batch\n\ + \032 mode, then Unison will always ask for confirmation before actually\n\ + \032 committing the results of the merge to the replicas.\n\ + \n\ + \032 A large number of external merging programs are available. For\n\ + \032 example, on Unix systems setting the merge preference to\n\ + \032 merge = Name *.txt -> diff3 -m CURRENT1 CURRENTARCH CURRENT2\n\ + \032 > NEW || echo \"differences detected\"\n\ + \n\ + \032 will tell Unison to use the external diff3 program for merging.\n\ + \032 Alternatively, users of emacs may find the following settings\n\ + \032 convenient:\n\ + \032 merge = Name *.txt -> emacs -q --eval '(ediff-merge-files-with-ancestor\n\ + \032 \"CURRENT1\" \"CURRENT2\" \"CURRENTARCH\" nil \"NEW\")'\n\ + \n\ + \032 (These commands are displayed here on two lines to avoid running off\n\ + \032 the edge of the page. In your preference file, each command should be\n\ + \032 written on a single line.)\n\ + \n\ + \032 Users running emacs under windows may find something like this useful:\n\ + \032 merge = Name * -> C:\\Progra~1\\Emacs\\emacs\\bin\\emacs.exe -q --eval\n\ + \032 \"(ediff-files \"\"\"CURRENT1\"\"\" \"\"\"CURRENT2\"\"\")\"\n\ + \n\ + \032 Users running Mac OS X (you may need the Developer Tools installed to\n\ + \032 get the opendiff utility) may prefer\n\ + \032 merge = Name *.txt -> opendiff CURRENT1 CURRENT2 -ancestor CURRENTARCH -mer\n\ + ge NEW\n\ + \n\ + \032 Here is a slightly more involved hack. The opendiff program can\n\ + \032 operate either with or without an archive file. A merge command of\n\ + \032 this form\n\ + \032 merge = Name *.txt ->\n\ + \032 if [ CURRENTARCHOPTx = x ];\n\ + \032 then opendiff CURRENT1 CURRENT2 -merge NEW;\n\ + \032 else opendiff CURRENT1 CURRENT2 -ancestor CURRENTARCHOPT -merge N\n\ + EW;\n\ + \032 fi\n\ + \n\ + \032 (still all on one line in the preference file!) will test whether an\n\ + \032 archive file exists and use the appropriate variant of the arguments\n\ + \032 to opendiff.\n\ + \n\ + \032 Ordinarily, external merge programs are only invoked when Unison is\n\ + \032 not running in batch mode. To specify an external merge program that\n\ + \032 should be used no matter the setting of the batch flag, use the\n\ + \032 mergebatch preference instead of merge.\n\ + \n\ + \032 Please post suggestions for other useful values of the merge\n\ + \032 preference to the unison-users mailing list--we'd like to give\n\ + \032 several examples here. \n\ + \n\ + The User Interface\n\ + \n\ + \032 Both the textual and the graphical user interfaces are intended to be\n\ + \032 mostly self-explanatory. Here are just a few tricks:\n\ + \032 * By default, when running on Unix the textual user interface will\n\ + \032 try to put the terminal into the \"raw mode\" so that it reads the\n\ + \032 input a character at a time rather than a line at a time. (This\n\ + \032 means you can type just the single keystroke \">\" to tell Unison to\n\ + \032 propagate a file from left to right, rather than \"> Enter.\")\n\ + \032 There are some situations, though, where this will not work -- for\n\ + \032 example, when Unison is running in a shell window inside Emacs.\n\ + \032 Setting the dumbtty preference will force Unison to leave the\n\ + \032 terminal alone and process input a line at a time.\n\ + \n\ + Exit code\n\ + \n\ + \032 When running in the textual mode, Unison returns an exit status, which\n\ + \032 describes whether, and at which level, the synchronization was\n\ + \032 successful. The exit status could be useful when Unison is invoked\n\ + \032 from a script. Currently, there are four possible values for the exit\n\ + \032 status:\n\ + \032 * 0: successful synchronization; everything is up-to-date now.\n\ + \032 * 1: some files were skipped, but all file transfers were\n\ + \032 successful.\n\ + \032 * 2: non-fatal failures occurred during file transfer.\n\ + \032 * 3: a fatal error occurred, or the execution was interrupted.\n\ + \n\ + \032 The graphical interface does not return any useful information through\n\ + \032 the exit status.\n\ + \n\ + Path specification\n\ + \n\ + \032 Several Unison preferences (e.g., ignore/ignorenot, follow,\n\ + \032 sortfirst/sortlast, backup, merge, etc.) specify individual paths or\n\ + \032 sets of paths. These preferences share a common syntax based on\n\ + \032 regular-expressions. Each preference is associated with a list of path\n\ + \032 patterns; the paths specified are those that match any one of the path\n\ + \032 pattern.\n\ + \032 * Pattern preferences can be given on the command line, or, more\n\ + \032 often, stored in profiles, using the same syntax as other\n\ + \032 preferences. For example, a profile line of the form\n\ + \032 ignore = pattern\n\ + \032 adds pattern to the list of patterns to be ignored.\n\ + \032 * Each pattern can have one of three forms. The most general form is\n\ + \032 a Posix extended regular expression introduced by the keyword\n\ + \032 Regex. (The collating sequences and character classes of full\n\ + \032 Posix regexps are not currently supported).\n\ + \032 Regex regexp\n\ + \032 For convenience, two other styles of pattern are also recognized:\n\ + \032 Name name\n\ + \032 matches any path in which the last component matches name, while\n\ + \032 Path path\n\ + \032 matches exactly the path path. The name and path arguments of the\n\ + \032 latter forms of patterns are not regular expressions. Instead,\n\ + \032 standard \"globbing\" conventions can be used in name and path:\n\ + \032 + a * matches any sequence of characters not including / (and\n\ + \032 not beginning with ., when used at the beginning of a name)\n\ + \032 + a ? matches any single character except / (and leading .)\n\ + \032 + [xyz] matches any character from the set {x, y, z }\n\ + \032 + {a,bb,ccc} matches any one of a, bb, or ccc.\n\ + \032 * The path separator in path patterns is always the forward-slash\n\ + \032 character \"/\" -- even when the client or server is running under\n\ + \032 Windows, where the normal separator character is a backslash. This\n\ + \032 makes it possible to use the same set of path patterns for both\n\ + \032 Unix and Windows file systems.\n\ + \n\ + \032 Some examples of path patterns appear in the section \"Ignoring Paths\"\n\ + \032 .\n\ + \n\ + Ignoring Paths\n\ + \n\ + \032 Most users of Unison will find that their replicas contain lots of\n\ + \032 files that they don't ever want to synchronize -- temporary files,\n\ + \032 very large files, old stuff, architecture-specific binaries, etc. They\n\ + \032 can instruct Unison to ignore these paths using patterns introduced in\n\ + \032 the section \"Path Patterns\" .\n\ + \n\ + \032 For example, the following pattern will make Unison ignore any path\n\ + \032 containing the name CVS or a name ending in .cmo:\n\ + \032 ignore = Name {CVS,*.cmo}\n\ + \n\ + \032 The next pattern makes Unison ignore the path a/b:\n\ + \032 ignore = Path a/b\n\ + \n\ + \032 Path patterns do not skip filesnames beginning with . (as Name\n\ + \032 patterns do). For example,\n\ + \032 ignore = Path */tmp\n\ + \n\ + \032 will include .foo/tmp in the set of ignore directories, as it is a\n\ + \032 path, not a name, that is ignored.\n\ + \n\ + \032 The following pattern makes Unison ignore any path beginning with a/b\n\ + \032 and ending with a name ending by .ml.\n\ + \032 ignore = Regex a/b/.*\\.ml\n\ + \n\ + \032 Note that regular expression patterns are \"anchored\": they must match\n\ + \032 the whole path, not just a substring of the path.\n\ + \n\ + \032 Here are a few extra points regarding the ignore preference.\n\ + \032 * If a directory is ignored, all its descendents will be too.\n\ + \032 * The user interface provides some convenient commands for adding\n\ + \032 new patterns to be ignored. To ignore a particular file, select it\n\ + \032 and press \"i\". To ignore all files with the same extension, select\n\ + \032 it and press \"E\" (with the shift key). To ignore all files with\n\ + \032 the same name, no matter what directory they appear in, select it\n\ + \032 and press \"N\". These new patterns become permanent: they are\n\ + \032 immediately added to the current profile on disk.\n\ + \032 * If you use the include directive to include a common collection of\n\ + \032 preferences in several top-level preference files, you will\n\ + \032 probably also want to set the addprefsto preference to the name of\n\ + \032 this file. This will cause any new ignore patterns that you add\n\ + \032 from inside Unison to be appended to this file, instead of\n\ + \032 whichever top-level preference file you started Unison with.\n\ + \032 * Ignore patterns can also be specified on the command line, if you\n\ + \032 like (this is probably not very useful), using an option like\n\ + \032 -ignore 'Name temp.txt'.\n\ + \032 * Be careful about renaming directories containing ignored files.\n\ + \032 Because Unison understands the rename as a delete plus a create,\n\ + \032 any ignored files in the directory will be lost (since they are\n\ + \032 invisible to Unison and therefore they do not get recreated in the\n\ + \032 new version of the directory).\n\ + \032 * There is also an ignorenot preference, which specifies a set of\n\ + \032 patterns for paths that should not be ignored, even if they match\n\ + \032 an ignore pattern. However, the interaction of these two sets of\n\ + \032 patterns can be a little tricky. Here is exactly how it works:\n\ + \032 + Unison starts detecting updates from the root of the\n\ + \032 replicas--i.e., from the empty path. If the empty path\n\ + \032 matches an ignore pattern and does not match an ignorenot\n\ + \032 pattern, then the whole replica will be ignored. (For this\n\ + \032 reason, it is not a good idea to include Name * as an ignore\n\ + \032 pattern. If you want to ignore everything except a certain\n\ + \032 set of files, use Name ?*.)\n\ + \032 + If the root is a directory, Unison continues looking for\n\ + \032 updates in all the immediate children of the root. Again, if\n\ + \032 the name of some child matches an ignore pattern and does not\n\ + \032 match an ignorenot pattern, then this whole path including\n\ + \032 everything below it will be ignored.\n\ + \032 + If any of the non-ignored children are directories, then the\n\ + \032 process continues recursively.\n\ + \n\ + Symbolic Links\n\ + \n\ + \032 Ordinarily, Unison treats symbolic links in Unix replicas as \"opaque\":\n\ + \032 it considers the contents of the link to be just the string specifying\n\ + \032 where the link points, and it will propagate changes in this string to\n\ + \032 the other replica.\n\ + \n\ + \032 It is sometimes useful to treat a symbolic link \"transparently,\"\n\ + \032 acting as though whatever it points to were physically in the replica\n\ + \032 at the point where the symbolic link appears. To tell Unison to treat\n\ + \032 a link in this manner, add a line of the form\n\ + \032 follow = pathspec\n\ + \n\ + \032 to the profile, where pathspec is a path pattern as described in the\n\ + \032 section \"Path Patterns\" .\n\ + \n\ + \032 Windows file systems do not support symbolic links; Unison will refuse\n\ + \032 to propagate an opaque symbolic link from Unix to Windows and flag the\n\ + \032 path as erroneous. When a Unix replica is to be synchronized with a\n\ + \032 Windows system, all symbolic links should match either an ignore\n\ + \032 pattern or a follow pattern.\n\ + \n\ + Permissions\n\ + \n\ + \032 Synchronizing the permission bits of files is slightly tricky when two\n\ + \032 different filesytems are involved (e.g., when synchronizing a Windows\n\ + \032 client and a Unix server). In detail, here's how it works:\n\ + \032 * When the permission bits of an existing file or directory are\n\ + \032 changed, the values of those bits that make sense on both\n\ + \032 operating systems will be propagated to the other replica. The\n\ + \032 other bits will not be changed.\n\ + \032 * When a newly created file is propagated to a remote replica, the\n\ + \032 permission bits that make sense in both operating systems are also\n\ + \032 propagated. The values of the other bits are set to default values\n\ + \032 (they are taken from the current umask, if the receiving host is a\n\ + \032 Unix system).\n\ + \032 * For security reasons, the Unix setuid and setgid bits are not\n\ + \032 propagated.\n\ + \032 * The Unix owner and group ids are not propagated. (What would this\n\ + \032 mean, in general?) All files are created with the owner and group\n\ + \032 of the server process.\n\ + \n\ + Cross-Platform Synchronization\n\ + \n\ + \032 If you use Unison to synchronize files between Windows and Unix\n\ + \032 systems, there are a few special issues to be aware of.\n\ + \n\ + \032 Case conflicts. In Unix, filenames are case sensitive: foo and FOO can\n\ + \032 refer to different files. In Windows, on the other hand, filenames are\n\ + \032 not case sensitive: foo and FOO can only refer to the same file. This\n\ + \032 means that a Unix foo and FOO cannot be synchronized onto a Windows\n\ + \032 system -- Windows won't allow two different files to have the \"same\"\n\ + \032 name. Unison detects this situation for you, and reports that it\n\ + \032 cannot synchronize the files.\n\ + \n\ + \032 You can deal with a case conflict in a couple of ways. If you need to\n\ + \032 have both files on the Windows system, your only choice is to rename\n\ + \032 one of the Unix files to avoid the case conflict, and re-synchronize.\n\ + \032 If you don't need the files on the Windows system, you can simply\n\ + \032 disregard Unison's warning message, and go ahead with the\n\ + \032 synchronization; Unison won't touch those files. If you don't want to\n\ + \032 see the warning on each synchronization, you can tell Unison to ignore\n\ + \032 the files (see the section \"Ignore\" ).\n\ + \n\ + \032 Illegal filenames. Unix allows some filenames that are illegal in\n\ + \032 Windows. For example, colons (`:') are not allowed in Windows\n\ + \032 filenames, but they are legal in Unix filenames. This means that a\n\ + \032 Unix file foo:bar can't be synchronized to a Windows system. As with\n\ + \032 case conflicts, Unison detects this situation for you, and you have\n\ + \032 the same options: you can either rename the Unix file and\n\ + \032 re-synchronize, or you can ignore it.\n\ + \n\ + Slow Links\n\ + \n\ + \032 Unison is built to run well even over relatively slow links such as\n\ + \032 modems and DSL connections.\n\ + \n\ + \032 Unison uses the \"rsync protocol\" designed by Andrew Tridgell and Paul\n\ + \032 Mackerras to greatly speed up transfers of large files in which only\n\ + \032 small changes have been made. More information about the rsync\n\ + \032 protocol can be found at the rsync web site\n\ + \032 (http://samba.anu.edu.au/rsync/).\n\ + \n\ + \032 If you are using Unison with ssh, you may get some speed improvement\n\ + \032 by enabling ssh's compression feature. Do this by adding the option\n\ + \032 \"-rshargs -C\" to the command line or \"rshargs = -C\" to your profile.\n\ + \n\ + Making Unison Faster on Large Files\n\ + \n\ + \032 Unison's built-in implementation of the rsync algorithm makes\n\ + \032 transferring updates to existing files pretty fast. However, for\n\ + \032 whole-file copies of newly created files, the built-in transfer method\n\ + \032 is not highly optimized. Also, if Unison is interrupted in the middle\n\ + \032 of transferring a large file, it will attempt to retransfer the whole\n\ + \032 thing on the next run.\n\ + \n\ + \032 These shortcomings can be addressed with a little extra work by\n\ + \032 telling Unison to use an external file copying utility for whole-file\n\ + \032 transfers. The recommended one is the standalone rsync tool, which is\n\ + \032 available by default on most Unix systems and can easily be installed\n\ + \032 on Windows systems using Cygwin.\n\ + \n\ + \032 If you have rsync installed on both hosts, you can make Unison use it\n\ + \032 simply by setting the copythreshold flag to something non-negative. If\n\ + \032 you set it to 0, Unison will use the external copy utility for all\n\ + \032 whole-file transfers. (This is probably slower than letting Unison\n\ + \032 copy small files by itself, but can be useful for testing.) If you set\n\ + \032 it to a larger value, Unison will use the external utility for all\n\ + \032 files larger than this size (which is given in kilobytes, so setting\n\ + \032 it to 1000 will cause the external tool to be used for all transfers\n\ + \032 larger than a megabyte).\n\ + \n\ + \032 If you want to use a different external copy utility, set both the\n\ + \032 copyprog and copyprogpartial preferences--the former is used for the\n\ + \032 first transfer of a file, while the latter is used when Unison sees a\n\ + \032 partially transferred temp file on the receiving host. Be careful\n\ + \032 here: Your external tool needs to be instructed to copy files in place\n\ + \032 (otherwise if the transfer is interrupted Unison will not notice that\n\ + \032 some of the data has already been transferred, the next time it\n\ + \032 tries). The default values are:\n\ + \032 copyprog = rsync --inplace --compress\n\ + \032 copyprogrest = rsync --partial --inplace --compress\n\ + \n\ + \032 You may also need to set the copyquoterem preference. When it is set\n\ + \032 to true, this causes Unison to add an extra layer of quotes to the\n\ + \032 remote path passed to the external copy program. This is is needed by\n\ + \032 rsync, for example, which internally uses an ssh connection, requiring\n\ + \032 an extra level of quoting for paths containing spaces. When this flag\n\ + \032 is set to default, extra quotes are added if the value of copyprog\n\ + \032 contains the string rsync. The default value is default, naturally.\n\ + \n\ + \032 If a directory transfer is interrupted, the next run of Unison will\n\ + \032 automatically skip any files that were completely transferred before\n\ + \032 the interruption. (This behavior is always on: it does not depend on\n\ + \032 the setting of the copythreshold preference.) Note, though, that the\n\ + \032 new directory will not appear in the destination filesystem until\n\ + \032 everything has been transferred--partially transferred directories are\n\ + \032 kept in a temporary location (with names like .unison.DIRNAME....)\n\ + \032 until the transfer is complete.\n\ + \n\ + Fast Update Detection\n\ + \n\ + \032 If your replicas are large and at least one of them is on a Windows\n\ + \032 system, you may find that Unison's default method for detecting\n\ + \032 changes (which involves scanning the full contents of every file on\n\ + \032 every sync--the only completely safe way to do it under Windows) is\n\ + \032 too slow. Unison provides a preference fastcheck that, when set to\n\ + \032 true, causes it to use file creation times as 'pseudo inode numbers'\n\ + \032 when scanning replicas for updates, instead of reading the full\n\ + \032 contents of every file.\n\ + \n\ + \032 When fastcheck is set to no, Unison will perform slow\n\ + \032 checking--re-scanning the contents of each file on each\n\ + \032 synchronization--on all replicas. When fastcheck is set to default\n\ + \032 (which, naturally, is the default), Unison will use fast checks on\n\ + \032 Unix replicas and slow checks on Windows replicas.\n\ + \n\ + \032 This strategy may cause Unison to miss propagating an update if the\n\ + \032 modification time and length of the file are both unchanged by the\n\ + \032 update. However, Unison will never overwrite such an update with a\n\ + \032 change from the other replica, since it always does a safe check for\n\ + \032 updates just before propagating a change. Thus, it is reasonable to\n\ + \032 use this switch most of the time and occasionally run Unison once with\n\ + \032 fastcheck set to no, if you are worried that Unison may have\n\ + \032 overlooked an update.\n\ + \n\ + \032 Fastcheck is (always) automatically disabled for files with extension\n\ + \032 .xls or .mpp, to prevent Unison from being confused by the habits of\n\ + \032 certain programs (Excel, in particular) of updating files without\n\ + \032 changing their modification times.\n\ + \n\ + Mount Points and Removable Media\n\ + \n\ + \032 Using Unison removable media such as USB drives can be dangerous\n\ + \032 unless you are careful. If you synchronize a directory that is stored\n\ + \032 on removable media when the media is not present, it will look to\n\ + \032 Unison as though the whole directory has been deleted, and it will\n\ + \032 proceed to delete the directory from the other replica--probably not\n\ + \032 what you want!\n\ + \n\ + \032 To prevent accidents, Unison provides a preference called mountpoint.\n\ + \032 Including a line like\n\ + \032 mountpoint = foo\n\ + \n\ + \032 in your preference file will cause Unison to check, after it finishes\n\ + \032 detecting updates, that something actually exists at the path foo on\n\ + \032 both replicas; if it does not, the Unison run will abort.\n\ + \n\ + Click-starting Unison\n\ + \n\ + \032 On Windows NT/2k/XP systems, the graphical version of Unison can be\n\ + \032 invoked directly by clicking on its icon. On Windows 95/98 systems,\n\ + \032 click-starting also works, as long as you are not using ssh. Due to an\n\ + \032 incompatibility with ocaml and Windows 95/98 that is not under our\n\ + \032 control, you must start Unison from a DOS window in Windows 95/98 if\n\ + \032 you want to use ssh.\n\ + \n\ + \032 When you click on the Unison icon, two windows will be created:\n\ + \032 Unison's regular window, plus a console window, which is used only for\n\ + \032 giving your password to ssh (if you do not use ssh to connect, you can\n\ + \032 ignore this window). When your password is requested, you'll need to\n\ + \032 activate the console window (e.g., by clicking in it) before typing.\n\ + \032 If you start Unison from a DOS window, Unison's regular window will\n\ + \032 appear and you will type your password in the DOS window you were\n\ + \032 using.\n\ + \n\ + \032 To use Unison in this mode, you must first create a profile (see the\n\ + \032 section \"Profile\" ). Use your favorite editor for this.\n\ + \n\ + ")) +:: + ("ssh", ("Installing Ssh", + "Installing Ssh\n\ + \n\ + \032 Warning: These instructions may be out of date. More current\n\ + \032 information can be found the Unison Wiki\n\ + \032 (http://alliance.seas.upenn.edu/ bcpierce/wiki/index.php?n=Main.Unison\n\ + \032 FAQOSSpecific).\n\ + \n\ + \032 Your local host will need just an ssh client; the remote host needs an\n\ + \032 ssh server (or daemon), which is available on Unix systems. Unison is\n\ + \032 known to work with ssh version 1.2.27 (Unix) and version 1.2.14\n\ + \032 (Windows); other versions may or may not work.\n\ + \n\ + Unix\n\ + \n\ + \032 Most modern Unix installations come with ssh pre-installed.\n\ + \n\ + Windows\n\ + \n\ + \032 Many Windows implementations of ssh only provide graphical interfaces,\n\ + \032 but Unison requires an ssh client that it can invoke with a\n\ + \032 command-line interface. A suitable version of ssh can be installed as\n\ + \032 follows.\n\ + \032 1. Download an ssh executable.\n\ + \032 Warning: there are many implementations and ports of ssh for\n\ + \032 Windows, and not all of them will work with Unison. We have gotten\n\ + \032 Unison to work with Cygwin's port of openssh, and we suggest you\n\ + \032 try that one first. Here's how to install it:\n\ + \032 a. First, create a new folder on your desktop to hold temporary\n\ + \032 installation files. It can have any name you like, but in\n\ + \032 these instructions we'll assume that you call it Foo.\n\ + \032 b. Direct your web browser to www.cygwin.com, and click on the\n\ + \032 \"Install now!\" link. This will download a file, setup.exe;\n\ + \032 save it in the directory Foo. The file setup.exe is a small\n\ + \032 program that will download the actual install files from the\n\ + \032 Internet when you run it.\n\ + \032 c. Start setup.exe (by double-clicking). This brings up a series\n\ + \032 of dialogs that you will have to go through. Select \"Install\n\ + \032 from Internet.\" For \"Local Package Directory\" select the\n\ + \032 directory Foo. For \"Select install root directory\" we\n\ + \032 recommend that you use the default, C:\\cygwin. The next\n\ + \032 dialog asks you to select the way that you want to connect to\n\ + \032 the network to download the installation files; we have used\n\ + \032 \"Use IE5 Settings\" successfully, but you may need to make a\n\ + \032 different selection depending on your networking setup. The\n\ + \032 next dialog gives a list of mirrors; select one close to you.\n\ + \032 Next you are asked to select which packages to install. The\n\ + \032 default settings in this dialog download a lot of packages\n\ + \032 that are not strictly necessary to run Unison with ssh. If\n\ + \032 you don't want to install a package, click on it until \"skip\"\n\ + \032 is shown. For a minimum installation, select only the\n\ + \032 packages \"cygwin\" and \"openssh,\" which come to about 1900KB;\n\ + \032 the full installation is much larger.\n\ + \n\ + \032 Note that you are plan to build unison using the free CygWin GNU C\n\ + \032 compiler, you need to install essential development packages such\n\ + \032 as \"gcc\", \"make\", \"fileutil\", etc; we refer to the file\n\ + \032 \"INSTALL.win32-cygwin-gnuc\" in the source distribution for further\n\ + \032 details. \n\ + \032 After the packages are downloaded and installed, the next\n\ + \032 dialog allows you to choose whether to \"Create Desktop Icon\"\n\ + \032 and \"Add to Start Menu.\" You make the call.\n\ + \032 d. You can now delete the directory Foo and its contents.\n\ + \032 Some people have reported problems using Cygwin's ssh with Unison.\n\ + \032 If you have trouble, you might try this one instead:\n\ + \032 http://opensores.thebunker.net/pub/mirrors/ssh/contrib/ssh-1.2.14-win32bin.zi\n\ + p\n\ + \032 2. You must set the environment variables HOME and PATH. Ssh will\n\ + \032 create a directory .ssh in the directory given by HOME, so that it\n\ + \032 has a place to keep data like your public and private keys. PATH\n\ + \032 must be set to include the Cygwin bin directory, so that Unison\n\ + \032 can find the ssh executable.\n\ + \032 + On Windows 95/98, add the lines\n\ + \032 set PATH=%PATH%;\n\ + \032 set HOME=\n\ + \032 to the file C:\\AUTOEXEC.BAT, where is the directory\n\ + \032 where you want ssh to create its .ssh directory, and \n\ + \032 is the directory where the executable ssh.exe is stored; if\n\ + \032 you've installed Cygwin in the default location, this is\n\ + \032 C:\\cygwin\\bin. You will have to reboot your computer to take\n\ + \032 the changes into account.\n\ + \032 + On Windows NT/2k/XP, open the environment variables dialog\n\ + \032 box:\n\ + \032 o Windows NT: My Computer/Properties/Environment\n\ + \032 o Windows 2k: My Computer/Properties/Advanced/Environment\n\ + \032 variables\n\ + \032 then select Path and edit its value by appending ; to\n\ + \032 it, where is the full name of the directory that\n\ + \032 includes the ssh executable; if you've installed Cygwin in\n\ + \032 the default location, this is C:\\cygwin\\bin.\n\ + \032 3. Test ssh from a DOS shell by typing\n\ + \032 ssh -l \n\ + \032 You should get a prompt for your password on ,\n\ + \032 followed by a working connection.\n\ + \032 4. Note that ssh-keygen may not work (fails with \"gethostname: no\n\ + \032 such file or directory\") on some systems. This is OK: you can use\n\ + \032 ssh with your regular password for the remote system.\n\ + \032 5. You should now be able to use Unison with an ssh connection. If\n\ + \032 you are logged in with a different user name on the local and\n\ + \032 remote hosts, provide your remote user name when providing the\n\ + \032 remote root (i.e., //username at host/path...).\n\ + \n\ + ")) +:: + ("news", ("Changes in Version 2.32.7", + "Changes in Version 2.32.7\n\ + \n\ + \032 Changes since 2.31:\n\ + \032 * Small user interface changes\n\ + \032 + Small change to text UI \"scanning...\" messages, to print just\n\ + \032 directories (hopefully making it clearer that individual\n\ + \032 files are not necessarily being fingerprinted).\n\ + \032 * Minor fixes and improvements:\n\ + \032 + Ignore one hour differences when deciding whether a file may\n\ + \032 have been updated. This avoids slow update detection after\n\ + \032 daylight saving time changes under Windows. This makes Unison\n\ + \032 slightly more likely to miss an update, but it should be safe\n\ + \032 enough.\n\ + \032 + Fix a small bug that was affecting mainly windows users. We\n\ + \032 need to commit the archives at the end of the sync even if\n\ + \032 there are no updates to propagate because some files (in\n\ + \032 fact, if we've just switched to DST on windows, a LOT of\n\ + \032 files) might have new modtimes in the archive. (Changed the\n\ + \032 text UI only. It's less clear where to change the GUI.)\n\ + \032 + Don't delete the temp file when a transfer fails due to a\n\ + \032 fingerprint mismatch (so that we can have a look and see\n\ + \032 why!) We've also added more debugging code togive more\n\ + \032 informative error messages when we encounter the dreaded and\n\ + \032 longstanding \"assert failed during file transfer\" bug\n\ + \n\ + \032 Changes since 2.27:\n\ + \032 * If Unison is interrupted during a directory transfer, it will now\n\ + \032 leave the partially transferred directory intact in a temporary\n\ + \032 location. (This maintains the invariant that new files/directories\n\ + \032 are transferred either completely or not at all.) The next time\n\ + \032 Unison is run, it will continue filling in this temporary\n\ + \032 directory, skipping transferring files that it finds are already\n\ + \032 there.\n\ + \032 * We've added experimental support for invoking an external file\n\ + \032 transfer tool for whole-file copies instead of Unison's built-in\n\ + \032 transfer protocol. Three new preferences have been added:\n\ + \032 + copyprog is a string giving the name (and command-line\n\ + \032 switches, if needed) of an external program that can be used\n\ + \032 to copy large files efficiently. By default, rsync is\n\ + \032 invoked, but other tools such as scp can be used instead by\n\ + \032 changing the value of this preference. (Although this is not\n\ + \032 its primary purpose, rsync is actually a pretty fast way of\n\ + \032 copying files that don't already exist on the receiving\n\ + \032 host.) For files that do already exist on (but that have been\n\ + \032 changed in one replica), Unison will always use its built-in\n\ + \032 implementation of the rsync algorithm.\n\ + \032 + Added a \"copyprogrest\" preference, so that we can give\n\ + \032 different command lines for invoking the external copy\n\ + \032 utility depending on whether a partially transferred file\n\ + \032 already exists or not. (Rsync doesn't seem to care about\n\ + \032 this, but other utilities may.)\n\ + \032 + copythreshold is an integer (-1 by default), indicating above\n\ + \032 what filesize (in megabytes) Unison should use the external\n\ + \032 copying utility specified by copyprog. Specifying 0 will\n\ + \032 cause ALL copies to use the external program; a negative\n\ + \032 number will prevent any files from using it. (Default is -1.)\n\ + \032 Thanks to Alan Schmitt for a huge amount of hacking and to an\n\ + \032 anonymous sponsor for suggesting and underwriting this extension.\n\ + \032 * Small improvements:\n\ + \032 + Added a new preference, dontchmod. By default, Unison uses\n\ + \032 the chmod system call to set the permission bits of files\n\ + \032 after it has copied them. But in some circumstances (and\n\ + \032 under some operating systems), the chmod call always fails.\n\ + \032 Setting this preference completely prevents Unison from ever\n\ + \032 calling chmod.\n\ + \032 + Don't ignore files that look like backup files if the\n\ + \032 backuplocation preference is set to central\n\ + \032 + Shortened the names of several preferences. The old names are\n\ + \032 also still supported, for backwards compatibility, but they\n\ + \032 do not appear in the documentation.\n\ + \032 + Lots of little documentation tidying. (In particular,\n\ + \032 preferences are separated into Basic and Advanced! This\n\ + \032 should hopefully make Unison a little more approachable for\n\ + \032 new users.\n\ + \032 + Unison can sometimes fail to transfer a file, giving the\n\ + \032 unhelpful message \"Destination updated during\n\ + \032 synchronization\" even though the file has not been changed.\n\ + \032 This can be caused by programs that change either the file's\n\ + \032 contents or the file's extended attributes without changing\n\ + \032 its modification time. It's not clear what is the best fix\n\ + \032 for this - it is not Unison's fault, but it makes Unison's\n\ + \032 behavior puzzling - but at least Unison can be more helpful\n\ + \032 about suggesting a workaround (running once with fastcheck\n\ + \032 set to false). The failure message has been changed to give\n\ + \032 this advice.\n\ + \032 + Many improvements to the OS X GUI (thanks to Alan Schmitt and\n\ + \032 Craig Federighi), including a very nice new \"nested\n\ + \032 directory\" display style and per-file progress bars.\n\ + \032 * Very preliminary support for triggering Unison from an external\n\ + \032 filesystem-watching utility. The current implementation is very\n\ + \032 simple, not efficient, and almost completely untested--not ready\n\ + \032 for real users. But if someone wants to help improve it (e.g., by\n\ + \032 writing a filesystem watcher for your favorite OS), please make\n\ + \032 yourself known!\n\ + \032 On the Unison side, the new behavior is very simple:\n\ + \032 + use the text UI\n\ + \032 + start Unison with the command-line flag \"-repeat FOO\", where\n\ + \032 FOO is name of a file where Unison should look for\n\ + \032 notifications of changes\n\ + \032 + when it starts up, Unison will read the whole contents of\n\ + \032 this file (on both hosts), which should be a\n\ + \032 newline-separated list of paths (relative to the root of the\n\ + \032 synchronization) and synchronize just these paths, as if it\n\ + \032 had been started with the \"-path=xxx\" option for each one of\n\ + \032 them\n\ + \032 + when it finishes, it will sleep for a few seconds and then\n\ + \032 examine the watchfile again; if anything has been added, it\n\ + \032 will read the new paths, synchronize them, and go back to\n\ + \032 sleep\n\ + \032 + that's it!\n\ + \032 To use this to drive Unison \"incrementally,\" just start it in this\n\ + \032 mode and start up a tool (on each host) to watch for new changes\n\ + \032 to the filesystem and append the appropriate paths to the\n\ + \032 watchfile. Hopefully such tools should not be too hard to write.\n\ + \032 * Bug fixes:\n\ + \032 + Fixed a bug that was causing new files to be created with\n\ + \032 permissions 0x600 instead of using a reasonable default (like\n\ + \032 0x644), if the 'perms' flag was set to 0. (Bug reported by\n\ + \032 Ben Crowell.)\n\ + \032 + Follow maxthreads preference when transferring directories.\n\ + \n\ + \032 Changes since 2.17:\n\ + \032 * Major rewrite and cleanup of the whole Mac OS X graphical user\n\ + \032 interface by Craig Federighi. Thanks, Craig!!!\n\ + \032 * Small fix to ctime (non-)handling in update detection under\n\ + \032 windows with fastcheck.\n\ + \032 * Several small fixes to the GTK2 UI to make it work better under\n\ + \032 Windows [thanks to Karl M for these].\n\ + \032 * The backup functionality has been completely rewritten. The\n\ + \032 external interface has not changed, but numerous bugs, irregular\n\ + \032 behaviors, and cross-platform inconsistencies have been corrected.\n\ + \032 * The Unison project now accepts donations via PayPal. If you'd like\n\ + \032 to donate, you can find a link to the donation page on the Unison\n\ + \032 home page (http://www.cis.upenn.edu/ bcpierce/unison/lists.html).\n\ + \032 * Some important safety improvements:\n\ + \032 + Added a new mountpoint preference, which can be used to\n\ + \032 specify a path that must exist in both replicas at the end of\n\ + \032 update detection (otherwise Unison aborts). This can be used\n\ + \032 to avoid potentially dangerous situations when Unison is used\n\ + \032 with removable media such as external hard drives and compact\n\ + \032 flash cards.\n\ + \032 + The confirmation of \"big deletes\" is now controlled by a\n\ + \032 boolean preference confirmbigdeletes. Default is true, which\n\ + \032 gives the same behavior as previously. (This functionality is\n\ + \032 at least partly superceded by the mountpoint preference, but\n\ + \032 it has been left in place in case it is useful to some\n\ + \032 people.)\n\ + \032 + If Unison is asked to \"follow\" a symbolic link but there is\n\ + \032 nothing at the other end of the link, it will now flag this\n\ + \032 path as an error, rather than treating the symlink itself as\n\ + \032 missing or deleted. This avoids a potentially dangerous\n\ + \032 situation where a followed symlink points to an external\n\ + \032 filesystem that might be offline when Unison is run\n\ + \032 (whereupon Unison would cheerfully delete the corresponding\n\ + \032 files in the other replica!).\n\ + \032 * Smaller changes:\n\ + \032 + Added forcepartial and preferpartial preferences, which\n\ + \032 behave like force and prefer but can be specified on a\n\ + \032 per-path basis. [Thanks to Alan Schmitt for this.]\n\ + \032 + A bare-bones self test feature was added, which runs unison\n\ + \032 through some of its paces and checks that the results are as\n\ + \032 expected. The coverage of the tests is still very limited,\n\ + \032 but the facility has already been very useful in debugging\n\ + \032 the new backup functionality (especially in exposing some\n\ + \032 subtle cross-platform issues).\n\ + \032 + Refined debugging code so that the verbosity of individual\n\ + \032 modules can be controlled separately. Instead of just putting\n\ + \032 '-debug verbose' on the command line, you can put '-debug\n\ + \032 update+', which causes all the extra messages in the Update\n\ + \032 module, but not other modules, to be printed. Putting '-debug\n\ + \032 verbose' causes all modules to print with maximum verbosity.\n\ + \032 + Removed mergebatch preference. (It never seemed very useful,\n\ + \032 and its semantics were confusing.)\n\ + \032 + Rewrote some of the merging functionality, for better\n\ + \032 cooperation with external Harmony instances.\n\ + \032 + Changed the temp file prefix from .# to .unison.\n\ + \032 + Compressed the output from the text user interface\n\ + \032 (particularly when run with the -terse flag) to make it\n\ + \032 easier to interpret the results when Unison is run several\n\ + \032 times in succession from a script.\n\ + \032 + Diff and merge functions now work under Windows.\n\ + \032 + Changed the order of arguments to the default diff command\n\ + \032 (so that the + and - annotations in diff's output are\n\ + \032 reversed).\n\ + \032 + Added .mpp files to the \"never fastcheck\" list (like .xls\n\ + \032 files).\n\ + \032 * Many small bugfixes, including:\n\ + \032 + Fixed a longstanding bug regarding fastcheck and daylight\n\ + \032 saving time under Windows when Unison is set up to\n\ + \032 synchronize modification times. (Modification times cannot be\n\ + \032 updated in the archive in this case, so we have to ignore one\n\ + \032 hour differences.)\n\ + \032 + Fixed a bug that would occasionally cause the archives to be\n\ + \032 left in non-identical states on the two hosts after\n\ + \032 synchronization.\n\ + \032 + Fixed a bug that prevented Unison from communicating\n\ + \032 correctly between 32- and 64-bit architectures.\n\ + \032 + On windows, file creation times are no longer used as a proxy\n\ + \032 for inode numbers. (This is unfortunate, as it makes\n\ + \032 fastcheck a little less safe. But it turns out that file\n\ + \032 creation times are not reliable under Windows: if a file is\n\ + \032 removed and a new file is created in its place, the new one\n\ + \032 will sometimes be given the same creation date as the old\n\ + \032 one!)\n\ + \032 + Set read-only file to R/W on OSX before attempting to change\n\ + \032 other attributes.\n\ + \032 + Fixed bug resulting in spurious \"Aborted\" errors during\n\ + \032 transport (thanks to Jerome Vouillon)\n\ + \032 + Enable diff if file contents have changed in one replica, but\n\ + \032 only properties in the other.\n\ + \032 + Removed misleading documentation for 'repeat' preference.\n\ + \032 + Fixed a bug in merging code where Unison could sometimes\n\ + \032 deadlock with the external merge program, if the latter\n\ + \032 produced large amounts of output.\n\ + \032 + Workaround for a bug compiling gtk2 user interface against\n\ + \032 current versions of gtk2+ libraries.\n\ + \032 + Added a better error message for \"ambiguous paths\".\n\ + \032 + Squashed a longstanding bug that would cause file transfer to\n\ + \032 fail with the message \"Failed: Error in readWrite: Is a\n\ + \032 directory.\"\n\ + \032 + Replaced symlinks with copies of their targets in the Growl\n\ + \032 framework in src/uimac. This should make the sources easier\n\ + \032 to check out from the svn repository on WinXP systems.\n\ + \032 + Added a workaround (suggested by Karl M.) for the problem\n\ + \032 discussed on the unison users mailing list where, on the\n\ + \032 Windows platform, the server would hang when transferring\n\ + \032 files. I conjecture that the problem has to do with the RPC\n\ + \032 mechanism, which was used to make a call back from the server\n\ + \032 to the client (inside the Trace.log function) so that the log\n\ + \032 message would be appended to the log file on the client. The\n\ + \032 workaround is to dump these messages (about when\n\ + \032 xferbycopying shortcuts are applied and whether they succeed)\n\ + \032 just to the standard output of the Unison process, not to the\n\ + \032 log file.\n\ + \n\ + \032 Changes since 2.13.0:\n\ + \032 * The features for performing backups and for invoking external\n\ + \032 merge programs have been completely rewritten by Stephane Lescuyer\n\ + \032 (thanks, Stephane!). The user-visible functionality should not\n\ + \032 change, but the internals have been rationalized and there are a\n\ + \032 number of new features. See the manual (in particular, the\n\ + \032 description of the backupXXX preferences) for details.\n\ + \032 * Incorporated patches for ipv6 support, contributed by Samuel\n\ + \032 Thibault. (Note that, due to a bug in the released OCaml 3.08.3\n\ + \032 compiler, this code will not actually work with ipv6 unless\n\ + \032 compiled with the CVS version of the OCaml compiler, where the bug\n\ + \032 has been fixed; however, ipv4 should continue to work normally.)\n\ + \032 * OSX interface:\n\ + \032 + Incorporated Ben Willmore's cool new icon for the Mac UI.\n\ + \032 * Small fixes:\n\ + \032 + Fixed off by one error in month numbers (in printed dates)\n\ + \032 reported by Bob Burger\n\ + \n\ + \032 Changes since 2.12.0:\n\ + \032 * New convention for release numbering: Releases will continue to be\n\ + \032 given numbers of the form X.Y.Z, but, from now on, just the major\n\ + \032 version number (X.Y) will be considered significant when checking\n\ + \032 compatibility between client and server versions. The third\n\ + \032 component of the version number will be used only to identify\n\ + \032 \"patch levels\" of releases.\n\ + \032 This change goes hand in hand with a change to the procedure for\n\ + \032 making new releases. Candidate releases will initially be given\n\ + \032 \"beta release\" status when they are announced for public\n\ + \032 consumption. Any bugs that are discovered will be fixed in a\n\ + \032 separate branch of the source repository (without changing the\n\ + \032 major version number) and new tarballs re-released as needed. When\n\ + \032 this process converges, the patched beta version will be dubbed\n\ + \032 stable.\n\ + \032 * Warning (failure in batch mode) when one path is completely\n\ + \032 emptied. This prevents Unison from deleting everything on one\n\ + \032 replica when the other disappear.\n\ + \032 * Fix diff bug (where no difference is shown the first time the diff\n\ + \032 command is given).\n\ + \032 * User interface changes:\n\ + \032 + Improved workaround for button focus problem (GTK2 UI)\n\ + \032 + Put leading zeroes in date fields\n\ + \032 + More robust handling of character encodings in GTK2 UI\n\ + \032 + Changed format of modification time displays, from modified\n\ + \032 at hh:mm:ss on dd MMM, yyyy to modified on yyyy-mm-dd\n\ + \032 hh:mm:ss\n\ + \032 + Changed time display to include seconds (so that people on\n\ + \032 FAT filesystems will not be confused when Unison tries to\n\ + \032 update a file time to an odd number of seconds and the\n\ + \032 filesystem truncates it to an even number!)\n\ + \032 + Use the diff \"-u\" option by default when showing differences\n\ + \032 between files (the output is more readable)\n\ + \032 + In text mode, pipe the diff output to a pager if the\n\ + \032 environment variable PAGER is set\n\ + \032 + Bug fixes and cleanups in ssh password prompting. Now works\n\ + \032 with the GTK2 UI under Linux. (Hopefully the Mac OS X one is\n\ + \032 not broken!)\n\ + \032 + Include profile name in the GTK2 window name\n\ + \032 + Added bindings ',' (same as '<') and '.' (same as '>') in the\n\ + \032 GTK2 UI\n\ + \032 * Mac GUI:\n\ + \032 + actions like < and > scroll to the next item as necessary.\n\ + \032 + Restart has a menu item and keyboard shortcut (command-R).\n\ + \032 + Added a command-line tool for Mac OS X. It can be installed\n\ + \032 from the Unison menu.\n\ + \032 + New icon.\n\ + \032 + Handle the \"help\" command-line argument properly.\n\ + \032 + Handle profiles given on the command line properly.\n\ + \032 + When a profile has been selected, the profile dialog is\n\ + \032 replaced by a \"connecting\" message while the connection is\n\ + \032 being made. This gives better feedback.\n\ + \032 + Size of left and right columns is now large enough so that\n\ + \032 \"PropsChanged\" is not cut off.\n\ + \032 * Minor changes:\n\ + \032 + Disable multi-threading when both roots are local\n\ + \032 + Improved error handling code. In particular, make sure all\n\ + \032 files are closed in case of a transient failure\n\ + \032 + Under Windows, use $UNISON for home directory as a last\n\ + \032 resort (it was wrongly moved before $HOME and $USERPROFILE in\n\ + \032 Unison 2.12.0)\n\ + \032 + Reopen the logfile if its name changes (profile change)\n\ + \032 + Double-check that permissions and modification times have\n\ + \032 been properly set: there are some combination of OS and\n\ + \032 filesystem on which setting them can fail in a silent way.\n\ + \032 + Check for bad Windows filenames for pure Windows\n\ + \032 synchronization also (not just cross architecture\n\ + \032 synchronization). This way, filenames containing backslashes,\n\ + \032 which are not correctly handled by unison, are rejected right\n\ + \032 away.\n\ + \032 + Attempt to resolve issues with synchronizing modification\n\ + \032 times of read-only files under Windows\n\ + \032 + Ignore chmod failures when deleting files\n\ + \032 + Ignore trailing dots in filenames in case insensitive mode\n\ + \032 + Proper quoting of paths, files and extensions ignored using\n\ + \032 the UI\n\ + \032 + The strings CURRENT1 and CURRENT2 are now correctly\n\ + \032 substitued when they occur in the diff preference\n\ + \032 + Improvements to syncing resource forks between Macs via a\n\ + \032 non-Mac system.\n\ + \n\ + \032 Changes since 2.10.2:\n\ + \032 * INCOMPATIBLE CHANGE: Archive format has changed.\n\ + \032 * Source code availability: The Unison sources are now managed using\n\ + \032 Subversion. One nice side-effect is that anonymous checkout is now\n\ + \032 possible, like this:\n\ + \032 svn co https://cvs.cis.upenn.edu:3690/svnroot/unison/\n\ + \032 We will also continue to export a \"developer tarball\" of the\n\ + \032 current (modulo one day) sources in the web export directory. To\n\ + \032 receive commit logs for changes to the sources, subscribe to the\n\ + \032 unison-hackers list\n\ + \032 (http://www.cis.upenn.edu/ bcpierce/unison/lists.html).\n\ + \032 * Text user interface:\n\ + \032 + Substantial reworking of the internal logic of the text UI to\n\ + \032 make it a bit easier to modify.\n\ + \032 + The dumbtty flag in the text UI is automatically set to true\n\ + \032 if the client is running on a Unix system and the EMACS\n\ + \032 environment variable is set to anything other than the empty\n\ + \032 string.\n\ + \032 * Native OS X gui:\n\ + \032 + Added a synchronize menu item with keyboard shortcut\n\ + \032 + Added a merge menu item, still needs to be debugged\n\ + \032 + Fixes to compile for Panther\n\ + \032 + Miscellaneous improvements and bugfixes\n\ + \032 * Small changes:\n\ + \032 + Changed the filename checking code to apply to Windows only,\n\ + \032 instead of OS X as well.\n\ + \032 + Finder flags now synchronized\n\ + \032 + Fallback in copy.ml for filesystem that do not support O_EXCL\n\ + \032 + Changed buffer size for local file copy (was highly\n\ + \032 inefficient with synchronous writes)\n\ + \032 + Ignore chmod failure when deleting a directory\n\ + \032 + Fixed assertion failure when resolving a conflict content\n\ + \032 change / permission changes in favor of the content change.\n\ + \032 + Workaround for transferring large files using rsync.\n\ + \032 + Use buffered I/O for files (this is the only way to open\n\ + \032 files in binary mode under Cygwin).\n\ + \032 + On non-Cygwin Windows systems, the UNISON environment\n\ + \032 variable is now checked first to determine where to look for\n\ + \032 Unison's archive and preference files, followed by HOME and\n\ + \032 USERPROFILE in that order. On Unix and Cygwin systems, HOME\n\ + \032 is used.\n\ + \032 + Generalized diff preference so that it can be given either as\n\ + \032 just the command name to be used for calculating diffs or\n\ + \032 else a whole command line, containing the strings CURRENT1\n\ + \032 and CURRENT2, which will be replaced by the names of the\n\ + \032 files to be diff'ed before the command is called.\n\ + \032 + Recognize password prompts in some newer versions of ssh.\n\ + \n\ + \032 Changes since 2.9.20:\n\ + \032 * INCOMPATIBLE CHANGE: Archive format has changed.\n\ + \032 * Major functionality changes:\n\ + \032 + Major tidying and enhancement of 'merge' functionality. The\n\ + \032 main user-visible change is that the external merge program\n\ + \032 may either write the merged output to a single new file, as\n\ + \032 before, or it may modify one or both of its input files, or\n\ + \032 it may write two new files. In the latter cases, its\n\ + \032 modifications will be copied back into place on both the\n\ + \032 local and the remote host, and (if the two files are now\n\ + \032 equal) the archive will be updated appropriately. More\n\ + \032 information can be found in the user manual. Thanks to Malo\n\ + \032 Denielou and Alan Schmitt for these improvements.\n\ + \032 Warning: the new merging functionality is not completely\n\ + \032 compatible with old versions! Check the manual for details.\n\ + \032 + Files larger than 2Gb are now supported.\n\ + \032 + Added preliminary (and still somewhat experimental) support\n\ + \032 for the Apple OS X operating system.\n\ + \032 o Resource forks should be transferred correctly. (See the\n\ + \032 manual for details of how this works when synchronizing\n\ + \032 HFS with non-HFS volumes.) Synchronization of file type\n\ + \032 and creator information is also supported.\n\ + \032 o On OSX systems, the name of the directory for storing\n\ + \032 Unison's archives, preference files, etc., is now\n\ + \032 determined as follows:\n\ + \032 # if ~/.unison exists, use it\n\ + \032 # otherwise, use ~/Library/Application\n\ + \032 Support/Unison, creating it if necessary.\n\ + \032 o A preliminary native-Cocoa user interface is under\n\ + \032 construction. This still needs some work, and some users\n\ + \032 experience unpredictable crashes, so it is only for\n\ + \032 hackers for now. Run make with UISTYLE=mac to build this\n\ + \032 interface.\n\ + \032 * Minor functionality changes:\n\ + \032 + Added an ignorelocks preference, which forces Unison to\n\ + \032 override left-over archive locks. (Setting this preference is\n\ + \032 dangerous! Use it only if you are positive you know what you\n\ + \032 are doing.)\n\ + \032 + Added a new preference assumeContentsAreImmutable. If a\n\ + \032 directory matches one of the patterns set in this preference,\n\ + \032 then update detection is skipped for files in this directory.\n\ + \032 (The purpose is to speed update detection for cases like Mail\n\ + \032 folders, which contain lots and lots of immutable files.)\n\ + \032 Also a preference assumeContentsAreImmutableNot, which\n\ + \032 overrides the first, similarly to ignorenot. (Later\n\ + \032 amendment: these preferences are now called immutable and\n\ + \032 immutablenot.)\n\ + \032 + The ignorecase flag has been changed from a boolean to a\n\ + \032 three-valued preference. The default setting, called default,\n\ + \032 checks the operating systems running on the client and server\n\ + \032 and ignores filename case if either of them is OSX or\n\ + \032 Windows. Setting ignorecase to true or false overrides this\n\ + \032 behavior. If you have been setting ignorecase on the command\n\ + \032 line using -ignorecase=true or -ignorecase=false, you will\n\ + \032 need to change to -ignorecase true or -ignorecase false.\n\ + \032 + a new preference, 'repeat', for the text user interface\n\ + \032 (only). If 'repeat' is set to a number, then, after it\n\ + \032 finishes synchronizing, Unison will wait for that many\n\ + \032 seconds and then start over, continuing this way until it is\n\ + \032 killed from outside. Setting repeat to true will\n\ + \032 automatically set the batch preference to true.\n\ + \032 + Excel files are now handled specially, so that the fastcheck\n\ + \032 optimization is skipped even if the fastcheck flag is set.\n\ + \032 (Excel does some naughty things with modtimes, making this\n\ + \032 optimization unreliable and leading to failures during change\n\ + \032 propagation.)\n\ + \032 + The ignorecase flag has been changed from a boolean to a\n\ + \032 three-valued preference. The default setting, called\n\ + \032 'default', checks the operating systems running on the client\n\ + \032 and server and ignores filename case if either of them is OSX\n\ + \032 or Windows. Setting ignorecase to 'true' or 'false' overrides\n\ + \032 this behavior.\n\ + \032 + Added a new preference, 'repeat', for the text user interface\n\ + \032 (only, at the moment). If 'repeat' is set to a number, then,\n\ + \032 after it finishes synchronizing, Unison will wait for that\n\ + \032 many seconds and then start over, continuing this way until\n\ + \032 it is killed from outside. Setting repeat to true will\n\ + \032 automatically set the batch preference to true.\n\ + \032 + The 'rshargs' preference has been split into 'rshargs' and\n\ + \032 'sshargs' (mainly to make the documentation clearer). In\n\ + \032 fact, 'rshargs' is no longer mentioned in the documentation\n\ + \032 at all, since pretty much everybody uses ssh now anyway.\n\ + \032 * Documentation\n\ + \032 + The web pages have been completely redesigned and\n\ + \032 reorganized. (Thanks to Alan Schmitt for help with this.)\n\ + \032 * User interface improvements\n\ + \032 + Added a GTK2 user interface, capable (among other things) of\n\ + \032 displaying filenames in any locale encoding. Kudos to Stephen\n\ + \032 Tse for contributing this code!\n\ + \032 + The text UI now prints a list of failed and skipped transfers\n\ + \032 at the end of synchronization.\n\ + \032 + Restarting update detection from the graphical UI will reload\n\ + \032 the current profile (which in particular will reset the -path\n\ + \032 preference, in case it has been narrowed by using the\n\ + \032 \"Recheck unsynchronized items\" command).\n\ + \032 + Several small improvements to the text user interface,\n\ + \032 including a progress display.\n\ + \032 * Bug fixes (too numerous to count, actually, but here are some):\n\ + \032 + The maxthreads preference works now.\n\ + \032 + Fixed bug where warning message about uname returning an\n\ + \032 unrecognized result was preventing connection to server. (The\n\ + \032 warning is no longer printed, and all systems where 'uname'\n\ + \032 returns anything other than 'Darwin' are assumed not to be\n\ + \032 running OS X.)\n\ + \032 + Fixed a problem on OS X that caused some valid file names\n\ + \032 (e.g., those including colons) to be considered invalid.\n\ + \032 + Patched Path.followLink to follow links under cygwin in\n\ + \032 addition to Unix (suggested by Matt Swift).\n\ + \032 + Small change to the storeRootsName function, suggested by\n\ + \032 bliviero at ichips.intel.com, to fix a problem in unison with\n\ + \032 the `rootalias' option, which allows you to tell unison that\n\ + \032 two roots contain the same files. Rootalias was being applied\n\ + \032 after the hosts were sorted, so it wouldn't work properly in\n\ + \032 all cases.\n\ + \032 + Incorporated a fix by Dmitry Bely for setting utimes of\n\ + \032 read-only files on Win32 systems.\n\ + \032 * Installation / portability:\n\ + \032 + Unison now compiles with OCaml version 3.07 and later out of\n\ + \032 the box.\n\ + \032 + Makefile.OCaml fixed to compile out of the box under OpenBSD.\n\ + \032 + a few additional ports (e.g. OpenBSD, Zaurus/IPAQ) are now\n\ + \032 mentioned in the documentation\n\ + \032 + Unison can now be installed easily on OSX systems using the\n\ + \032 Fink package manager\n\ + \n\ + \032 Changes since 2.9.1:\n\ + \032 * Added a preference maxthreads that can be used to limit the number\n\ + \032 of simultaneous file transfers.\n\ + \032 * Added a backupdir preference, which controls where backup files\n\ + \032 are stored.\n\ + \032 * Basic support added for OSX. In particular, Unison now recognizes\n\ + \032 when one of the hosts being synchronized is running OSX and\n\ + \032 switches to a case-insensitive treatment of filenames (i.e., 'foo'\n\ + \032 and 'FOO' are considered to be the same file). (OSX is not yet\n\ + \032 fully working, however: in particular, files with resource forks\n\ + \032 will not be synchronized correctly.)\n\ + \032 * The same hash used to form the archive name is now also added to\n\ + \032 the names of the temp files created during file transfer. The\n\ + \032 reason for this is that, during update detection, we are going to\n\ + \032 silently delete any old temp files that we find along the way, and\n\ + \032 we want to prevent ourselves from deleting temp files belonging to\n\ + \032 other instances of Unison that may be running in parallel, e.g.\n\ + \032 synchronizing with a different host. Thanks to Ruslan Ermilov for\n\ + \032 this suggestion.\n\ + \032 * Several small user interface improvements\n\ + \032 * Documentation\n\ + \032 + FAQ and bug reporting instructions have been split out as\n\ + \032 separate HTML pages, accessible directly from the unison web\n\ + \032 page.\n\ + \032 + Additions to FAQ, in particular suggestions about performance\n\ + \032 tuning.\n\ + \032 * Makefile\n\ + \032 + Makefile.OCaml now sets UISTYLE=text or UISTYLE=gtk\n\ + \032 automatically, depending on whether it finds lablgtk\n\ + \032 installed\n\ + \032 + Unison should now compile \"out of the box\" under OSX\n\ + \n\ + \032 Changes since 2.8.1:\n\ + \032 * Changing profile works again under Windows\n\ + \032 * File movement optimization: Unison now tries to use local copy\n\ + \032 instead of transfer for moved or copied files. It is controled by\n\ + \032 a boolean option \"xferbycopying\".\n\ + \032 * Network statistics window (transfer rate, amount of data\n\ + \032 transferred). [NB: not available in Windows-Cygwin version.]\n\ + \032 * symlinks work under the cygwin version (which is dynamically\n\ + \032 linked).\n\ + \032 * Fixed potential deadlock when synchronizing between Windows and\n\ + \032 Unix\n\ + \032 * Small improvements:\n\ + \032 + If neither the USERPROFILE nor the HOME environment variables\n\ + \032 are set, then Unison will put its temporary commit log\n\ + \032 (called DANGER.README) into the directory named by the UNISON\n\ + \032 environment variable, if any; otherwise it will use C:.\n\ + \032 + alternative set of values for fastcheck: yes = true; no =\n\ + \032 false; default = auto.\n\ + \032 + -silent implies -contactquietly\n\ + \032 * Source code:\n\ + \032 + Code reorganization and tidying. (Started breaking up some of\n\ + \032 the basic utility modules so that the non-unison-specific\n\ + \032 stuff can be made available for other projects.)\n\ + \032 + several Makefile and docs changes (for release);\n\ + \032 + further comments in \"update.ml\";\n\ + \032 + connection information is not stored in global variables\n\ + \032 anymore.\n\ + \n\ + \032 Changes since 2.7.78:\n\ + \032 * Small bugfix to textual user interface under Unix (to avoid\n\ + \032 leaving the terminal in a bad state where it would not echo inputs\n\ + \032 after Unison exited).\n\ + \n\ + \032 Changes since 2.7.39:\n\ + \032 * Improvements to the main web page (stable and beta version docs\n\ + \032 are now both accessible).\n\ + \032 * User manual revised.\n\ + \032 * Added some new preferences:\n\ + \032 + \"sshcmd\" and \"rshcmd\" for specifying paths to ssh and rsh\n\ + \032 programs.\n\ + \032 + \"contactquietly\" for suppressing the \"contacting server\"\n\ + \032 message during Unison startup (under the graphical UI).\n\ + \032 * Bug fixes:\n\ + \032 + Fixed small bug in UI that neglected to change the displayed\n\ + \032 column headers if loading a new profile caused the roots to\n\ + \032 change.\n\ + \032 + Fixed a bug that would put the text UI into an infinite loop\n\ + \032 if it encountered a conflict when run in batch mode.\n\ + \032 + Added some code to try to fix the display of non-Ascii\n\ + \032 characters in filenames on Windows systems in the GTK UI.\n\ + \032 (This code is currently untested--if you're one of the people\n\ + \032 that had reported problems with display of non-ascii\n\ + \032 filenames, we'd appreciate knowing if this actually fixes\n\ + \032 things.)\n\ + \032 + `-prefer/-force newer' works properly now. (The bug was\n\ + \032 reported by Sebastian Urbaniak and Sean Fulton.)\n\ + \032 * User interface and Unison behavior:\n\ + \032 + Renamed `Proceed' to `Go' in the graphical UI.\n\ + \032 + Added exit status for the textual user interface.\n\ + \032 + Paths that are not synchronized because of conflicts or\n\ + \032 errors during update detection are now noted in the log file.\n\ + \032 + [END] messages in log now use a briefer format\n\ + \032 + Changed the text UI startup sequence so that ./unison -ui\n\ + \032 text will use the default profile instead of failing.\n\ + \032 + Made some improvements to the error messages.\n\ + \032 + Added some debugging messages to remote.ml.\n\ + \n\ + \032 Changes since 2.7.7:\n\ + \032 * Incorporated, once again, a multi-threaded transport sub-system.\n\ + \032 It transfers several files at the same time, thereby making much\n\ + \032 more effective use of available network bandwidth. Unlike the\n\ + \032 earlier attempt, this time we do not rely on the native thread\n\ + \032 library of OCaml. Instead, we implement a light-weight,\n\ + \032 non-preemptive multi-thread library in OCaml directly. This\n\ + \032 version appears stable.\n\ + \032 Some adjustments to unison are made to accommodate the\n\ + \032 multi-threaded version. These include, in particular, changes to\n\ + \032 the user interface and logging, for example:\n\ + \032 + Two log entries for each transferring task, one for the\n\ + \032 beginning, one for the end.\n\ + \032 + Suppressed warning messages against removing temp files left\n\ + \032 by a previous unison run, because warning does not work\n\ + \032 nicely under multi-threading. The temp file names are made\n\ + \032 less likely to coincide with the name of a file created by\n\ + \032 the user. They take the form\n\ + \032 .#..unison.tmp. [N.b. This was later\n\ + \032 changed to .unison...unison.tmp.]\n\ + \032 * Added a new command to the GTK user interface: pressing 'f' causes\n\ + \032 Unison to start a new update detection phase, using as paths just\n\ + \032 those paths that have been detected as changed and not yet marked\n\ + \032 as successfully completed. Use this command to quickly restart\n\ + \032 Unison on just the set of paths still needing attention after a\n\ + \032 previous run.\n\ + \032 * Made the ignorecase preference user-visible, and changed the\n\ + \032 initialization code so that it can be manually set to true, even\n\ + \032 if neither host is running Windows. (This may be useful, e.g.,\n\ + \032 when using Unison running on a Unix system with a FAT volume\n\ + \032 mounted.)\n\ + \032 * Small improvements and bug fixes:\n\ + \032 + Errors in preference files now generate fatal errors rather\n\ + \032 than warnings at startup time. (I.e., you can't go on from\n\ + \032 them.) Also, we fixed a bug that was preventing these\n\ + \032 warnings from appearing in the text UI, so some users who\n\ + \032 have been running (unsuspectingly) with garbage in their\n\ + \032 prefs files may now get error reports.\n\ + \032 + Error reporting for preference files now provides file name\n\ + \032 and line number.\n\ + \032 + More intelligible message in the case of identical change to\n\ + \032 the same files: \"Nothing to do: replicas have been changed\n\ + \032 only in identical ways since last sync.\"\n\ + \032 + Files with prefix '.#' excluded when scanning for preference\n\ + \032 files.\n\ + \032 + Rsync instructions are send directly instead of first\n\ + \032 marshaled.\n\ + \032 + Won't try forever to get the fingerprint of a continuously\n\ + \032 changing file: unison will give up after certain number of\n\ + \032 retries.\n\ + \032 + Other bug fixes, including the one reported by Peter Selinger\n\ + \032 (force=older preference not working).\n\ + \032 * Compilation:\n\ + \032 + Upgraded to the new OCaml 3.04 compiler, with the LablGtk\n\ + \032 1.2.3 library (patched version used for compiling under\n\ + \032 Windows).\n\ + \032 + Added the option to compile unison on the Windows platform\n\ + \032 with Cygwin GNU C compiler. This option only supports\n\ + \032 building dynamically linked unison executables.\n\ + \n\ + \032 Changes since 2.7.4:\n\ + \032 * Fixed a silly (but debilitating) bug in the client startup\n\ + \032 sequence.\n\ + \n\ + \032 Changes since 2.7.1:\n\ + \032 * Added addprefsto preference, which (when set) controls which\n\ + \032 preference file new preferences (e.g. new ignore patterns) are\n\ + \032 added to.\n\ + \032 * Bug fix: read the initial connection header one byte at a time, so\n\ + \032 that we don't block if the header is shorter than expected. (This\n\ + \032 bug did not affect normal operation -- it just made it hard to\n\ + \032 tell when you were trying to use Unison incorrectly with an old\n\ + \032 version of the server, since it would hang instead of giving an\n\ + \032 error message.)\n\ + \n\ + \032 Changes since 2.6.59:\n\ + \032 * Changed fastcheck from a boolean to a string preference. Its legal\n\ + \032 values are yes (for a fast check), no (for a safe check), or\n\ + \032 default (for a fast check--which also happens to be safe--when\n\ + \032 running on Unix and a safe check when on Windows). The default is\n\ + \032 default.\n\ + \032 * Several preferences have been renamed for consistency. All\n\ + \032 preference names are now spelled out in lowercase. For backward\n\ + \032 compatibility, the old names still work, but they are not\n\ + \032 mentioned in the manual any more.\n\ + \032 * The temp files created by the 'diff' and 'merge' commands are now\n\ + \032 named by prepending a new prefix to the file name, rather than\n\ + \032 appending a suffix. This should avoid confusing diff/merge\n\ + \032 programs that depend on the suffix to guess the type of the file\n\ + \032 contents.\n\ + \032 * We now set the keepalive option on the server socket, to make sure\n\ + \032 that the server times out if the communication link is\n\ + \032 unexpectedly broken.\n\ + \032 * Bug fixes:\n\ + \032 + When updating small files, Unison now closes the destination\n\ + \032 file.\n\ + \032 + File permissions are properly updated when the file is behind\n\ + \032 a followed link.\n\ + \032 + Several other small fixes.\n\ + \n\ + \032 Changes since 2.6.38:\n\ + \032 * Major Windows performance improvement!\n\ + \032 We've added a preference fastcheck that makes Unison look only at\n\ + \032 a file's creation time and last-modified time to check whether it\n\ + \032 has changed. This should result in a huge speedup when checking\n\ + \032 for updates in large replicas.\n\ + \032 When this switch is set, Unison will use file creation times as\n\ + \032 'pseudo inode numbers' when scanning Windows replicas for updates,\n\ + \032 instead of reading the full contents of every file. This may cause\n\ + \032 Unison to miss propagating an update if the create time,\n\ + \032 modification time, and length of the file are all unchanged by the\n\ + \032 update (this is not easy to achieve, but it can be done). However,\n\ + \032 Unison will never overwrite such an update with a change from the\n\ + \032 other replica, since it always does a safe check for updates just\n\ + \032 before propagating a change. Thus, it is reasonable to use this\n\ + \032 switch most of the time and occasionally run Unison once with\n\ + \032 fastcheck set to false, if you are worried that Unison may have\n\ + \032 overlooked an update.\n\ + \032 Warning: This change is has not yet been thoroughly field-tested.\n\ + \032 If you set the fastcheck preference, pay careful attention to what\n\ + \032 Unison is doing.\n\ + \032 * New functionality: centralized backups and merging\n\ + \032 + This version incorporates two pieces of major new\n\ + \032 functionality, implemented by Sylvain Roy during a summer\n\ + \032 internship at Penn: a centralized backup facility that keeps\n\ + \032 a full backup of (selected files in) each replica, and a\n\ + \032 merging feature that allows Unison to invoke an external\n\ + \032 file-merging tool to resolve conflicting changes to\n\ + \032 individual files.\n\ + \032 + Centralized backups:\n\ + \032 o Unison now maintains full backups of the\n\ + \032 last-synchronized versions of (some of) the files in\n\ + \032 each replica; these function both as backups in the\n\ + \032 usual sense and as the \"common version\" when invoking\n\ + \032 external merge programs.\n\ + \032 o The backed up files are stored in a directory\n\ + \032 /.unison/backup on each host. (The name of this\n\ + \032 directory can be changed by setting the environment\n\ + \032 variable UNISONBACKUPDIR.)\n\ + \032 o The predicate backup controls which files are actually\n\ + \032 backed up: giving the preference 'backup = Path *'\n\ + \032 causes backing up of all files.\n\ + \032 o Files are added to the backup directory whenever unison\n\ + \032 updates its archive. This means that\n\ + \032 # When unison reconstructs its archive from scratch\n\ + \032 (e.g., because of an upgrade, or because the\n\ + \032 archive files have been manually deleted), all\n\ + \032 files will be backed up.\n\ + \032 # Otherwise, each file will be backed up the first\n\ + \032 time unison propagates an update for it.\n\ + \032 o The preference backupversions controls how many previous\n\ + \032 versions of each file are kept. The default is 2 (i.e.,\n\ + \032 the last synchronized version plus one backup).\n\ + \032 o For backward compatibility, the backups preference is\n\ + \032 also still supported, but backup is now preferred.\n\ + \032 o It is OK to manually delete files from the backup\n\ + \032 directory (or to throw away the directory itself).\n\ + \032 Before unison uses any of these files for anything\n\ + \032 important, it checks that its fingerprint matches the\n\ + \032 one that it expects.\n\ + \032 + Merging:\n\ + \032 o Both user interfaces offer a new 'merge' command,\n\ + \032 invoked by pressing 'm' (with a changed file selected).\n\ + \032 o The actual merging is performed by an external program.\n\ + \032 The preferences merge and merge2 control how this\n\ + \032 program is invoked. If a backup exists for this file\n\ + \032 (see the backup preference), then the merge preference\n\ + \032 is used for this purpose; otherwise merge2 is used. In\n\ + \032 both cases, the value of the preference should be a\n\ + \032 string representing the command that should be passed to\n\ + \032 a shell to invoke the merge program. Within this string,\n\ + \032 the special substrings CURRENT1, CURRENT2, NEW, and OLD\n\ + \032 may appear at any point. Unison will substitute these as\n\ + \032 follows before invoking the command:\n\ + \032 # CURRENT1 is replaced by the name of the local copy\n\ + \032 of the file;\n\ + \032 # CURRENT2 is replaced by the name of a temporary\n\ + \032 file, into which the contents of the remote copy of\n\ + \032 the file have been transferred by Unison prior to\n\ + \032 performing the merge;\n\ + \032 # NEW is replaced by the name of a temporary file\n\ + \032 that Unison expects to be written by the merge\n\ + \032 program when it finishes, giving the desired new\n\ + \032 contents of the file; and\n\ + \032 # OLD is replaced by the name of the backed up copy\n\ + \032 of the original version of the file (i.e., its\n\ + \032 state at the end of the last successful run of\n\ + \032 Unison), if one exists (applies only to merge, not\n\ + \032 merge2).\n\ + \032 For example, on Unix systems setting the merge\n\ + \032 preference to\n\ + \032 merge = diff3 -m CURRENT1 OLD CURRENT2 > NEW\n\ + \032 will tell Unison to use the external diff3 program for\n\ + \032 merging.\n\ + \032 A large number of external merging programs are\n\ + \032 available. For example, emacs users may find the\n\ + \032 following convenient:\n\ + \032 merge2 = emacs -q --eval '(ediff-merge-files \"CURRENT1\" \"CURRENT2\"\n\ + \032 nil \"NEW\")'\n\ + \032 merge = emacs -q --eval '(ediff-merge-files-with-ancestor\n\ + \032 \"CURRENT1\" \"CURRENT2\" \"OLD\" nil \"NEW\")'\n\ + \032 (These commands are displayed here on two lines to avoid\n\ + \032 running off the edge of the page. In your preference\n\ + \032 file, each should be written on a single line.)\n\ + \032 o If the external program exits without leaving any file\n\ + \032 at the path NEW, Unison considers the merge to have\n\ + \032 failed. If the merge program writes a file called NEW\n\ + \032 but exits with a non-zero status code, then Unison\n\ + \032 considers the merge to have succeeded but to have\n\ + \032 generated conflicts. In this case, it attempts to invoke\n\ + \032 an external editor so that the user can resolve the\n\ + \032 conflicts. The value of the editor preference controls\n\ + \032 what editor is invoked by Unison. The default is emacs.\n\ + \032 o Please send us suggestions for other useful values of\n\ + \032 the merge2 and merge preferences - we'd like to give\n\ + \032 several examples in the manual.\n\ + \032 * Smaller changes:\n\ + \032 + When one preference file includes another, unison no longer\n\ + \032 adds the suffix '.prf' to the included file by default. If a\n\ + \032 file with precisely the given name exists in the .unison\n\ + \032 directory, it will be used; otherwise Unison will add .prf,\n\ + \032 as it did before. (This change means that included preference\n\ + \032 files can be named blah.include instead of blah.prf, so that\n\ + \032 unison will not offer them in its 'choose a preference file'\n\ + \032 dialog.)\n\ + \032 + For Linux systems, we now offer both a statically linked and\n\ + \032 a dynamically linked executable. The static one is larger,\n\ + \032 but will probably run on more systems, since it doesn't\n\ + \032 depend on the same versions of dynamically linked library\n\ + \032 modules being available.\n\ + \032 + Fixed the force and prefer preferences, which were getting\n\ + \032 the propagation direction exactly backwards.\n\ + \032 + Fixed a bug in the startup code that would cause unison to\n\ + \032 crash when the default profile (~/.unison/default.prf) does\n\ + \032 not exist.\n\ + \032 + Fixed a bug where, on the run when a profile is first\n\ + \032 created, Unison would confusingly display the roots in\n\ + \032 reverse order in the user interface.\n\ + \032 * For developers:\n\ + \032 + We've added a module dependency diagram to the source\n\ + \032 distribution, in src/DEPENDENCIES.ps, to help new prospective\n\ + \032 developers with navigating the code.\n\ + \n\ + \032 Changes since 2.6.11:\n\ + \032 * INCOMPATIBLE CHANGE: Archive format has changed.\n\ + \032 * INCOMPATIBLE CHANGE: The startup sequence has been completely\n\ + \032 rewritten and greatly simplified. The main user-visible change is\n\ + \032 that the defaultpath preference has been removed. Its effect can\n\ + \032 be approximated by using multiple profiles, with include\n\ + \032 directives to incorporate common settings. All uses of defaultpath\n\ + \032 in existing profiles should be changed to path.\n\ + \032 Another change in startup behavior that will affect some users is\n\ + \032 that it is no longer possible to specify roots both in the profile\n\ + \032 and on the command line.\n\ + \032 You can achieve a similar effect, though, by breaking your profile\n\ + \032 into two:\n\ + \n\ + \032 default.prf =\n\ + \032 root = blah\n\ + \032 root = foo\n\ + \032 include common\n\ + \n\ + \032 common.prf =\n\ + \032 \n\ + \032 Now do\n\ + \032 unison common root1 root2\n\ + \032 when you want to specify roots explicitly.\n\ + \032 * The -prefer and -force options have been extended to allow users\n\ + \032 to specify that files with more recent modtimes should be\n\ + \032 propagated, writing either -prefer newer or -force newer. (For\n\ + \032 symmetry, Unison will also accept -prefer older or -force older.)\n\ + \032 The -force older/newer options can only be used when -times is\n\ + \032 also set.\n\ + \032 The graphical user interface provides access to these facilities\n\ + \032 on a one-off basis via the Actions menu.\n\ + \032 * Names of roots can now be \"aliased\" to allow replicas to be\n\ + \032 relocated without changing the name of the archive file where\n\ + \032 Unison stores information between runs. (This feature is for\n\ + \032 experts only. See the \"Archive Files\" section of the manual for\n\ + \032 more information.)\n\ + \032 * Graphical user-interface:\n\ + \032 + A new command is provided in the Synchronization menu for\n\ + \032 switching to a new profile without restarting Unison from\n\ + \032 scratch.\n\ + \032 + The GUI also supports one-key shortcuts for commonly used\n\ + \032 profiles. If a profile contains a preference of the form 'key\n\ + \032 = n', where n is a single digit, then pressing this key will\n\ + \032 cause Unison to immediately switch to this profile and begin\n\ + \032 synchronization again from scratch. (Any actions that may\n\ + \032 have been selected for a set of changes currently being\n\ + \032 displayed will be discarded.)\n\ + \032 + Each profile may include a preference 'label = '\n\ + \032 giving a descriptive string that described the options\n\ + \032 selected in this profile. The string is listed along with the\n\ + \032 profile name in the profile selection dialog, and displayed\n\ + \032 in the top-right corner of the main Unison window.\n\ + \032 * Minor:\n\ + \032 + Fixed a bug that would sometimes cause the 'diff' display to\n\ + \032 order the files backwards relative to the main user\n\ + \032 interface. (Thanks to Pascal Brisset for this fix.)\n\ + \032 + On Unix systems, the graphical version of Unison will check\n\ + \032 the DISPLAY variable and, if it is not set, automatically\n\ + \032 fall back to the textual user interface.\n\ + \032 + Synchronization paths (path preferences) are now matched\n\ + \032 against the ignore preferences. So if a path is both\n\ + \032 specified in a path preference and ignored, it will be\n\ + \032 skipped.\n\ + \032 + Numerous other bugfixes and small improvements.\n\ + \n\ + \032 Changes since 2.6.1:\n\ + \032 * The synchronization of modification times has been disabled for\n\ + \032 directories.\n\ + \032 * Preference files may now include lines of the form include ,\n\ + \032 which will cause name.prf to be read at that point.\n\ + \032 * The synchronization of permission between Windows and Unix now\n\ + \032 works properly.\n\ + \032 * A binding CYGWIN=binmode in now added to the environment so that\n\ + \032 the Cygwin port of OpenSSH works properly in a non-Cygwin context.\n\ + \032 * The servercmd and addversionno preferences can now be used\n\ + \032 together: -addversionno appends an appropriate -NNN to the server\n\ + \032 command, which is found by using the value of the -servercmd\n\ + \032 preference if there is one, or else just unison.\n\ + \032 * Both '-pref=val' and '-pref val' are now allowed for boolean\n\ + \032 values. (The former can be used to set a preference to false.)\n\ + \032 * Lot of small bugs fixed.\n\ + \n\ + \032 Changes since 2.5.31:\n\ + \032 * The log preference is now set to true by default, since the log\n\ + \032 file seems useful for most users.\n\ + \032 * Several miscellaneous bugfixes (most involving symlinks).\n\ + \n\ + \032 Changes since 2.5.25:\n\ + \032 * INCOMPATIBLE CHANGE: Archive format has changed (again).\n\ + \032 * Several significant bugs introduced in 2.5.25 have been fixed.\n\ + \n\ + \032 Changes since 2.5.1:\n\ + \032 * INCOMPATIBLE CHANGE: Archive format has changed. Make sure you\n\ + \032 synchronize your replicas before upgrading, to avoid spurious\n\ + \032 conflicts. The first sync after upgrading will be slow.\n\ + \032 * New functionality:\n\ + \032 + Unison now synchronizes file modtimes, user-ids, and\n\ + \032 group-ids.\n\ + \032 These new features are controlled by a set of new\n\ + \032 preferences, all of which are currently false by default.\n\ + \032 o When the times preference is set to true, file\n\ + \032 modification times are propaged. (Because the\n\ + \032 representations of time may not have the same\n\ + \032 granularity on both replicas, Unison may not always be\n\ + \032 able to make the modtimes precisely equal, but it will\n\ + \032 get them as close as the operating systems involved\n\ + \032 allow.)\n\ + \032 o When the owner preference is set to true, file ownership\n\ + \032 information is synchronized.\n\ + \032 o When the group preference is set to true, group\n\ + \032 information is synchronized.\n\ + \032 o When the numericIds preference is set to true, owner and\n\ + \032 group information is synchronized numerically. By\n\ + \032 default, owner and group numbers are converted to names\n\ + \032 on each replica and these names are synchronized. (The\n\ + \032 special user id 0 and the special group 0 are never\n\ + \032 mapped via user/group names even if this preference is\n\ + \032 not set.)\n\ + \032 + Added an integer-valued preference perms that can be used to\n\ + \032 control the propagation of permission bits. The value of this\n\ + \032 preference is a mask indicating which permission bits should\n\ + \032 be synchronized. It is set by default to 0o1777: all bits but\n\ + \032 the set-uid and set-gid bits are synchronised (synchronizing\n\ + \032 theses latter bits can be a security hazard). If you want to\n\ + \032 synchronize all bits, you can set the value of this\n\ + \032 preference to -1.\n\ + \032 + Added a log preference (default false), which makes Unison\n\ + \032 keep a complete record of the changes it makes to the\n\ + \032 replicas. By default, this record is written to a file called\n\ + \032 unison.log in the user's home directory (the value of the\n\ + \032 HOME environment variable). If you want it someplace else,\n\ + \032 set the logfile preference to the full pathname you want\n\ + \032 Unison to use.\n\ + \032 + Added an ignorenot preference that maintains a set of\n\ + \032 patterns for paths that should definitely not be ignored,\n\ + \032 whether or not they match an ignore pattern. (That is, a path\n\ + \032 will now be ignored iff it matches an ignore pattern and does\n\ + \032 not match any ignorenot patterns.)\n\ + \032 * User-interface improvements:\n\ + \032 + Roots are now displayed in the user interface in the same\n\ + \032 order as they were given on the command line or in the\n\ + \032 preferences file.\n\ + \032 + When the batch preference is set, the graphical user\n\ + \032 interface no longer waits for user confirmation when it\n\ + \032 displays a warning message: it simply pops up an advisory\n\ + \032 window with a Dismiss button at the bottom and keeps on\n\ + \032 going.\n\ + \032 + Added a new preference for controlling how many status\n\ + \032 messages are printed during update detection: statusdepth\n\ + \032 controls the maximum depth for paths on the local machine\n\ + \032 (longer paths are not displayed, nor are non-directory\n\ + \032 paths). The value should be an integer; default is 1.\n\ + \032 + Removed the trace and silent preferences. They did not seem\n\ + \032 very useful, and there were too many preferences for\n\ + \032 controlling output in various ways.\n\ + \032 + The text UI now displays just the default command (the one\n\ + \032 that will be used if the user just types ) instead of\n\ + \032 all available commands. Typing ? will print the full list of\n\ + \032 possibilities.\n\ + \032 + The function that finds the canonical hostname of the local\n\ + \032 host (which is used, for example, in calculating the name of\n\ + \032 the archive file used to remember which files have been\n\ + \032 synchronized) normally uses the gethostname operating system\n\ + \032 call. However, if the environment variable\n\ + \032 UNISONLOCALHOSTNAME is set, its value will now be used\n\ + \032 instead. This makes it easier to use Unison in situations\n\ + \032 where a machine's name changes frequently (e.g., because it\n\ + \032 is a laptop and gets moved around a lot).\n\ + \032 + File owner and group are now displayed in the \"detail window\"\n\ + \032 at the bottom of the screen, when unison is configured to\n\ + \032 synchronize them.\n\ + \032 * For hackers:\n\ + \032 + Updated to Jacques Garrigue's new version of lablgtk, which\n\ + \032 means we can throw away our local patched version.\n\ + \032 If you're compiling the GTK version of unison from sources,\n\ + \032 you'll need to update your copy of lablgtk to the developers\n\ + \032 release. (Warning: installing lablgtk under Windows is\n\ + \032 currently a bit challenging.)\n\ + \032 + The TODO.txt file (in the source distribution) has been\n\ + \032 cleaned up and reorganized. The list of pending tasks should\n\ + \032 be much easier to make sense of, for people that may want to\n\ + \032 contribute their programming energies. There is also a\n\ + \032 separate file BUGS.txt for open bugs.\n\ + \032 + The Tk user interface has been removed (it was not being\n\ + \032 maintained and no longer compiles).\n\ + \032 + The debug preference now prints quite a bit of additional\n\ + \032 information that should be useful for identifying sources of\n\ + \032 problems.\n\ + \032 + The version number of the remote server is now checked right\n\ + \032 away during the connection setup handshake, rather than\n\ + \032 later. (Somebody sent a bug report of a server crash that\n\ + \032 turned out to come from using inconsistent versions: better\n\ + \032 to check this earlier and in a way that can't crash either\n\ + \032 client or server.)\n\ + \032 + Unison now runs correctly on 64-bit architectures (e.g. Alpha\n\ + \032 linux). We will not be distributing binaries for these\n\ + \032 architectures ourselves (at least for a while) but if someone\n\ + \032 would like to make them available, we'll be glad to provide a\n\ + \032 link to them.\n\ + \032 * Bug fixes:\n\ + \032 + Pattern matching (e.g. for ignore) is now case-insensitive\n\ + \032 when Unison is in case-insensitive mode (i.e., when one of\n\ + \032 the replicas is on a windows machine).\n\ + \032 + Some people had trouble with mysterious failures during\n\ + \032 propagation of updates, where files would be falsely reported\n\ + \032 as having changed during synchronization. This should be\n\ + \032 fixed.\n\ + \032 + Numerous smaller fixes.\n\ + \n\ + \032 Changes since 2.4.1:\n\ + \032 * Added a number of 'sorting modes' for the user interface. By\n\ + \032 default, conflicting changes are displayed at the top, and the\n\ + \032 rest of the entries are sorted in alphabetical order. This\n\ + \032 behavior can be changed in the following ways:\n\ + \032 + Setting the sortnewfirst preference to true causes newly\n\ + \032 created files to be displayed before changed files.\n\ + \032 + Setting sortbysize causes files to be displayed in increasing\n\ + \032 order of size.\n\ + \032 + Giving the preference sortfirst= (where is\n\ + \032 a path descriptor in the same format as 'ignore' and 'follow'\n\ + \032 patterns, causes paths matching this pattern to be displayed\n\ + \032 first.\n\ + \032 + Similarly, giving the preference sortlast= causes\n\ + \032 paths matching this pattern to be displayed last.\n\ + \032 The sorting preferences are described in more detail in the user\n\ + \032 manual. The sortnewfirst and sortbysize flags can also be accessed\n\ + \032 from the 'Sort' menu in the grpahical user interface.\n\ + \032 * Added two new preferences that can be used to change unison's\n\ + \032 fundamental behavior to make it more like a mirroring tool instead\n\ + \032 of a synchronizer.\n\ + \032 + Giving the preference prefer with argument (by adding\n\ + \032 -prefer to the command line or prefer=) to your\n\ + \032 profile) means that, if there is a conflict, the contents of\n\ + \032 should be propagated to the other replica (with no\n\ + \032 questions asked). Non-conflicting changes are treated as\n\ + \032 usual.\n\ + \032 + Giving the preference force with argument will make\n\ + \032 unison resolve all differences in favor of the given root,\n\ + \032 even if it was the other replica that was changed.\n\ + \032 These options should be used with care! (More information is\n\ + \032 available in the manual.)\n\ + \032 * Small changes:\n\ + \032 + Changed default answer to 'Yes' in all two-button dialogs in\n\ + \032 the graphical interface (this seems more intuitive).\n\ + \032 + The rsync preference has been removed (it was used to\n\ + \032 activate rsync compression for file transfers, but rsync\n\ + \032 compression is now enabled by default).\n\ + \032 + In the text user interface, the arrows indicating which\n\ + \032 direction changes are being propagated are printed\n\ + \032 differently when the user has overridded Unison's default\n\ + \032 recommendation (====> instead of ---->). This matches the\n\ + \032 behavior of the graphical interface, which displays such\n\ + \032 arrows in a different color.\n\ + \032 + Carriage returns (Control-M's) are ignored at the ends of\n\ + \032 lines in profiles, for Windows compatibility.\n\ + \032 + All preferences are now fully documented in the user manual.\n\ + \n\ + \032 Changes since 2.3.12:\n\ + \032 * INCOMPATIBLE CHANGE: Archive format has changed. Make sure you\n\ + \032 synchronize your replicas before upgrading, to avoid spurious\n\ + \032 conflicts. The first sync after upgrading will be slow.\n\ + \032 * New/improved functionality:\n\ + \032 + A new preference -sortbysize controls the order in which\n\ + \032 changes are displayed to the user: when it is set to true,\n\ + \032 the smallest changed files are displayed first. (The default\n\ + \032 setting is false.)\n\ + \032 + A new preference -sortnewfirst causes newly created files to\n\ + \032 be listed before other updates in the user interface.\n\ + \032 + We now allow the ssh protocol to specify a port.\n\ + \032 + Incompatible change: The unison: protocol is deprecated, and\n\ + \032 we added file: and socket:. You may have to modify your\n\ + \032 profiles in the .unison directory. If a replica is specified\n\ + \032 without an explicit protocol, we now assume it refers to a\n\ + \032 file. (Previously \"//saul/foo\" meant to use SSH to connect to\n\ + \032 saul, then access the foo directory. Now it means to access\n\ + \032 saul via a remote file mechanism such as samba; the old\n\ + \032 effect is now achieved by writing ssh://saul/foo.)\n\ + \032 + Changed the startup sequence for the case where roots are\n\ + \032 given but no profile is given on the command line. The new\n\ + \032 behavior is to use the default profile (creating it if it\n\ + \032 does not exist), and temporarily override its roots. The\n\ + \032 manual claimed that this case would work by reading no\n\ + \032 profile at all, but AFAIK this was never true.\n\ + \032 + In all user interfaces, files with conflicts are always\n\ + \032 listed first\n\ + \032 + A new preference 'sshversion' can be used to control which\n\ + \032 version of ssh should be used to connect to the server. Legal\n\ + \032 values are 1 and 2. (Default is empty, which will make unison\n\ + \032 use whatever version of ssh is installed as the default 'ssh'\n\ + \032 command.)\n\ + \032 + The situation when the permissions of a file was updated the\n\ + \032 same on both side is now handled correctly (we used to report\n\ + \032 a spurious conflict)\n\ + \032 * Improvements for the Windows version:\n\ + \032 + The fact that filenames are treated case-insensitively under\n\ + \032 Windows should now be handled correctly. The exact behavior\n\ + \032 is described in the cross-platform section of the manual.\n\ + \032 + It should be possible to synchronize with Windows shares,\n\ + \032 e.g., //host/drive/path.\n\ + \032 + Workarounds to the bug in syncing root directories in\n\ + \032 Windows. The most difficult thing to fix is an ocaml bug:\n\ + \032 Unix.opendir fails on c: in some versions of Windows.\n\ + \032 * Improvements to the GTK user interface (the Tk interface is no\n\ + \032 longer being maintained):\n\ + \032 + The UI now displays actions differently (in blue) when they\n\ + \032 have been explicitly changed by the user from Unison's\n\ + \032 default recommendation.\n\ + \032 + More colorful appearance.\n\ + \032 + The initial profile selection window works better.\n\ + \032 + If any transfers failed, a message to this effect is\n\ + \032 displayed along with 'Synchronization complete' at the end of\n\ + \032 the transfer phase (in case they may have scrolled off the\n\ + \032 top).\n\ + \032 + Added a global progress meter, displaying the percentage of\n\ + \032 total bytes that have been transferred so far.\n\ + \032 * Improvements to the text user interface:\n\ + \032 + The file details will be displayed automatically when a\n\ + \032 conflict is been detected.\n\ + \032 + when a warning is generated (e.g. for a temporary file left\n\ + \032 over from a previous run of unison) Unison will no longer\n\ + \032 wait for a response if it is running in -batch mode.\n\ + \032 + The UI now displays a short list of possible inputs each time\n\ + \032 it waits for user interaction.\n\ + \032 + The UI now quits immediately (rather than looping back and\n\ + \032 starting the interaction again) if the user presses 'q' when\n\ + \032 asked whether to propagate changes.\n\ + \032 + Pressing 'g' in the text user interface will proceed\n\ + \032 immediately with propagating updates, without asking any more\n\ + \032 questions.\n\ + \032 * Documentation and installation changes:\n\ + \032 + The manual now includes a FAQ, plus sections on common\n\ + \032 problems and on tricks contributed by users.\n\ + \032 + Both the download page and the download directory explicitly\n\ + \032 say what are the current stable and beta-test version\n\ + \032 numbers.\n\ + \032 + The OCaml sources for the up-to-the-minute developers'\n\ + \032 version (not guaranteed to be stable, or even to compile, at\n\ + \032 any given time!) are now available from the download page.\n\ + \032 + Added a subsection to the manual describing cross-platform\n\ + \032 issues (case conflicts, illegal filenames)\n\ + \032 * Many small bug fixes and random improvements.\n\ + \n\ + \032 Changes since 2.3.1:\n\ + \032 * Several bug fixes. The most important is a bug in the rsync module\n\ + \032 that would occasionally cause change propagation to fail with a\n\ + \032 'rename' error.\n\ + \n\ + \032 Changes since 2.2:\n\ + \032 * The multi-threaded transport system is now disabled by default.\n\ + \032 (It is not stable enough yet.)\n\ + \032 * Various bug fixes.\n\ + \032 * A new experimental feature:\n\ + \032 The final component of a -path argument may now be the wildcard\n\ + \032 specifier *. When Unison sees such a path, it expands this path on\n\ + \032 the client into into the corresponding list of paths by listing\n\ + \032 the contents of that directory.\n\ + \032 Note that if you use wildcard paths from the command line, you\n\ + \032 will probably need to use quotes or a backslash to prevent the *\n\ + \032 from being interpreted by your shell.\n\ + \032 If both roots are local, the contents of the first one will be\n\ + \032 used for expanding wildcard paths. (Nb: this is the first one\n\ + \032 after the canonization step - i.e., the one that is listed first\n\ + \032 in the user interface - not the one listed first on the command\n\ + \032 line or in the preferences file.)\n\ + \n\ + \032 Changes since 2.1:\n\ + \032 * The transport subsystem now includes an implementation by Sylvain\n\ + \032 Gommier and Norman Ramsey of Tridgell and Mackerras's rsync\n\ + \032 protocol. This protocol achieves much faster transfers when only a\n\ + \032 small part of a large file has been changed by sending just diffs.\n\ + \032 This feature is mainly helpful for transfers over slow links--on\n\ + \032 fast local area networks it can actually degrade performance--so\n\ + \032 we have left it off by default. Start unison with the -rsync\n\ + \032 option (or put rsync=true in your preferences file) to turn it on.\n\ + \032 * \"Progress bars\" are now diplayed during remote file transfers,\n\ + \032 showing what percentage of each file has been transferred so far.\n\ + \032 * The version numbering scheme has changed. New releases will now be\n\ + \032 have numbers like 2.2.30, where the second component is\n\ + \032 incremented on every significant public release and the third\n\ + \032 component is the \"patch level.\"\n\ + \032 * Miscellaneous improvements to the GTK-based user interface.\n\ + \032 * The manual is now available in PDF format.\n\ + \032 * We are experimenting with using a multi-threaded transport\n\ + \032 subsystem to transfer several files at the same time, making much\n\ + \032 more effective use of available network bandwidth. This feature is\n\ + \032 not completely stable yet, so by default it is disabled in the\n\ + \032 release version of Unison.\n\ + \032 If you want to play with the multi-threaded version, you'll need\n\ + \032 to recompile Unison from sources (as described in the\n\ + \032 documentation), setting the THREADS flag in Makefile.OCaml to\n\ + \032 true. Make sure that your OCaml compiler has been installed with\n\ + \032 the -with-pthreads configuration option. (You can verify this by\n\ + \032 checking whether the file threads/threads.cma in the OCaml\n\ + \032 standard library directory contains the string -lpthread near the\n\ + \032 end.)\n\ + \n\ + \032 Changes since 1.292:\n\ + \032 * Reduced memory footprint (this is especially important during the\n\ + \032 first run of unison, where it has to gather information about all\n\ + \032 the files in both repositories).\n\ + \032 * Fixed a bug that would cause the socket server under NT to fail\n\ + \032 after the client exits.\n\ + \032 * Added a SHIFT modifier to the Ignore menu shortcut keys in GTK\n\ + \032 interface (to avoid hitting them accidentally).\n\ + \n\ + \032 Changes since 1.231:\n\ + \032 * Tunneling over ssh is now supported in the Windows version. See\n\ + \032 the installation section of the manual for detailed instructions.\n\ + \032 * The transport subsystem now includes an implementation of the\n\ + \032 rsync protocol, built by Sylvain Gommier and Norman Ramsey. This\n\ + \032 protocol achieves much faster transfers when only a small part of\n\ + \032 a large file has been changed by sending just diffs. The rsync\n\ + \032 feature is off by default in the current version. Use the -rsync\n\ + \032 switch to turn it on. (Nb. We still have a lot of tuning to do:\n\ + \032 you may not notice much speedup yet.)\n\ + \032 * We're experimenting with a multi-threaded transport subsystem,\n\ + \032 written by Jerome Vouillon. The downloadable binaries are still\n\ + \032 single-threaded: if you want to try the multi-threaded version,\n\ + \032 you'll need to recompile from sources. (Say make THREADS=true.)\n\ + \032 Native thread support from the compiler is required. Use the\n\ + \032 option -threads N to select the maximal number of concurrent\n\ + \032 threads (default is 5). Multi-threaded and single-threaded\n\ + \032 clients/servers can interoperate.\n\ + \032 * A new GTK-based user interface is now available, thanks to Jacques\n\ + \032 Garrigue. The Tk user interface still works, but we'll be shifting\n\ + \032 development effort to the GTK interface from now on.\n\ + \032 * OCaml 3.00 is now required for compiling Unison from sources. The\n\ + \032 modules uitk and myfileselect have been changed to use labltk\n\ + \032 instead of camltk. To compile the Tk interface in Windows, you\n\ + \032 must have ocaml-3.00 and tk8.3. When installing tk8.3, put it in\n\ + \032 c:\\Tcl rather than the suggested c:\\Program Files\\Tcl, and be sure\n\ + \032 to install the headers and libraries (which are not installed by\n\ + \032 default).\n\ + \032 * Added a new -addversionno switch, which causes unison to use\n\ + \032 unison- instead of just unison as the remote\n\ + \032 server command. This allows multiple versions of unison to coexist\n\ + \032 conveniently on the same server: whichever version is run on the\n\ + \032 client, the same version will be selected on the server.\n\ + \n\ + \032 Changes since 1.219:\n\ + \032 * INCOMPATIBLE CHANGE: Archive format has changed. Make sure you\n\ + \032 synchronize your replicas before upgrading, to avoid spurious\n\ + \032 conflicts. The first sync after upgrading will be slow.\n\ + \032 * This version fixes several annoying bugs, including:\n\ + \032 + Some cases where propagation of file permissions was not\n\ + \032 working.\n\ + \032 + umask is now ignored when creating directories\n\ + \032 + directories are create writable, so that a read-only\n\ + \032 directory and its contents can be propagated.\n\ + \032 + Handling of warnings generated by the server.\n\ + \032 + Synchronizing a path whose parent is not a directory on both\n\ + \032 sides is now flagged as erroneous.\n\ + \032 + Fixed some bugs related to symnbolic links and nonexistant\n\ + \032 roots.\n\ + \032 o When a change (deletion or new contents) is propagated\n\ + \032 onto a 'follow'ed symlink, the file pointed to by the\n\ + \032 link is now changed. (We used to change the link itself,\n\ + \032 which doesn't fit our assertion that 'follow' means the\n\ + \032 link is completely invisible)\n\ + \032 o When one root did not exist, propagating the other root\n\ + \032 on top of it used to fail, becuase unison could not\n\ + \032 calculate the working directory into which to write\n\ + \032 changes. This should be fixed.\n\ + \032 * A human-readable timestamp has been added to Unison's archive\n\ + \032 files.\n\ + \032 * The semantics of Path and Name regular expressions now correspond\n\ + \032 better.\n\ + \032 * Some minor improvements to the text UI (e.g. a command for going\n\ + \032 back to previous items)\n\ + \032 * The organization of the export directory has changed -- should be\n\ + \032 easier to find / download things now.\n\ + \n\ + \032 Changes since 1.200:\n\ + \032 * INCOMPATIBLE CHANGE: Archive format has changed. Make sure you\n\ + \032 synchronize your replicas before upgrading, to avoid spurious\n\ + \032 conflicts. The first sync after upgrading will be slow.\n\ + \032 * This version has not been tested extensively on Windows.\n\ + \032 * Major internal changes designed to make unison safer to run at the\n\ + \032 same time as the replicas are being changed by the user.\n\ + \032 * Internal performance improvements.\n\ + \n\ + \032 Changes since 1.190:\n\ + \032 * INCOMPATIBLE CHANGE: Archive format has changed. Make sure you\n\ + \032 synchronize your replicas before upgrading, to avoid spurious\n\ + \032 conflicts. The first sync after upgrading will be slow.\n\ + \032 * A number of internal functions have been changed to reduce the\n\ + \032 amount of memory allocation, especially during the first\n\ + \032 synchronization. This should help power users with very big\n\ + \032 replicas.\n\ + \032 * Reimplementation of low-level remote procedure call stuff, in\n\ + \032 preparation for adding rsync-like smart file transfer in a later\n\ + \032 release.\n\ + \032 * Miscellaneous bug fixes.\n\ + \n\ + \032 Changes since 1.180:\n\ + \032 * INCOMPATIBLE CHANGE: Archive format has changed. Make sure you\n\ + \032 synchronize your replicas before upgrading, to avoid spurious\n\ + \032 conflicts. The first sync after upgrading will be slow.\n\ + \032 * Fixed some small bugs in the interpretation of ignore patterns.\n\ + \032 * Fixed some problems that were preventing the Windows version from\n\ + \032 working correctly when click-started.\n\ + \032 * Fixes to treatment of file permissions under Windows, which were\n\ + \032 causing spurious reports of different permissions when\n\ + \032 synchronizing between windows and unix systems.\n\ + \032 * Fixed one more non-tail-recursive list processing function, which\n\ + \032 was causing stack overflows when synchronizing very large\n\ + \032 replicas.\n\ + \n\ + \032 Changes since 1.169:\n\ + \032 * The text user interface now provides commands for ignoring files.\n\ + \032 * We found and fixed some more non-tail-recursive list processing\n\ + \032 functions. Some power users have reported success with very large\n\ + \032 replicas.\n\ + \032 * INCOMPATIBLE CHANGE: Files ending in .tmp are no longer ignored\n\ + \032 automatically. If you want to ignore such files, put an\n\ + \032 appropriate ignore pattern in your profile.\n\ + \032 * INCOMPATIBLE CHANGE: The syntax of ignore and follow patterns has\n\ + \032 changed. Instead of putting a line of the form\n\ + \032 ignore = \n\ + \032 in your profile (.unison/default.prf), you should put:\n\ + \032 ignore = Regexp \n\ + \032 Moreover, two other styles of pattern are also recognized:\n\ + \032 ignore = Name \n\ + \032 matches any path in which one component matches , while\n\ + \032 ignore = Path \n\ + \032 matches exactly the path .\n\ + \032 Standard \"globbing\" conventions can be used in and :\n\ + \032 + a ? matches any single character except /\n\ + \032 + a * matches any sequence of characters not including /\n\ + \032 + [xyz] matches any character from the set {x, y, z }\n\ + \032 + {a,bb,ccc} matches any one of a, bb, or ccc.\n\ + \032 See the user manual for some examples.\n\ + \n\ + \032 Changes since 1.146:\n\ + \032 * Some users were reporting stack overflows when synchronizing huge\n\ + \032 directories. We found and fixed some non-tail-recursive list\n\ + \032 processing functions, which we hope will solve the problem. Please\n\ + \032 give it a try and let us know.\n\ + \032 * Major additions to the documentation.\n\ + \n\ + \032 Changes since 1.142:\n\ + \032 * Major internal tidying and many small bugfixes.\n\ + \032 * Major additions to the user manual.\n\ + \032 * Unison can now be started with no arguments - it will prompt\n\ + \032 automatically for the name of a profile file containing the roots\n\ + \032 to be synchronized. This makes it possible to start the graphical\n\ + \032 UI from a desktop icon.\n\ + \032 * Fixed a small bug where the text UI on NT was raising a 'no such\n\ + \032 signal' exception.\n\ + \n\ + \032 Changes since 1.139:\n\ + \032 * The precompiled windows binary in the last release was compiled\n\ + \032 with an old OCaml compiler, causing propagation of permissions not\n\ + \032 to work (and perhaps leading to some other strange behaviors we've\n\ + \032 heard reports about). This has been corrected. If you're using\n\ + \032 precompiled binaries on Windows, please upgrade.\n\ + \032 * Added a -debug command line flag, which controls debugging of\n\ + \032 various modules. Say -debug XXX to enable debug tracing for module\n\ + \032 XXX, or -debug all to turn on absolutely everything.\n\ + \032 * Fixed a small bug where the text UI on NT was raising a 'no such\n\ + \032 signal' exception.\n\ + \n\ + \032 Changes since 1.111:\n\ + \032 * INCOMPATIBLE CHANGE: The names and formats of the preference files\n\ + \032 in the .unison directory have changed. In particular:\n\ + \032 + the file \"prefs\" should be renamed to default.prf\n\ + \032 + the contents of the file \"ignore\" should be merged into\n\ + \032 default.prf. Each line of the form REGEXP in ignore should\n\ + \032 become a line of the form ignore = REGEXP in default.prf.\n\ + \032 * Unison now handles permission bits and symbolic links. See the\n\ + \032 manual for details.\n\ + \032 * You can now have different preference files in your .unison\n\ + \032 directory. If you start unison like this\n\ + \032 unison profilename\n\ + \032 (i.e. with just one \"anonymous\" command-line argument), then the\n\ + \032 file ~/.unison/profilename.prf will be loaded instead of\n\ + \032 default.prf.\n\ + \032 * Some improvements to terminal handling in the text user interface\n\ + \032 * Added a switch -killServer that terminates the remote server\n\ + \032 process when the unison client is shutting down, even when using\n\ + \032 sockets for communication. (By default, a remote server created\n\ + \032 using ssh/rsh is terminated automatically, while a socket server\n\ + \032 is left running.)\n\ + \032 * When started in 'socket server' mode, unison prints 'server\n\ + \032 started' on stderr when it is ready to accept connections. (This\n\ + \032 may be useful for scripts that want to tell when a socket-mode\n\ + \032 server has finished initalization.)\n\ + \032 * We now make a nightly mirror of our current internal development\n\ + \032 tree, in case anyone wants an up-to-the-minute version to hack\n\ + \032 around with.\n\ + \032 * Added a file CONTRIB with some suggestions for how to help us make\n\ + \032 Unison better.\n\ + \n\ + ")) +:: + ("", ("Junk", + "Junk\n\ + \032 _________________________________________________________________\n\ + \n\ + \032 This document was translated from L^AT[E]X by [2]H^EV^EA.\n\ + \n\ + References\n\ + \n\ + \032 1. file://localhost/Users/bcpierce/current/unison/trunk/doc/temp.html#ssh-win\n\ + \032 2. http://pauillac.inria.fr/~maranget/hevea/index.html\n\ + ")) +:: + [];; + Deleted: branches/2.32/src/strings.mli =================================================================== --- trunk/src/strings.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/strings.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,4 +0,0 @@ -(* Unison file synchronizer: src/strings.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -val docs : (string * (string * string)) list Copied: branches/2.32/src/strings.mli (from rev 320, trunk/src/strings.mli) =================================================================== --- branches/2.32/src/strings.mli (rev 0) +++ branches/2.32/src/strings.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,4 @@ +(* Unison file synchronizer: src/strings.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +val docs : (string * (string * string)) list Deleted: branches/2.32/src/test.ml =================================================================== --- trunk/src/test.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/test.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,443 +0,0 @@ -(* Unison file synchronizer: src/test.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -let (>>=) = Lwt.(>>=) - -(* ---------------------------------------------------------------------- *) -(* Utility functions *) - -let debug = Trace.debug "test" -let verbose = Trace.debug "test" - -let rec remove_file_or_dir d = - match try Some(Unix.lstat d) with Unix.Unix_error((Unix.ENOENT | Unix.ENOTDIR),_,_) -> None with - | Some(s) -> - if s.Unix.st_kind = Unix.S_DIR then begin - let handle = Unix.opendir d in - let rec loop () = - let r = try Some(Unix.readdir handle) with End_of_file -> None in - match r with - | Some f -> - if f="." || f=".." then loop () - else begin - remove_file_or_dir (d^"/"^f); - loop () - end - | None -> - Unix.closedir handle; - Unix.rmdir d - in loop () - end else - Sys.remove d - | None -> () - -let read_chan chan = - let nbytes = in_channel_length chan in - let string = String.create nbytes in - really_input chan string 0 nbytes; - string - -let read file = - if file = "-" then - read_chan stdin - else - let chan = open_in_bin file in - try - let r = read_chan chan in - close_in chan; - r - with exn -> - close_in chan; - raise exn - -let write file s = - if file = "-" then - output_string stdout s - else - let chan = open_out_bin file in - try - output_string chan s; - close_out chan - with exn -> - close_out chan; - raise exn - -let read_dir d = - let ignored = ["."; ".."] in - let d = Unix.opendir d in - let rec do_read acc = - try - (match (Unix.readdir d) with - | s when Safelist.mem s ignored -> do_read acc - | f -> do_read (f :: acc)) - with End_of_file -> acc - in - let files = do_read [] in - Unix.closedir d; - files - -let extend p file = - p ^ "/" ^ file - -type fs = - | File of string - | Link of string - | Dir of (string * fs) list - -let rec equal fs1 fs2 = - match fs1,fs2 with - | File s1, File s2 -> s1=s2 - | Link s1, Link s2 -> s1=s2 - | Dir d1, Dir d2 -> - let dom d = Safelist.sort String.compare (Safelist.map fst d) in - (dom d1 = dom d2) - && (Safelist.for_all - (fun x -> - equal (Safelist.assoc x d1) (Safelist.assoc x d2))) - (dom d1) - | _,_ -> false - -let rec fs2string = function - | File s -> "File \"" ^ s ^ "\"" - | Link s -> "Link \"" ^ s ^ "\"" - | Dir s -> "Dir [" ^ (String.concat "; " - (Safelist.map (fun (n,fs') -> "(\""^n^"\", "^(fs2string fs')^")") s)) ^ "]" - -let fsopt2string = function - None -> "MISSING" - | Some(f) -> fs2string f - -let readfs p = - let rec loop p = - let s = Unix.lstat p in - match s.Unix.st_kind with - | Unix.S_REG -> File (read p) - | Unix.S_LNK -> Link (Unix.readlink p) - | Unix.S_DIR -> Dir (Safelist.map (fun x -> (x, loop (extend p x))) (read_dir p)) - | _ -> assert false - in try Some(loop p) with - Unix.Unix_error (Unix.ENOENT,_,_) -> None - -let default_perm = 0o755 - -let writefs p fs = - verbose (fun() -> Util.msg "Writing new test filesystem\n"); - let rec loop p = function - | File s -> - verbose (fun() -> Util.msg "Writing %s with contents %s (fingerprint %s)\n" - p s (Fingerprint.toString (Fingerprint.string s))); - write p s - | Link s -> Unix.symlink s p - | Dir files -> - Unix.mkdir p default_perm; - Safelist.iter (fun (x,cont) -> loop (extend p x) cont) files - in - remove_file_or_dir p; - loop p fs - -let checkRootEmpty : Common.root -> unit -> unit Lwt.t = - Remote.registerRootCmd - "checkRootEmpty" - (fun (fspath, ()) -> - if Os.exists fspath Path.empty then - raise (Util.Fatal (Printf.sprintf - "Path %s is not empty at start of tests!" - (Fspath.toString fspath))); - Lwt.return ()) - -let makeRootEmpty : Common.root -> unit -> unit Lwt.t = - Remote.registerRootCmd - "makeRootEmpty" - (fun (fspath, ()) -> - remove_file_or_dir (Fspath.toString fspath); - Lwt.return ()) - -let getfs : Common.root -> unit -> (fs option) Lwt.t = - Remote.registerRootCmd - "getfs" - (fun (fspath, ()) -> - Lwt.return (readfs (Fspath.toString fspath))) - -let getbackup : Common.root -> unit -> (fs option) Lwt.t = - Remote.registerRootCmd - "getbackup" - (fun (fspath, ()) -> - Lwt.return (readfs (Fspath.toString (Stasher.backupDirectory ())))) - -let makeBackupEmpty : Common.root -> unit -> unit Lwt.t = - Remote.registerRootCmd - "makeBackupEmpty" - (fun (fspath, ()) -> - let b = Fspath.toString (Stasher.backupDirectory ()) in - debug (fun () -> Util.msg "Removing %s\n" b); - Lwt.return (remove_file_or_dir b)) - -let putfs : Common.root -> fs -> unit Lwt.t = - Remote.registerRootCmd - "putfs" - (fun (fspath, fs) -> - writefs (Fspath.toString fspath) fs; - Lwt.return ()) - -let loadPrefs l = - Prefs.loadStrings l; - Lwt_unix.run (Globals.propagatePrefs ()); - Stasher.initBackups() - -(* ---------------------------------------------------------------------------- *) - -let displayRis ris = - Safelist.iter - (fun ri -> - Util.msg "%s\n" (Uicommon.reconItem2string Path.empty ri "")) - ris - -let sync ?(verbose=false) () = - let (reconItemList, _, _) = - Recon.reconcileAll (Update.findUpdates()) in - if verbose then begin - Util.msg "Sync result:\n"; - displayRis reconItemList - end; - Lwt_unix.run ( - Lwt_util.iter - (fun ri -> - Transport.transportItem ri - (Uutil.File.ofLine 0) (fun _ _ -> true)) - reconItemList); - Update.commitUpdates() - -let currentTest = ref "" - -type checkable = R1 | R2 | BACKUP1 | BACKUP2 - -let checkable2string = function - R1 -> "R1" | R2 -> "R2" | BACKUP1 -> "BACKUP1" | BACKUP2 -> "BACKUP2" - -let test() = - Util.warnPrinter := None; - Prefs.set Trace.logging false; - Prefs.set Trace.terse true; - Trace.sendLogMsgsToStderr := false; - - let origPrefs = Prefs.dump() in - - let runtest name prefs f = - Util.msg "%s...\n" name; - Util.convertUnixErrorsToFatal "Test.test" (fun() -> - currentTest := name; - Prefs.load origPrefs; - loadPrefs prefs; - debug (fun() -> Util.msg "Emptying backup directory\n"); - Lwt_unix.run (Globals.allRootsIter (fun r -> makeBackupEmpty r ())); - debug (fun() -> Util.msg "Running test\n"); - f(); - ) in - - Util.msg "Running internal tests...\n"; - - (* Paranoid checks, to make sure we do not delete anybody's filesystem! *) - if not (Safelist.for_all - (fun r -> Util.findsubstring "test" r <> None) - (Globals.rawRoots())) then - raise (Util.Fatal - "Self-tests can only be run if both roots include the string 'test'"); - if Util.findsubstring "test" (Fspath.toString (Stasher.backupDirectory())) = None then - raise (Util.Fatal - ("Self-tests can only be run if the 'backupdir' preference (or wherever the backup " - ^ "directory name is coming from, e.g. the UNISONBACKUPDIR environment variable) " - ^ "includes the string 'test'")); - - Lwt_unix.run (Globals.allRootsIter (fun r -> makeRootEmpty r ())); - - let (r2,r1) = Globals.roots () in - (* Util.msg "r1 = %s r2 = %s...\n" (Common.root2string r1) (Common.root2string r2); *) - let bothRootsLocal = - match (r1,r2) with - (Common.Local,_),(Common.Local,_) -> true - | _ -> false in - - let put c fs = - Lwt_unix.run - (match c with - R1 -> putfs r1 fs | R2 -> putfs r2 fs | BACKUP1 | BACKUP2 -> assert false) in - - let failures = ref 0 in - - let check name c fs = - debug (fun() -> Util.msg "Checking %s / %s\n" (!currentTest) name); - let actual = - Lwt_unix.run - ((match c with - R1 -> getfs r1 | R2 -> getfs r2 | BACKUP1 -> getbackup r1 | BACKUP2 -> getbackup r2) ()) in - let fail () = - Util.msg - "Test %s / %s: \nExpected %s = \n %s\nbut found\n %s\n" - (!currentTest) name (checkable2string c) (fs2string fs) (fsopt2string actual); - failures := !failures+1; - raise (Util.Fatal (Printf.sprintf "Self-test %s / %s failed!" (!currentTest) name)) in - match actual with - Some(a) -> if not (equal a fs) then fail() - | None -> fail() in - - let checkmissing name c = - debug (fun() -> Util.msg "Checking nonexistence %s / %s\n" (!currentTest) name); - let actual = - Lwt_unix.run - ((match c with - R1 -> getfs r1 | R2 -> getfs r2 | BACKUP1 -> getbackup r1 | BACKUP2 -> getbackup r2) ()) in - if actual <> None then begin - Util.msg - "Test %s / %s: \nExpected %s MISSING\nbut found\n %s\n" - (!currentTest) name (checkable2string c) (fsopt2string actual); - failures := !failures+1; - raise (Util.Fatal (Printf.sprintf "Self-test %s / %s failed!" (!currentTest) name)) - end in - - (* N.b.: When making up tests, it's important to choose file contents of different - lengths. The reason for this is that, on some Unix systems, it is possible for - the inode number of a just-deleted file to be reassigned to the very next file - created -- i.e., to the updated version of the file that the test script has - just written. If the length of the contents is also the same and the test is - running fast enough that the whole thing happens within a second, then the - update will be missed! *) - - (* Check for the bug reported by Ralf Lehmann *) - if not bothRootsLocal then - runtest "backups 1 (remote)" ["backup = Name *"] (fun() -> - put R1 (Dir []); put R2 (Dir []); sync(); - debug (fun () -> Util.msg "First check\n"); - checkmissing "1" BACKUP1; - checkmissing "2" BACKUP2; - (* Create a file *) - put R1 (Dir ["test.txt", File "1"]); sync(); - checkmissing "3" BACKUP1; - checkmissing "4" BACKUP2; - (* Change it and check that the old version got backed up on the target host *) - put R1 (Dir ["test.txt", File "2"]); sync(); - checkmissing "5" BACKUP1; - check "6" BACKUP2 (Dir [("test.txt", File "1")]); - ); - - if bothRootsLocal then - runtest "backups 1 (local)" ["backup = Name *"] (fun() -> - put R1 (Dir []); put R2 (Dir []); sync(); - (* Create a file and a directory *) - put R1 (Dir ["x", File "foo"; "d", Dir ["a", File "barr"]]); sync(); - (* Delete them *) - put R1 (Dir []); sync(); - check "1" BACKUP1 (Dir ["x", File "foo"; "d", Dir ["a", File "barr"]]); - (* Put them back and delete them once more *) - put R1 (Dir ["x", File "FOO"; "d", Dir ["a", File "BARR"]]); sync(); - put R1 (Dir []); sync(); - check "2" BACKUP1 (Dir [("x", File "FOO"); ("d", Dir [("a", File "BARR")]); - (".bak.1.x", File "foo"); (".bak.1.d", Dir [("a", File "barr")])]) - ); - - runtest "backups 2" ["backup = Name *"; "backuplocation = local"] (fun() -> - put R1 (Dir []); put R2 (Dir []); sync(); - (* Create a file and a directory *) - put R1 (Dir ["x", File "foo"; "d", Dir ["a", File "barr"]]); sync(); - (* Delete them *) - put R1 (Dir []); sync(); - (* Check that they have been backed up correctly on the other side *) - check "1" R2 (Dir [(".bak.0.x", File "foo"); (".bak.0.d", Dir [("a", File "barr")])]); - ); - - runtest "backups 2a" ["backup = Name *"; "backuplocation = local"] (fun() -> - put R1 (Dir []); put R2 (Dir []); sync(); - (* Create a file and a directory *) - put R1 (Dir ["foo", File "1"]); sync(); - check "1" R1 (Dir [("foo", File "1")]); - check "2" R1 (Dir [("foo", File "1")]); - put R1 (Dir ["foo", File "2"]); sync(); - check "3" R1 (Dir [("foo", File "2")]); - check "4" R2 (Dir [("foo", File "2"); (".bak.0.foo", File "1")]); - ); - - runtest "backups 3" ["backup = Name *"; "backuplocation = local"; "backupcurrent = Name *"] (fun() -> - put R1 (Dir []); put R2 (Dir []); sync(); - put R1 (Dir ["x", File "foo"]); sync (); - check "1a" R1 (Dir [("x", File "foo"); (".bak.0.x", File "foo")]); - check "1b" R2 (Dir [("x", File "foo"); (".bak.0.x", File "foo")]); - put R2 (Dir ["x", File "barr"; (".bak.0.x", File "foo")]); sync (); - check "2a" R1 (Dir [("x", File "barr"); (".bak.1.x", File "foo"); (".bak.0.x", File "barr")]); - check "2b" R2 (Dir [("x", File "barr"); (".bak.1.x", File "foo"); (".bak.0.x", File "barr")]); - ); - - runtest "backups 4" ["backup = Name *"; "backupcurrent = Name *"; "maxbackups = 7"] (fun() -> - put R1 (Dir []); put R2 (Dir []); sync(); - put R1 (Dir ["x", File "foo"]); sync(); - check "1a" BACKUP1 (Dir [("x", File "foo")]); - put R1 (Dir ["x", File "barr"]); sync(); - check "1b" BACKUP1 (Dir [("x", File "barr"); (".bak.1.x", File "foo")]); - put R2 (Dir ["x", File "bazzz"]); sync(); - check "1c" BACKUP1 (Dir [("x", File "bazzz"); (".bak.2.x", File "foo"); (".bak.1.x", File "barr")]); - ); - - runtest "backups 5 (directories)" ["backup = Name *"; "backupcurrent = Name *"; "maxbackups = 7"] (fun() -> - put R1 (Dir []); put R2 (Dir []); sync(); - (* Create a directory x containing files a and l; check that the current version gets backed up *) - put R1 (Dir ["x", Dir ["a", File "foo"; "l", File "./foo"]]); sync(); - check "1" BACKUP1 (Dir [("x", Dir [("l", File "./foo"); ("a", File "foo")])]); - (* On replica 2, delete file a, create file b, and edit file l *) - put R2 (Dir ["x", Dir ["b", File "barr"; "l", File "./barr"]]); sync(); - check "2" BACKUP1 (Dir [("x", Dir [("l", File "./barr"); ("b", File "barr"); ("a", File "foo"); (".bak.1.l", File "./foo")])]); - (* On replica 1, replace the whole directory by a file; when we check the result, we need to know - whether we're running the test locally or remotely; in the former case, we should see *both* the - old and the new version as backups *) - put R1 (Dir ["x", File "bazzz"]); sync(); - if bothRootsLocal then - check "3" BACKUP1 (Dir [("x", File "bazzz"); (".bak.2.x", Dir [("l", File "./barr"); ("b", File "barr"); ("a", File "foo"); (".bak.1.l", File "./foo")]); (".bak.1.x", Dir [("l", File "./barr"); ("b", File "barr")])]) - else - check "3" BACKUP1 (Dir [("x", File "bazzz"); (".bak.1.x", Dir [("l", File "./barr"); ("b", File "barr"); ("a", File "foo"); (".bak.1.l", File "./foo")])]); - ); - - runtest "backups 6 (backup prefix/suffix)" ["backup = Name *"; - "backuplocation = local"; - "backupprefix = back/$VERSION-"; - "backupsuffix = .backup"; - "backupcurrent = Name *"] (fun() -> - put R1 (Dir []); put R2 (Dir []); sync(); - put R1 (Dir ["x", File "foo"]); sync(); - check "1" R1 (Dir [("x", File "foo"); ("back", Dir [("0-x.backup", File "foo")])]); - ); - - if not (Prefs.read Globals.someHostIsRunningWindows) then begin - runtest "links 1 (directories and links)" ["backup = Name *"; "backupcurrent = Name *"; "maxbackups = 7"] (fun() -> - put R1 (Dir []); put R2 (Dir []); sync(); - put R1 (Dir ["x", Dir ["a", File "foo"; "l", Link "./foo"]]); sync(); - check "1" BACKUP1 (Dir [("x", Dir [("l", Link "./foo"); ("a", File "foo")])]); - put R2 (Dir ["x", Dir ["b", File "barr"; "l", Link "./barr"]]); sync(); - check "2" BACKUP1 (Dir [("x", Dir [("l", Link "./barr"); ("b", File "barr"); ("a", File "foo"); (".bak.1.l", Link "./foo")])]); - put R1 (Dir ["x", File "bazzz"]); sync(); - if bothRootsLocal then - check "3" BACKUP1 - (Dir [("x", File "bazzz"); - (".bak.2.x", Dir [("l", Link "./barr"); ("b", File "barr"); ("a", File "foo"); - (".bak.1.l", Link "./foo")]); - (".bak.1.x", Dir [("l", Link "./barr"); ("b", File "barr")])]) - else - check "3" BACKUP1 - (Dir [("x", File "bazzz"); - (".bak.1.x", Dir [("l", Link "./barr"); ("b", File "barr"); - ("a", File "foo"); (".bak.1.l", Link "./foo")])]); - ); - - (* Test that we correctly fail when we try to 'follow' a symlink that does not - point to anything *) - runtest "links 2 (symlink to nowhere)" ["follow = Name y"] (fun() -> - let orig = (Dir []) in - put R1 orig; put R2 orig; sync(); - put R1 (Dir ["y", Link "x"]); sync(); - check "1" R2 orig; - ); - end; - - if !failures = 0 then - Util.msg "Success :-)\n" - else - raise (Util.Fatal "Self-tests failed\n") - -(* Initialization: tie the knot between this module and Uicommon *) -let _ = (Uicommon.testFunction := test) Copied: branches/2.32/src/test.ml (from rev 320, trunk/src/test.ml) =================================================================== --- branches/2.32/src/test.ml (rev 0) +++ branches/2.32/src/test.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,458 @@ +(* Unison file synchronizer: src/test.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +let (>>=) = Lwt.(>>=) + +(* ---------------------------------------------------------------------- *) +(* Utility functions *) + +let debug = Trace.debug "test" +let verbose = Trace.debug "test" + +let rec remove_file_or_dir d = + match try Some(Unix.lstat d) with Unix.Unix_error((Unix.ENOENT | Unix.ENOTDIR),_,_) -> None with + | Some(s) -> + if s.Unix.st_kind = Unix.S_DIR then begin + let handle = Unix.opendir d in + let rec loop () = + let r = try Some(Unix.readdir handle) with End_of_file -> None in + match r with + | Some f -> + if f="." || f=".." then loop () + else begin + remove_file_or_dir (d^"/"^f); + loop () + end + | None -> + Unix.closedir handle; + Unix.rmdir d + in loop () + end else + Sys.remove d + | None -> () + +let read_chan chan = + let nbytes = in_channel_length chan in + let string = String.create nbytes in + really_input chan string 0 nbytes; + string + +let read file = + if file = "-" then + read_chan stdin + else + let chan = open_in_bin file in + try + let r = read_chan chan in + close_in chan; + r + with exn -> + close_in chan; + raise exn + +let write file s = + if file = "-" then + output_string stdout s + else + let chan = open_out_bin file in + try + output_string chan s; + close_out chan + with exn -> + close_out chan; + raise exn + +let read_dir d = + let ignored = ["."; ".."] in + let d = Unix.opendir d in + let rec do_read acc = + try + (match (Unix.readdir d) with + | s when Safelist.mem s ignored -> do_read acc + | f -> do_read (f :: acc)) + with End_of_file -> acc + in + let files = do_read [] in + Unix.closedir d; + files + +let extend p file = + p ^ "/" ^ file + +type fs = + | File of string + | Link of string + | Dir of (string * fs) list + +let rec equal fs1 fs2 = + match fs1,fs2 with + | File s1, File s2 -> s1=s2 + | Link s1, Link s2 -> s1=s2 + | Dir d1, Dir d2 -> + let dom d = Safelist.sort String.compare (Safelist.map fst d) in + (dom d1 = dom d2) + && (Safelist.for_all + (fun x -> + equal (Safelist.assoc x d1) (Safelist.assoc x d2))) + (dom d1) + | _,_ -> false + +let rec fs2string = function + | File s -> "File \"" ^ s ^ "\"" + | Link s -> "Link \"" ^ s ^ "\"" + | Dir s -> "Dir [" ^ (String.concat "; " + (Safelist.map (fun (n,fs') -> "(\""^n^"\", "^(fs2string fs')^")") s)) ^ "]" + +let fsopt2string = function + None -> "MISSING" + | Some(f) -> fs2string f + +let readfs p = + let rec loop p = + let s = Unix.lstat p in + match s.Unix.st_kind with + | Unix.S_REG -> File (read p) + | Unix.S_LNK -> Link (Unix.readlink p) + | Unix.S_DIR -> Dir (Safelist.map (fun x -> (x, loop (extend p x))) (read_dir p)) + | _ -> assert false + in try Some(loop p) with + Unix.Unix_error (Unix.ENOENT,_,_) -> None + +let default_perm = 0o755 + +let writefs p fs = + verbose (fun() -> Util.msg "Writing new test filesystem\n"); + let rec loop p = function + | File s -> + verbose (fun() -> Util.msg "Writing %s with contents %s (fingerprint %s)\n" + p s (Fingerprint.toString (Fingerprint.string s))); + write p s + | Link s -> Unix.symlink s p + | Dir files -> + Unix.mkdir p default_perm; + Safelist.iter (fun (x,cont) -> loop (extend p x) cont) files + in + remove_file_or_dir p; + loop p fs + +let checkRootEmpty : Common.root -> unit -> unit Lwt.t = + Remote.registerRootCmd + "checkRootEmpty" + (fun (fspath, ()) -> + if Os.exists fspath Path.empty then + raise (Util.Fatal (Printf.sprintf + "Path %s is not empty at start of tests!" + (Fspath.toString fspath))); + Lwt.return ()) + +let makeRootEmpty : Common.root -> unit -> unit Lwt.t = + Remote.registerRootCmd + "makeRootEmpty" + (fun (fspath, ()) -> + remove_file_or_dir (Fspath.toString fspath); + Lwt.return ()) + +let getfs : Common.root -> unit -> (fs option) Lwt.t = + Remote.registerRootCmd + "getfs" + (fun (fspath, ()) -> + Lwt.return (readfs (Fspath.toString fspath))) + +let getbackup : Common.root -> unit -> (fs option) Lwt.t = + Remote.registerRootCmd + "getbackup" + (fun (fspath, ()) -> + Lwt.return (readfs (Fspath.toString (Stasher.backupDirectory ())))) + +let makeBackupEmpty : Common.root -> unit -> unit Lwt.t = + Remote.registerRootCmd + "makeBackupEmpty" + (fun (fspath, ()) -> + let b = Fspath.toString (Stasher.backupDirectory ()) in + debug (fun () -> Util.msg "Removing %s\n" b); + Lwt.return (remove_file_or_dir b)) + +let putfs : Common.root -> fs -> unit Lwt.t = + Remote.registerRootCmd + "putfs" + (fun (fspath, fs) -> + writefs (Fspath.toString fspath) fs; + Lwt.return ()) + +let loadPrefs l = + Prefs.loadStrings l; + Lwt_unix.run (Globals.propagatePrefs ()); + Stasher.initBackups() + +(* ---------------------------------------------------------------------------- *) + +let displayRis ris = + Safelist.iter + (fun ri -> + Util.msg "%s\n" (Uicommon.reconItem2string Path.empty ri "")) + ris + +let sync ?(verbose=false) () = + let (reconItemList, _, _) = + Recon.reconcileAll (Update.findUpdates()) in + if verbose then begin + Util.msg "Sync result:\n"; + displayRis reconItemList + end; + Lwt_unix.run ( + Lwt_util.iter + (fun ri -> + Transport.transportItem ri + (Uutil.File.ofLine 0) (fun _ _ -> true)) + reconItemList); + Update.commitUpdates() + +let currentTest = ref "" + +type checkable = R1 | R2 | BACKUP1 | BACKUP2 + +let checkable2string = function + R1 -> "R1" | R2 -> "R2" | BACKUP1 -> "BACKUP1" | BACKUP2 -> "BACKUP2" + +let test() = + Util.warnPrinter := None; + Prefs.set Trace.logging false; + Prefs.set Trace.terse true; + Trace.sendLogMsgsToStderr := false; + + let origPrefs = Prefs.dump() in + + let runtest name prefs f = + Util.msg "%s...\n" name; + Util.convertUnixErrorsToFatal "Test.test" (fun() -> + currentTest := name; + Prefs.load origPrefs; + loadPrefs prefs; + debug (fun() -> Util.msg "Emptying backup directory\n"); + Lwt_unix.run (Globals.allRootsIter (fun r -> makeBackupEmpty r ())); + debug (fun() -> Util.msg "Running test\n"); + f(); + ) in + + Util.msg "Running internal tests...\n"; + + (* Paranoid checks, to make sure we do not delete anybody's filesystem! *) + if not (Safelist.for_all + (fun r -> Util.findsubstring "test" r <> None) + (Globals.rawRoots())) then + raise (Util.Fatal + "Self-tests can only be run if both roots include the string 'test'"); + if Util.findsubstring "test" (Fspath.toString (Stasher.backupDirectory())) = None then + raise (Util.Fatal + ("Self-tests can only be run if the 'backupdir' preference (or wherever the backup " + ^ "directory name is coming from, e.g. the UNISONBACKUPDIR environment variable) " + ^ "includes the string 'test'")); + + Lwt_unix.run (Globals.allRootsIter (fun r -> makeRootEmpty r ())); + + let (r2,r1) = Globals.roots () in + (* Util.msg "r1 = %s r2 = %s...\n" (Common.root2string r1) (Common.root2string r2); *) + let bothRootsLocal = + match (r1,r2) with + (Common.Local,_),(Common.Local,_) -> true + | _ -> false in + + let put c fs = + Lwt_unix.run + (match c with + R1 -> putfs r1 fs | R2 -> putfs r2 fs | BACKUP1 | BACKUP2 -> assert false) in + + let failures = ref 0 in + + let check name c fs = + debug (fun() -> Util.msg "Checking %s / %s\n" (!currentTest) name); + let actual = + Lwt_unix.run + ((match c with + R1 -> getfs r1 | R2 -> getfs r2 | BACKUP1 -> getbackup r1 | BACKUP2 -> getbackup r2) ()) in + let fail () = + Util.msg + "Test %s / %s: \nExpected %s = \n %s\nbut found\n %s\n" + (!currentTest) name (checkable2string c) (fs2string fs) (fsopt2string actual); + failures := !failures+1; + raise (Util.Fatal (Printf.sprintf "Self-test %s / %s failed!" (!currentTest) name)) in + match actual with + Some(a) -> if not (equal a fs) then fail() + | None -> fail() in + + let checkmissing name c = + debug (fun() -> Util.msg "Checking nonexistence %s / %s\n" (!currentTest) name); + let actual = + Lwt_unix.run + ((match c with + R1 -> getfs r1 | R2 -> getfs r2 | BACKUP1 -> getbackup r1 | BACKUP2 -> getbackup r2) ()) in + if actual <> None then begin + Util.msg + "Test %s / %s: \nExpected %s MISSING\nbut found\n %s\n" + (!currentTest) name (checkable2string c) (fsopt2string actual); + failures := !failures+1; + raise (Util.Fatal (Printf.sprintf "Self-test %s / %s failed!" (!currentTest) name)) + end in + + (* N.b.: When making up tests, it's important to choose file contents of different + lengths. The reason for this is that, on some Unix systems, it is possible for + the inode number of a just-deleted file to be reassigned to the very next file + created -- i.e., to the updated version of the file that the test script has + just written. If the length of the contents is also the same and the test is + running fast enough that the whole thing happens within a second, then the + update will be missed! *) + + (* Check for the bug reported by Ralf Lehmann *) + if not bothRootsLocal then + runtest "backups 1 (remote)" ["backup = Name *"] (fun() -> + put R1 (Dir []); put R2 (Dir []); sync(); + debug (fun () -> Util.msg "First check\n"); + checkmissing "1" BACKUP1; + checkmissing "2" BACKUP2; + (* Create a file *) + put R1 (Dir ["test.txt", File "1"]); sync(); + checkmissing "3" BACKUP1; + checkmissing "4" BACKUP2; + (* Change it and check that the old version got backed up on the target host *) + put R1 (Dir ["test.txt", File "2"]); sync(); + checkmissing "5" BACKUP1; + check "6" BACKUP2 (Dir [("test.txt", File "1")]); + ); + + if bothRootsLocal then + runtest "backups 1 (local)" ["backup = Name *"] (fun() -> + put R1 (Dir []); put R2 (Dir []); sync(); + (* Create a file and a directory *) + put R1 (Dir ["x", File "foo"; "d", Dir ["a", File "barr"]]); sync(); + (* Delete them *) + put R1 (Dir []); sync(); + check "1" BACKUP1 (Dir ["x", File "foo"; "d", Dir ["a", File "barr"]]); + (* Put them back and delete them once more *) + put R1 (Dir ["x", File "FOO"; "d", Dir ["a", File "BARR"]]); sync(); + put R1 (Dir []); sync(); + check "2" BACKUP1 (Dir [("x", File "FOO"); ("d", Dir [("a", File "BARR")]); + (".bak.1.x", File "foo"); (".bak.1.d", Dir [("a", File "barr")])]) + ); + + runtest "backups 2" ["backup = Name *"; "backuplocation = local"] (fun() -> + put R1 (Dir []); put R2 (Dir []); sync(); + (* Create a file and a directory *) + put R1 (Dir ["x", File "foo"; "d", Dir ["a", File "barr"]]); sync(); + (* Delete them *) + put R1 (Dir []); sync(); + (* Check that they have been backed up correctly on the other side *) + check "1" R2 (Dir [(".bak.0.x", File "foo"); (".bak.0.d", Dir [("a", File "barr")])]); + ); + + runtest "backups 2a" ["backup = Name *"; "backuplocation = local"] (fun() -> + put R1 (Dir []); put R2 (Dir []); sync(); + (* Create a file and a directory *) + put R1 (Dir ["foo", File "1"]); sync(); + check "1" R1 (Dir [("foo", File "1")]); + check "2" R1 (Dir [("foo", File "1")]); + put R1 (Dir ["foo", File "2"]); sync(); + check "3" R1 (Dir [("foo", File "2")]); + check "4" R2 (Dir [("foo", File "2"); (".bak.0.foo", File "1")]); + ); + + runtest "backups 3" ["backup = Name *"; "backuplocation = local"; "backupcurrent = Name *"] (fun() -> + put R1 (Dir []); put R2 (Dir []); sync(); + put R1 (Dir ["x", File "foo"]); sync (); + check "1a" R1 (Dir [("x", File "foo"); (".bak.0.x", File "foo")]); + check "1b" R2 (Dir [("x", File "foo"); (".bak.0.x", File "foo")]); + put R2 (Dir ["x", File "barr"; (".bak.0.x", File "foo")]); sync (); + check "2a" R1 (Dir [("x", File "barr"); (".bak.1.x", File "foo"); (".bak.0.x", File "barr")]); + check "2b" R2 (Dir [("x", File "barr"); (".bak.1.x", File "foo"); (".bak.0.x", File "barr")]); + ); + + runtest "backups 4" ["backup = Name *"; "backupcurrent = Name *"; "maxbackups = 7"] (fun() -> + put R1 (Dir []); put R2 (Dir []); sync(); + put R1 (Dir ["x", File "foo"]); sync(); + check "1a" BACKUP1 (Dir [("x", File "foo")]); + put R1 (Dir ["x", File "barr"]); sync(); + check "1b" BACKUP1 (Dir [("x", File "barr"); (".bak.1.x", File "foo")]); + put R2 (Dir ["x", File "bazzz"]); sync(); + check "1c" BACKUP1 (Dir [("x", File "bazzz"); (".bak.2.x", File "foo"); (".bak.1.x", File "barr")]); + ); + + runtest "backups 5 (directories)" ["backup = Name *"; "backupcurrent = Name *"; "maxbackups = 7"] (fun() -> + put R1 (Dir []); put R2 (Dir []); sync(); + (* Create a directory x containing files a and l; check that the current version gets backed up *) + put R1 (Dir ["x", Dir ["a", File "foo"; "l", File "./foo"]]); sync(); + check "1" BACKUP1 (Dir [("x", Dir [("l", File "./foo"); ("a", File "foo")])]); + (* On replica 2, delete file a, create file b, and edit file l *) + put R2 (Dir ["x", Dir ["b", File "barr"; "l", File "./barr"]]); sync(); + check "2" BACKUP1 (Dir [("x", Dir [("l", File "./barr"); ("b", File "barr"); ("a", File "foo"); (".bak.1.l", File "./foo")])]); + (* On replica 1, replace the whole directory by a file; when we check the result, we need to know + whether we're running the test locally or remotely; in the former case, we should see *both* the + old and the new version as backups *) + put R1 (Dir ["x", File "bazzz"]); sync(); + if bothRootsLocal then + check "3" BACKUP1 (Dir [("x", File "bazzz"); (".bak.2.x", Dir [("l", File "./barr"); ("b", File "barr"); ("a", File "foo"); (".bak.1.l", File "./foo")]); (".bak.1.x", Dir [("l", File "./barr"); ("b", File "barr")])]) + else + check "3" BACKUP1 (Dir [("x", File "bazzz"); (".bak.1.x", Dir [("l", File "./barr"); ("b", File "barr"); ("a", File "foo"); (".bak.1.l", File "./foo")])]); + ); + + runtest "backups 6 (backup prefix/suffix)" ["backup = Name *"; + "backuplocation = local"; + "backupprefix = back/$VERSION-"; + "backupsuffix = .backup"; + "backupcurrent = Name *"] (fun() -> + put R1 (Dir []); put R2 (Dir []); sync(); + put R1 (Dir ["x", File "foo"]); sync(); + check "1" R1 (Dir [("x", File "foo"); ("back", Dir [("0-x.backup", File "foo")])]); + ); + + if not (Prefs.read Globals.someHostIsRunningWindows) then begin + runtest "links 1 (directories and links)" ["backup = Name *"; "backupcurrent = Name *"; "maxbackups = 7"] (fun() -> + put R1 (Dir []); put R2 (Dir []); sync(); + put R1 (Dir ["x", Dir ["a", File "foo"; "l", Link "./foo"]]); sync(); + check "1" BACKUP1 (Dir [("x", Dir [("l", Link "./foo"); ("a", File "foo")])]); + put R2 (Dir ["x", Dir ["b", File "barr"; "l", Link "./barr"]]); sync(); + check "2" BACKUP1 (Dir [("x", Dir [("l", Link "./barr"); ("b", File "barr"); ("a", File "foo"); (".bak.1.l", Link "./foo")])]); + put R1 (Dir ["x", File "bazzz"]); sync(); + if bothRootsLocal then + check "3" BACKUP1 + (Dir [("x", File "bazzz"); + (".bak.2.x", Dir [("l", Link "./barr"); ("b", File "barr"); ("a", File "foo"); + (".bak.1.l", Link "./foo")]); + (".bak.1.x", Dir [("l", Link "./barr"); ("b", File "barr")])]) + else + check "3" BACKUP1 + (Dir [("x", File "bazzz"); + (".bak.1.x", Dir [("l", Link "./barr"); ("b", File "barr"); + ("a", File "foo"); (".bak.1.l", Link "./foo")])]); + ); + + (* Test that we correctly fail when we try to 'follow' a symlink that does not + point to anything *) + runtest "links 2 (symlink to nowhere)" ["follow = Name y"] (fun() -> + let orig = (Dir []) in + put R1 orig; put R2 orig; sync(); + put R1 (Dir ["y", Link "x"]); sync(); + check "1" R2 orig; + ); + end; + + if !failures = 0 then + Util.msg "Success :-)\n" + else + raise (Util.Fatal "Self-tests failed\n") + +(* Initialization: tie the knot between this module and Uicommon *) +let _ = (Uicommon.testFunction := test) Deleted: branches/2.32/src/test.mli =================================================================== --- trunk/src/test.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/test.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,6 +0,0 @@ -(* Unison file synchronizer: src/test.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* Internal self-tests *) - -val test: unit -> unit Copied: branches/2.32/src/test.mli (from rev 320, trunk/src/test.mli) =================================================================== --- branches/2.32/src/test.mli (rev 0) +++ branches/2.32/src/test.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,6 @@ +(* Unison file synchronizer: src/test.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +(* Internal self-tests *) + +val test: unit -> unit Deleted: branches/2.32/src/transfer.ml =================================================================== --- trunk/src/transfer.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/transfer.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,685 +0,0 @@ -(* Unison file synchronizer: src/transfer.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* rsync compression algorithm - - To compress, we use a compression buffer with a size a lot - greater than the size of a block, typically half a megabyte. This - buffer is loaded with the file contents. Its valid part is - represented by its limit 'length'. - We scan the file contents by sliding a window with the size of a - block over the compression buffer. This window is represented by - its 'offset' and its size 'blockSize'. - We transmit STRING tokens, containing the differences between the - files, and BLOCK tokens, containing the number of a block from the - old file found in the new one. The data not transmitted yet are - pointed by 'toBeSent'. - For each position of the window, we compute the checksum of the - block it contains and try to find a matching entry in the hashed - block information data. If there is a match, we compute the - fingerprint of our block to match it with the candidates' - fingerprints : - - if there is a match, we've just hit, we can transmit the data not - sent yet as a STRING token and emit a BLOCK token representing our - match, then we slide the window one block ahead and try again; - - in any other case, we've missed, we just slide the window one - character ahead and try again. - If the file size is greater than the compression buffer size, - then we have to update the compression buffer when the window - reaches its limit. We do so by sending any data not sent yet, then - copying the end of the buffer at its beginning and filling it up - with the file contents coming next. We now place our window at the - beginning of the buffer and we continue the process. - The compression is over when we reach the end of the file. We - just have to send the data not sent yet together with the last - characters that could not fill a block. *) - -let debug = Trace.debug "transfer" -let debugV = Trace.debug "transfer+" -let debugToken = Trace.debug "rsynctoken" -let debugLog = Trace.debug "rsynclog" - -open Lwt - -type transfer_instruction = string * int * int - -type transmitter = transfer_instruction -> unit Lwt.t - -(*************************************************************************) -(* BUFFERED DISK I/O *) -(*************************************************************************) - -let reallyRead infd buffer pos length = - let rec read pos length = - let n = input infd buffer pos length in - if n = length || n = 0 then pos + n else - read (pos + n) (length - n) - in - read pos length - pos - -let rec reallyWrite outfd buffer pos length = - output outfd buffer pos length - -(*************************************************************************) -(* TOKEN QUEUE *) -(*************************************************************************) - -(* There are two goals: - 1) to merge consecutive compatible tokens (catenating STRING tokens - and combining BLOCK tokens when the referenced blocks are - consecutive) - 2) to delay the transmission of the tokens across the network until - their total size is greater than a limit, not to make a costly - RPC for each token (therefore, the rsync module uses memory up to - (2 * comprBufSize + tokenQueueLimit) bytes at a time) *) - -type token = - | STRING of string * int * int - | BLOCK of int - | EOF - -(* Size of a block *) -let blockSize = 700 -let blockSize64 = Int64.of_int blockSize - -let maxQueueSize = 65500 -let maxQueueSizeFS = Uutil.Filesize.ofInt maxQueueSize -type tokenQueue = - { mutable data : string; (* the queued tokens *) - mutable previous : [`Str of int | `Block of int | `None]; - (* some informations about the - previous token *) - mutable pos : int; (* head of the queue *) - mutable prog : int } (* the size of the data they represent *) - -(* Size of the data a token represents for the destination host, - to keep track of the propagation progress *) -let tokenProg t = - match t with - STRING (s, pos, len) -> String.length s - | BLOCK n -> blockSize - | EOF -> 0 - -let encodeInt3 s pos i = - assert (i >= 0 && i < 256 * 256 * 256); - s.[pos + 0] <- Char.chr ((i lsr 0) land 0xff); - s.[pos + 1] <- Char.chr ((i lsr 8) land 0xff); - s.[pos + 2] <- Char.chr ((i lsr 16) land 0xff) - -let decodeInt3 s pos = - (Char.code s.[pos + 0] lsl 0) lor - (Char.code s.[pos + 1] lsl 8) lor - (Char.code s.[pos + 2] lsl 16) - -let encodeInt2 s pos i = - assert (i >= 0 && i < 65536); - s.[pos + 0] <- Char.chr ((i lsr 0) land 0xff); - s.[pos + 1] <- Char.chr ((i lsr 8) land 0xff) - -let decodeInt2 s pos = - (Char.code s.[pos + 0] lsl 0) lor (Char.code s.[pos + 1] lsl 8) - -let encodeInt1 s pos i = - assert (i >= 0 && i < 256); - s.[pos + 0] <- Char.chr i - -let decodeInt1 s pos = - Char.code s.[pos + 0] - -(* Transmit the contents of the tokenQueue *) -let flushQueue q showProgress transmit cond = - if cond && q.pos > 0 then begin - debugToken (fun() -> Util.msg "flushing the token queue\n"); - transmit (q.data, 0, q.pos) >>= (fun () -> - showProgress q.prog; - q.pos <- 0; q.prog <- 0; q.previous <- `None; - return ()) - end else - return () - -let pushEOF q showProgress transmit = - flushQueue q showProgress transmit - (q.pos + 1 > String.length q.data) >>= (fun () -> - q.data.[q.pos] <- 'E'; - q.pos <- q.pos + 1; - q.previous <- `None; - return ()) - -let pushString q id transmit s pos len = - flushQueue q id transmit (q.pos + len + 3 > String.length q.data) - >>= (fun () -> - if q.pos + 3 + len > String.length q.data then begin - (* The file is longer than expected, so the string does not fit in - the buffer *) - assert (q.pos = 0); - q.data <- String.create maxQueueSize - end; - q.data.[q.pos] <- 'S'; - encodeInt2 q.data (q.pos + 1) len; - assert (q.pos + 3 + len <= String.length q.data); - String.blit s pos q.data (q.pos + 3) len; - q.pos <- q.pos + len + 3; - q.prog <- q.prog + len; - q.previous <- `Str len; - return ()) - -let rec growString q id transmit len' s pos len = - let l = min (String.length q.data - q.pos) len in - String.blit s pos q.data q.pos l; - assert (q.data.[q.pos - len' - 3] = 'S'); - assert (decodeInt2 q.data (q.pos - len' - 2) = len'); - let len'' = len' + l in - encodeInt2 q.data (q.pos - len' - 2) len''; - q.pos <- q.pos + l; - q.prog <- q.prog + l; - q.previous <- `Str len''; - if l < len then - pushString q id transmit s (pos + l) (len - l) - else - return () - -let pushBlock q id transmit pos = - flushQueue q id transmit (q.pos + 5 > String.length q.data) >>= (fun () -> - q.data.[q.pos] <- 'B'; - encodeInt3 q.data (q.pos + 1) pos; - encodeInt1 q.data (q.pos + 4) 1; - q.pos <- q.pos + 5; - q.prog <- q.prog + blockSize; - q.previous <- `Block (pos + 1); - return ()) - -let growBlock q id transmit pos = - let count = decodeInt1 q.data (q.pos - 1) in - assert (q.data.[q.pos - 5] = 'B'); - assert (decodeInt3 q.data (q.pos - 4) + count = pos); - assert (count < 255); - encodeInt1 q.data (q.pos - 1) (count + 1); - q.prog <- q.prog + blockSize; - q.previous <- if count = 254 then `None else `Block (pos + 1); - return () - -(* Queue a new token, possibly merging it with a previous compatible - token and flushing the queue if its size becomes greater than the - limit *) -let queueToken q id transmit token = - match token, q.previous with - EOF, _ -> - pushEOF q id transmit - | STRING (s, pos, len), `Str len' -> - growString q id transmit len' s pos len - | STRING (s, pos, len), _ -> - pushString q id transmit s pos len - | BLOCK pos, `Block pos' when pos = pos' -> - growBlock q id transmit pos - | BLOCK pos, _ -> - pushBlock q id transmit pos - -let makeQueue length = - { data = - (* We need to make sure here that the size of the queue is not - larger than 65538 - (1 byte: header, 2 bytes: string size, 65535 bytes: string) *) - String.create - (if length > maxQueueSizeFS then maxQueueSize else - Uutil.Filesize.toInt length + 10); - pos = 0; previous = `None; prog = 0 } - -(*************************************************************************) -(* GENERIC TRANSMISSION *) -(*************************************************************************) - -let debug = Trace.debug "generic" - -(* Slice the file into STRING tokens that are transmitted incrementally *) -let send infd length showProgress transmit = - debug (fun() -> Util.msg "sending file\n"); - let timer = Trace.startTimer "Sending file using generic transmission" in - let bufSz = 8192 in - let bufSzFS = Uutil.Filesize.ofInt 8192 in - let buf = String.create bufSz in - let q = makeQueue length in - let rec sendSlice length = - let count = - reallyRead infd buf 0 - (if length > bufSzFS then bufSz else Uutil.Filesize.toInt length) in - queueToken q showProgress transmit (STRING (buf, 0, count)) >>= (fun () -> - let length = Uutil.Filesize.sub length (Uutil.Filesize.ofInt count) in - if count = bufSz && length > Uutil.Filesize.zero then - sendSlice length - else - return ()) - in - sendSlice length >>= (fun () -> - queueToken q showProgress transmit EOF >>= (fun () -> - flushQueue q showProgress transmit true >>= (fun () -> - Trace.showTimer timer; - return ()))) - -let rec receiveRec outfd showProgress data pos maxPos = - if pos = maxPos then false else - match data.[pos] with - 'S' -> - let length = decodeInt2 data (pos + 1) in - if Trace.enabled "generic" then debug (fun() -> Util.msg - "receiving %d bytes\n" length); - reallyWrite outfd data (pos + 3) length; - showProgress length; - receiveRec outfd showProgress data (pos + length + 3) maxPos - | 'E' -> - true - | _ -> - assert false - -let receive outfd showProgress (data, pos, len) = - receiveRec outfd showProgress data pos (pos + len) - -(*************************************************************************) -(* RSYNC TRANSMISSION *) -(*************************************************************************) - -module Rsync = -struct - - (* Debug messages *) - let debug = Trace.debug "rsync" - - -(**************************** DESTINATION HOST ***************************) - - (* It is impossible to use rsync when the file size is smaller than - the size of a block *) - let blockSizeFs = Uutil.Filesize.ofInt blockSize - let aboveRsyncThreshold sz = sz >= blockSizeFs - - (* The type of the info that will be sent to the source host *) - type rsync_block_info = (Checksum.t * Digest.t) list - - - (*** PREPROCESS ***) - - (* Preprocess buffer size *) - let preproBufSize = 8192 - - (* Incrementally build arg by executing f on successive blocks (of size - 'blockSize') of the input stream (pointed by 'infd'). - The procedure uses a buffer of size 'bufferSize' to load the input, - and eventually handles the buffer update. *) - let blockIter infd f arg maxCount = - let bufferSize = 8192 + blockSize in - let buffer = String.create bufferSize in - let rec iter count arg offset length = - if count = maxCount then arg else begin - let newOffset = offset + blockSize in - if newOffset <= length then - iter (count + 1) (f buffer offset arg) newOffset length - else if offset > 0 then begin - let chunkSize = length - offset in - String.blit buffer offset buffer 0 chunkSize; - iter count arg 0 chunkSize - end else begin - let l = input infd buffer length (bufferSize - length) in - if l = 0 then - arg - else - iter count arg 0 (length + l) - end - end - in - iter 0 arg 0 0 - - let rec rev_split_rec accu1 accu2 n l = - if n = 100000 then - rev_split_rec (accu2 :: accu1) [] 0 l - else - match l with - [] -> accu2 :: accu1 - | x :: r -> rev_split_rec accu1 (x :: accu2) (n + 1) r - - let rev_split l = rev_split_rec [] [] 0 l - - (* Given a block size, get blocks from the old file and compute a - checksum and a fingerprint for each one. *) - let rsyncPreprocess infd = - debug (fun() -> Util.msg "preprocessing\n"); - debugLog (fun() -> Util.msg "block size = %d bytes\n" blockSize); - let timer = Trace.startTimer "Preprocessing old file" in - let addBlock buf offset rev_bi = - let cs = Checksum.substring buf offset blockSize in - let fp = Digest.substring buf offset blockSize in - (cs, fp) :: rev_bi - in - (* Make sure we are at the beginning of the file - (important for AppleDouble files *) - LargeFile.seek_in infd 0L; - (* Limit the number of block so that there is no overflow in - encodeInt3 *) - let rev_bi = blockIter infd addBlock [] (256*256*256) in - let bi = rev_split rev_bi in - debugLog (fun() -> Util.msg "%d blocks\n" (Safelist.length bi)); - Trace.showTimer timer; - bi - - - (*** DECOMPRESSION ***) - - (* Decompression buffer size *) - let decomprBufSize = 8192 - - (* For each transfer instruction, either output a string or copy one or - several blocks from the old file. *) - let rsyncDecompress infd outfd showProgress (data, pos, len) = - let decomprBuf = String.create decomprBufSize in - let progress = ref 0 in - let rec copy length = - if length > decomprBufSize then begin - let _ = reallyRead infd decomprBuf 0 decomprBufSize in - reallyWrite outfd decomprBuf 0 decomprBufSize; - copy (length - decomprBufSize) - end else - let _ = reallyRead infd decomprBuf 0 length in - reallyWrite outfd decomprBuf 0 length - in - let copyBlocks n k = - LargeFile.seek_in infd (Int64.mul n blockSize64); - let length = k * blockSize in - copy length; - progress := !progress + length - in - let maxPos = pos + len in - let rec decode pos = - if pos = maxPos then false else - match data.[pos] with - 'S' -> - let length = decodeInt2 data (pos + 1) in - if Trace.enabled "rsynctoken" then - debugToken (fun() -> - Util.msg "decompressing string (%d bytes)\n" length); - reallyWrite outfd data (pos + 3) length; - progress := !progress + length; - decode (pos + length + 3) - | 'B' -> - let n = decodeInt3 data (pos + 1) in - let k = decodeInt1 data (pos + 4) in - if Trace.enabled "rsynctoken" then - debugToken (fun() -> Util.msg - "decompressing %d block(s) (sequence %d->%d)\n" - k n (n + k - 1)); - copyBlocks (Int64.of_int n) k; - decode (pos + 5) - | 'E' -> - true - | _ -> - assert false - in - let finished = decode pos in - showProgress !progress; - finished - -(***************************** SOURCE HOST *******************************) - - (*** CUSTOM HASH TABLE ***) - - (* Maximum number of entries in the hash table. - MUST be a power of 2 ! - Typical values are around an average 2 * fileSize / blockSize. *) - let hashTableMaxLength = 64 * 1024 - - let hash checksum = checksum - - let rec sigLength sigs = - match sigs with - [] -> 0 - | x :: r -> Safelist.length x + sigLength r - - (* Compute the hash table length as a function of the number of blocks *) - let hashTableLength signatures = - let rec upperPowerOfTwo n n2 = - if (n2 >= n) || (n2 = hashTableMaxLength) then - n2 - else - upperPowerOfTwo n (2 * n2) - in - 2 * (upperPowerOfTwo (sigLength signatures) 32) - - (* Hash the block signatures into the hash table *) - let hashSig hashTableLength signatures = - let hashTable = Array.make hashTableLength [] in - let rec addList k l l' = - match l, l' with - [], [] -> - () - | [], r :: r' -> - addList k r r' - | ((cs, fp) :: r), _ -> - let h = (hash cs) land (hashTableLength - 1) in - hashTable.(h) <- (k, cs, fp)::(hashTable.(h)); - addList (k + 1) r l' - in - addList 0 [] signatures; - hashTable - - (* Given a key, retrieve the corresponding entry in the table *) - let findEntry hashTable hashTableLength checksum : - (int * Checksum.t * Digest.t) list = - hashTable.((hash checksum) land (hashTableLength - 1)) - - (* Log the values of the parameters associated with the hash table *) - let logHash hashTable hashTableLength = - let rec probe empty collision i = - if i = hashTableLength then (empty, collision) - else begin - let length = Safelist.length hashTable.(i) in - let next = - if length = 0 then probe (empty + 1) collision - else if length > 1 then probe empty (collision + 1) - else probe empty collision - in - next (i + 1) - end - in - let (empty, collision) = probe 0 0 0 in - debugLog (fun() -> Util.msg "%d hash table entries\n" hashTableLength); - debugLog (fun() -> Util.msg - "%d empty, %d used, %d collided\n" - empty (hashTableLength - empty) collision) - - (*** MEASURES ***) - - type probes = { - mutable hitHit : int; - mutable hitMiss : int; - mutable nbBlock : int; - mutable nbString : int; - mutable stringSize : int - } - - let logMeasures pb = -((* - debugLog (fun() -> Util.msg - "hit-hit = %d, hit-miss = %d, hit rate = %d%%\n" - pb.hitHit pb.hitMiss - (if pb.hitHit <> 0 then - pb.hitHit * 100 / (pb.hitHit + pb.hitMiss) - else 0)); - debugLog (fun() -> Util.msg - "%d strings (%d bytes), %d blocks\n" - pb.nbString pb.stringSize pb.nbBlock); - let generic = pb.stringSize + pb.nbBlock * blockSize in - debugLog (fun() -> Util.msg - "file size = %d bytes\n" - generic); - debug (fun() -> Util.msg - "compression rate = %d%%\n" ((pb.stringSize * 100) / generic)) -*)) - - - (*** COMPRESSION ***) - - (* Compression buffer size *) - (* MUST be >= 2 * blockSize *) - let comprBufSize = 8192 - let comprBufSizeFS = Uutil.Filesize.ofInt 8192 - - (* Compress the file using the algorithm described in the header *) - let rsyncCompress sigs infd srcLength showProgress transmit = - debug (fun() -> Util.msg "compressing\n"); - debugLog (fun() -> Util.msg - "compression buffer size = %d bytes\n" comprBufSize); - debugLog (fun() -> Util.msg "block size = %d bytes\n" blockSize); - assert (comprBufSize >= 2 * blockSize); - let timer = Trace.startTimer "Compressing the new file" in - - (* Measures *) - let pb = - { hitHit = 0; hitMiss = 0; nbBlock = 0; nbString = 0; stringSize = 0 } in -(* - let transmit tokenList = - Safelist.iter - (fun token -> - match token with - | STRING s -> - let length = String.length s in - if Trace.enabled "rsynctoken" then debugToken (fun() -> - Util.msg "transmitting string (%d bytes)\n" length); - pb.nbString <- pb.nbString + 1; - pb.stringSize <- pb.stringSize + length - | BLOCK n -> - if Trace.enabled "rsynctoken" then debugToken (fun() -> Util.msg - "transmitting %d block(s) (sequence %d->%d)\n" - 1 n (n)); - pb.nbBlock <- pb.nbBlock + k) - tokenList; - transmit tokenList - in -*) - - (* Enable token buffering *) - let tokenQueue = makeQueue srcLength in - let flushTokenQueue () = - flushQueue tokenQueue showProgress transmit true in - let transmit token = queueToken tokenQueue showProgress transmit token in - - (* Set up the hash table for fast checksum look-up *) - let hashTableLength = ref (hashTableLength sigs) in - let blockTable = hashSig !hashTableLength sigs in - logHash blockTable !hashTableLength; - - (* Create the compression buffer *) - let comprBuf = String.create comprBufSize in - - (* If there is data waiting to be sent, transmit it as a STRING token *) - let transmitString toBeSent offset = - if offset > toBeSent then - transmit (STRING (comprBuf, toBeSent, offset - toBeSent)) - else - return () - in - - (* Set up the rolling checksum data *) - let checksum = ref 0 in - let cksumOutgoing = ref ' ' in - let cksumTable = ref (Checksum.init blockSize) in - - let absolutePos = ref Uutil.Filesize.zero in - - (* Check the new window position and update the compression buffer - if its end has been reached *) - let rec slideWindow newOffset toBeSent length miss : unit Lwt.t = - if newOffset + blockSize <= length then - computeChecksum newOffset toBeSent length miss - else if length = comprBufSize then begin - transmitString toBeSent newOffset >>= (fun () -> - let chunkSize = length - newOffset in - if chunkSize > 0 then begin - assert(comprBufSize >= blockSize); - String.blit comprBuf newOffset comprBuf 0 chunkSize - end; - let rem = Uutil.Filesize.sub srcLength !absolutePos in - let avail = comprBufSize - chunkSize in - let l = - reallyRead infd comprBuf chunkSize - (if rem > comprBufSizeFS then avail else - min (Uutil.Filesize.toInt rem) avail) - in - absolutePos := - Uutil.Filesize.add !absolutePos (Uutil.Filesize.ofInt l); - let length = chunkSize + l in - debugToken (fun() -> Util.msg "updating the compression buffer\n"); - debugToken (fun() -> Util.msg "new length = %d bytes\n" length); - slideWindow 0 0 length miss) - end else - transmitString toBeSent length >>= (fun () -> - transmit EOF) - - (* Compute the window contents checksum, in a rolling fashion if there - was a miss *) - and computeChecksum newOffset toBeSent length miss = - let cksum = - if miss then - Checksum.roll !cksumTable !checksum !cksumOutgoing - (String.unsafe_get comprBuf (newOffset + blockSize - 1)) - else - Checksum.substring comprBuf newOffset blockSize - in - checksum := cksum; - cksumOutgoing := String.unsafe_get comprBuf newOffset; - processBlock newOffset toBeSent length cksum - - (* Try to match the current block with one existing in the old file *) - and processBlock offset toBeSent length checksum = - if Trace.enabled "transfer+" then - debugV (fun() -> Util.msg - "processBlock offset=%d toBeSent=%d length=%d blockSize = %d\n" - offset toBeSent length blockSize); - if Trace.enabled "rsynctoken" then assert - (0 <= toBeSent && toBeSent <= offset && offset + blockSize <= length); - match findEntry blockTable !hashTableLength checksum with - | [] -> miss offset toBeSent length - | entry -> - let blockNum = findBlock offset checksum entry None in - if blockNum = -1 then begin - pb.hitMiss <- pb.hitMiss + 1; - miss offset toBeSent length - end else begin - pb.hitHit <- pb.hitHit + 1; - hit offset toBeSent length blockNum - end - - (* In the hash table entry, find nodes with the right checksum and - match fingerprints *) - and findBlock offset checksum entry fingerprint = - match entry, fingerprint with - | [], _ -> - -1 - | (k, cs, fp) :: tl, None - when cs = checksum -> - let fingerprint = Digest.substring comprBuf offset blockSize in - findBlock offset checksum entry (Some fingerprint) - | (k, cs, fp) :: tl, Some fingerprint - when (cs = checksum) && (fp = fingerprint) -> - k - | _ :: tl, _ -> - findBlock offset checksum tl fingerprint - - (* Miss : slide the window one character ahead *) - and miss offset toBeSent length = - slideWindow (offset + 1) toBeSent length true - - (* Hit : send the data waiting and a BLOCK token, then slide the window - one block ahead *) - and hit offset toBeSent length blockNum = - transmitString toBeSent offset >>= (fun () -> - let sent = offset in - let toBeSent = sent + blockSize in - transmit (BLOCK blockNum) >>= (fun () -> - slideWindow (offset + blockSize) toBeSent length false)) - in - - (* Initialization and termination *) - slideWindow comprBufSize comprBufSize comprBufSize false >>= (fun () -> - flushTokenQueue () >>= (fun () -> - logMeasures pb; - Trace.showTimer timer; - return ())) - -end Copied: branches/2.32/src/transfer.ml (from rev 320, trunk/src/transfer.ml) =================================================================== --- branches/2.32/src/transfer.ml (rev 0) +++ branches/2.32/src/transfer.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,700 @@ +(* Unison file synchronizer: src/transfer.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +(* rsync compression algorithm + + To compress, we use a compression buffer with a size a lot + greater than the size of a block, typically half a megabyte. This + buffer is loaded with the file contents. Its valid part is + represented by its limit 'length'. + We scan the file contents by sliding a window with the size of a + block over the compression buffer. This window is represented by + its 'offset' and its size 'blockSize'. + We transmit STRING tokens, containing the differences between the + files, and BLOCK tokens, containing the number of a block from the + old file found in the new one. The data not transmitted yet are + pointed by 'toBeSent'. + For each position of the window, we compute the checksum of the + block it contains and try to find a matching entry in the hashed + block information data. If there is a match, we compute the + fingerprint of our block to match it with the candidates' + fingerprints : + - if there is a match, we've just hit, we can transmit the data not + sent yet as a STRING token and emit a BLOCK token representing our + match, then we slide the window one block ahead and try again; + - in any other case, we've missed, we just slide the window one + character ahead and try again. + If the file size is greater than the compression buffer size, + then we have to update the compression buffer when the window + reaches its limit. We do so by sending any data not sent yet, then + copying the end of the buffer at its beginning and filling it up + with the file contents coming next. We now place our window at the + beginning of the buffer and we continue the process. + The compression is over when we reach the end of the file. We + just have to send the data not sent yet together with the last + characters that could not fill a block. *) + +let debug = Trace.debug "transfer" +let debugV = Trace.debug "transfer+" +let debugToken = Trace.debug "rsynctoken" +let debugLog = Trace.debug "rsynclog" + +open Lwt + +type transfer_instruction = string * int * int + +type transmitter = transfer_instruction -> unit Lwt.t + +(*************************************************************************) +(* BUFFERED DISK I/O *) +(*************************************************************************) + +let reallyRead infd buffer pos length = + let rec read pos length = + let n = input infd buffer pos length in + if n = length || n = 0 then pos + n else + read (pos + n) (length - n) + in + read pos length - pos + +let rec reallyWrite outfd buffer pos length = + output outfd buffer pos length + +(*************************************************************************) +(* TOKEN QUEUE *) +(*************************************************************************) + +(* There are two goals: + 1) to merge consecutive compatible tokens (catenating STRING tokens + and combining BLOCK tokens when the referenced blocks are + consecutive) + 2) to delay the transmission of the tokens across the network until + their total size is greater than a limit, not to make a costly + RPC for each token (therefore, the rsync module uses memory up to + (2 * comprBufSize + tokenQueueLimit) bytes at a time) *) + +type token = + | STRING of string * int * int + | BLOCK of int + | EOF + +(* Size of a block *) +let blockSize = 700 +let blockSize64 = Int64.of_int blockSize + +let maxQueueSize = 65500 +let maxQueueSizeFS = Uutil.Filesize.ofInt maxQueueSize +type tokenQueue = + { mutable data : string; (* the queued tokens *) + mutable previous : [`Str of int | `Block of int | `None]; + (* some informations about the + previous token *) + mutable pos : int; (* head of the queue *) + mutable prog : int } (* the size of the data they represent *) + +(* Size of the data a token represents for the destination host, + to keep track of the propagation progress *) +let tokenProg t = + match t with + STRING (s, pos, len) -> String.length s + | BLOCK n -> blockSize + | EOF -> 0 + +let encodeInt3 s pos i = + assert (i >= 0 && i < 256 * 256 * 256); + s.[pos + 0] <- Char.chr ((i lsr 0) land 0xff); + s.[pos + 1] <- Char.chr ((i lsr 8) land 0xff); + s.[pos + 2] <- Char.chr ((i lsr 16) land 0xff) + +let decodeInt3 s pos = + (Char.code s.[pos + 0] lsl 0) lor + (Char.code s.[pos + 1] lsl 8) lor + (Char.code s.[pos + 2] lsl 16) + +let encodeInt2 s pos i = + assert (i >= 0 && i < 65536); + s.[pos + 0] <- Char.chr ((i lsr 0) land 0xff); + s.[pos + 1] <- Char.chr ((i lsr 8) land 0xff) + +let decodeInt2 s pos = + (Char.code s.[pos + 0] lsl 0) lor (Char.code s.[pos + 1] lsl 8) + +let encodeInt1 s pos i = + assert (i >= 0 && i < 256); + s.[pos + 0] <- Char.chr i + +let decodeInt1 s pos = + Char.code s.[pos + 0] + +(* Transmit the contents of the tokenQueue *) +let flushQueue q showProgress transmit cond = + if cond && q.pos > 0 then begin + debugToken (fun() -> Util.msg "flushing the token queue\n"); + transmit (q.data, 0, q.pos) >>= (fun () -> + showProgress q.prog; + q.pos <- 0; q.prog <- 0; q.previous <- `None; + return ()) + end else + return () + +let pushEOF q showProgress transmit = + flushQueue q showProgress transmit + (q.pos + 1 > String.length q.data) >>= (fun () -> + q.data.[q.pos] <- 'E'; + q.pos <- q.pos + 1; + q.previous <- `None; + return ()) + +let pushString q id transmit s pos len = + flushQueue q id transmit (q.pos + len + 3 > String.length q.data) + >>= (fun () -> + if q.pos + 3 + len > String.length q.data then begin + (* The file is longer than expected, so the string does not fit in + the buffer *) + assert (q.pos = 0); + q.data <- String.create maxQueueSize + end; + q.data.[q.pos] <- 'S'; + encodeInt2 q.data (q.pos + 1) len; + assert (q.pos + 3 + len <= String.length q.data); + String.blit s pos q.data (q.pos + 3) len; + q.pos <- q.pos + len + 3; + q.prog <- q.prog + len; + q.previous <- `Str len; + return ()) + +let rec growString q id transmit len' s pos len = + let l = min (String.length q.data - q.pos) len in + String.blit s pos q.data q.pos l; + assert (q.data.[q.pos - len' - 3] = 'S'); + assert (decodeInt2 q.data (q.pos - len' - 2) = len'); + let len'' = len' + l in + encodeInt2 q.data (q.pos - len' - 2) len''; + q.pos <- q.pos + l; + q.prog <- q.prog + l; + q.previous <- `Str len''; + if l < len then + pushString q id transmit s (pos + l) (len - l) + else + return () + +let pushBlock q id transmit pos = + flushQueue q id transmit (q.pos + 5 > String.length q.data) >>= (fun () -> + q.data.[q.pos] <- 'B'; + encodeInt3 q.data (q.pos + 1) pos; + encodeInt1 q.data (q.pos + 4) 1; + q.pos <- q.pos + 5; + q.prog <- q.prog + blockSize; + q.previous <- `Block (pos + 1); + return ()) + +let growBlock q id transmit pos = + let count = decodeInt1 q.data (q.pos - 1) in + assert (q.data.[q.pos - 5] = 'B'); + assert (decodeInt3 q.data (q.pos - 4) + count = pos); + assert (count < 255); + encodeInt1 q.data (q.pos - 1) (count + 1); + q.prog <- q.prog + blockSize; + q.previous <- if count = 254 then `None else `Block (pos + 1); + return () + +(* Queue a new token, possibly merging it with a previous compatible + token and flushing the queue if its size becomes greater than the + limit *) +let queueToken q id transmit token = + match token, q.previous with + EOF, _ -> + pushEOF q id transmit + | STRING (s, pos, len), `Str len' -> + growString q id transmit len' s pos len + | STRING (s, pos, len), _ -> + pushString q id transmit s pos len + | BLOCK pos, `Block pos' when pos = pos' -> + growBlock q id transmit pos + | BLOCK pos, _ -> + pushBlock q id transmit pos + +let makeQueue length = + { data = + (* We need to make sure here that the size of the queue is not + larger than 65538 + (1 byte: header, 2 bytes: string size, 65535 bytes: string) *) + String.create + (if length > maxQueueSizeFS then maxQueueSize else + Uutil.Filesize.toInt length + 10); + pos = 0; previous = `None; prog = 0 } + +(*************************************************************************) +(* GENERIC TRANSMISSION *) +(*************************************************************************) + +let debug = Trace.debug "generic" + +(* Slice the file into STRING tokens that are transmitted incrementally *) +let send infd length showProgress transmit = + debug (fun() -> Util.msg "sending file\n"); + let timer = Trace.startTimer "Sending file using generic transmission" in + let bufSz = 8192 in + let bufSzFS = Uutil.Filesize.ofInt 8192 in + let buf = String.create bufSz in + let q = makeQueue length in + let rec sendSlice length = + let count = + reallyRead infd buf 0 + (if length > bufSzFS then bufSz else Uutil.Filesize.toInt length) in + queueToken q showProgress transmit (STRING (buf, 0, count)) >>= (fun () -> + let length = Uutil.Filesize.sub length (Uutil.Filesize.ofInt count) in + if count = bufSz && length > Uutil.Filesize.zero then + sendSlice length + else + return ()) + in + sendSlice length >>= (fun () -> + queueToken q showProgress transmit EOF >>= (fun () -> + flushQueue q showProgress transmit true >>= (fun () -> + Trace.showTimer timer; + return ()))) + +let rec receiveRec outfd showProgress data pos maxPos = + if pos = maxPos then false else + match data.[pos] with + 'S' -> + let length = decodeInt2 data (pos + 1) in + if Trace.enabled "generic" then debug (fun() -> Util.msg + "receiving %d bytes\n" length); + reallyWrite outfd data (pos + 3) length; + showProgress length; + receiveRec outfd showProgress data (pos + length + 3) maxPos + | 'E' -> + true + | _ -> + assert false + +let receive outfd showProgress (data, pos, len) = + receiveRec outfd showProgress data pos (pos + len) + +(*************************************************************************) +(* RSYNC TRANSMISSION *) +(*************************************************************************) + +module Rsync = +struct + + (* Debug messages *) + let debug = Trace.debug "rsync" + + +(**************************** DESTINATION HOST ***************************) + + (* It is impossible to use rsync when the file size is smaller than + the size of a block *) + let blockSizeFs = Uutil.Filesize.ofInt blockSize + let aboveRsyncThreshold sz = sz >= blockSizeFs + + (* The type of the info that will be sent to the source host *) + type rsync_block_info = (Checksum.t * Digest.t) list + + + (*** PREPROCESS ***) + + (* Preprocess buffer size *) + let preproBufSize = 8192 + + (* Incrementally build arg by executing f on successive blocks (of size + 'blockSize') of the input stream (pointed by 'infd'). + The procedure uses a buffer of size 'bufferSize' to load the input, + and eventually handles the buffer update. *) + let blockIter infd f arg maxCount = + let bufferSize = 8192 + blockSize in + let buffer = String.create bufferSize in + let rec iter count arg offset length = + if count = maxCount then arg else begin + let newOffset = offset + blockSize in + if newOffset <= length then + iter (count + 1) (f buffer offset arg) newOffset length + else if offset > 0 then begin + let chunkSize = length - offset in + String.blit buffer offset buffer 0 chunkSize; + iter count arg 0 chunkSize + end else begin + let l = input infd buffer length (bufferSize - length) in + if l = 0 then + arg + else + iter count arg 0 (length + l) + end + end + in + iter 0 arg 0 0 + + let rec rev_split_rec accu1 accu2 n l = + if n = 100000 then + rev_split_rec (accu2 :: accu1) [] 0 l + else + match l with + [] -> accu2 :: accu1 + | x :: r -> rev_split_rec accu1 (x :: accu2) (n + 1) r + + let rev_split l = rev_split_rec [] [] 0 l + + (* Given a block size, get blocks from the old file and compute a + checksum and a fingerprint for each one. *) + let rsyncPreprocess infd = + debug (fun() -> Util.msg "preprocessing\n"); + debugLog (fun() -> Util.msg "block size = %d bytes\n" blockSize); + let timer = Trace.startTimer "Preprocessing old file" in + let addBlock buf offset rev_bi = + let cs = Checksum.substring buf offset blockSize in + let fp = Digest.substring buf offset blockSize in + (cs, fp) :: rev_bi + in + (* Make sure we are at the beginning of the file + (important for AppleDouble files *) + LargeFile.seek_in infd 0L; + (* Limit the number of block so that there is no overflow in + encodeInt3 *) + let rev_bi = blockIter infd addBlock [] (256*256*256) in + let bi = rev_split rev_bi in + debugLog (fun() -> Util.msg "%d blocks\n" (Safelist.length bi)); + Trace.showTimer timer; + bi + + + (*** DECOMPRESSION ***) + + (* Decompression buffer size *) + let decomprBufSize = 8192 + + (* For each transfer instruction, either output a string or copy one or + several blocks from the old file. *) + let rsyncDecompress infd outfd showProgress (data, pos, len) = + let decomprBuf = String.create decomprBufSize in + let progress = ref 0 in + let rec copy length = + if length > decomprBufSize then begin + let _ = reallyRead infd decomprBuf 0 decomprBufSize in + reallyWrite outfd decomprBuf 0 decomprBufSize; + copy (length - decomprBufSize) + end else + let _ = reallyRead infd decomprBuf 0 length in + reallyWrite outfd decomprBuf 0 length + in + let copyBlocks n k = + LargeFile.seek_in infd (Int64.mul n blockSize64); + let length = k * blockSize in + copy length; + progress := !progress + length + in + let maxPos = pos + len in + let rec decode pos = + if pos = maxPos then false else + match data.[pos] with + 'S' -> + let length = decodeInt2 data (pos + 1) in + if Trace.enabled "rsynctoken" then + debugToken (fun() -> + Util.msg "decompressing string (%d bytes)\n" length); + reallyWrite outfd data (pos + 3) length; + progress := !progress + length; + decode (pos + length + 3) + | 'B' -> + let n = decodeInt3 data (pos + 1) in + let k = decodeInt1 data (pos + 4) in + if Trace.enabled "rsynctoken" then + debugToken (fun() -> Util.msg + "decompressing %d block(s) (sequence %d->%d)\n" + k n (n + k - 1)); + copyBlocks (Int64.of_int n) k; + decode (pos + 5) + | 'E' -> + true + | _ -> + assert false + in + let finished = decode pos in + showProgress !progress; + finished + +(***************************** SOURCE HOST *******************************) + + (*** CUSTOM HASH TABLE ***) + + (* Maximum number of entries in the hash table. + MUST be a power of 2 ! + Typical values are around an average 2 * fileSize / blockSize. *) + let hashTableMaxLength = 64 * 1024 + + let hash checksum = checksum + + let rec sigLength sigs = + match sigs with + [] -> 0 + | x :: r -> Safelist.length x + sigLength r + + (* Compute the hash table length as a function of the number of blocks *) + let hashTableLength signatures = + let rec upperPowerOfTwo n n2 = + if (n2 >= n) || (n2 = hashTableMaxLength) then + n2 + else + upperPowerOfTwo n (2 * n2) + in + 2 * (upperPowerOfTwo (sigLength signatures) 32) + + (* Hash the block signatures into the hash table *) + let hashSig hashTableLength signatures = + let hashTable = Array.make hashTableLength [] in + let rec addList k l l' = + match l, l' with + [], [] -> + () + | [], r :: r' -> + addList k r r' + | ((cs, fp) :: r), _ -> + let h = (hash cs) land (hashTableLength - 1) in + hashTable.(h) <- (k, cs, fp)::(hashTable.(h)); + addList (k + 1) r l' + in + addList 0 [] signatures; + hashTable + + (* Given a key, retrieve the corresponding entry in the table *) + let findEntry hashTable hashTableLength checksum : + (int * Checksum.t * Digest.t) list = + hashTable.((hash checksum) land (hashTableLength - 1)) + + (* Log the values of the parameters associated with the hash table *) + let logHash hashTable hashTableLength = + let rec probe empty collision i = + if i = hashTableLength then (empty, collision) + else begin + let length = Safelist.length hashTable.(i) in + let next = + if length = 0 then probe (empty + 1) collision + else if length > 1 then probe empty (collision + 1) + else probe empty collision + in + next (i + 1) + end + in + let (empty, collision) = probe 0 0 0 in + debugLog (fun() -> Util.msg "%d hash table entries\n" hashTableLength); + debugLog (fun() -> Util.msg + "%d empty, %d used, %d collided\n" + empty (hashTableLength - empty) collision) + + (*** MEASURES ***) + + type probes = { + mutable hitHit : int; + mutable hitMiss : int; + mutable nbBlock : int; + mutable nbString : int; + mutable stringSize : int + } + + let logMeasures pb = +((* + debugLog (fun() -> Util.msg + "hit-hit = %d, hit-miss = %d, hit rate = %d%%\n" + pb.hitHit pb.hitMiss + (if pb.hitHit <> 0 then + pb.hitHit * 100 / (pb.hitHit + pb.hitMiss) + else 0)); + debugLog (fun() -> Util.msg + "%d strings (%d bytes), %d blocks\n" + pb.nbString pb.stringSize pb.nbBlock); + let generic = pb.stringSize + pb.nbBlock * blockSize in + debugLog (fun() -> Util.msg + "file size = %d bytes\n" + generic); + debug (fun() -> Util.msg + "compression rate = %d%%\n" ((pb.stringSize * 100) / generic)) +*)) + + + (*** COMPRESSION ***) + + (* Compression buffer size *) + (* MUST be >= 2 * blockSize *) + let comprBufSize = 8192 + let comprBufSizeFS = Uutil.Filesize.ofInt 8192 + + (* Compress the file using the algorithm described in the header *) + let rsyncCompress sigs infd srcLength showProgress transmit = + debug (fun() -> Util.msg "compressing\n"); + debugLog (fun() -> Util.msg + "compression buffer size = %d bytes\n" comprBufSize); + debugLog (fun() -> Util.msg "block size = %d bytes\n" blockSize); + assert (comprBufSize >= 2 * blockSize); + let timer = Trace.startTimer "Compressing the new file" in + + (* Measures *) + let pb = + { hitHit = 0; hitMiss = 0; nbBlock = 0; nbString = 0; stringSize = 0 } in +(* + let transmit tokenList = + Safelist.iter + (fun token -> + match token with + | STRING s -> + let length = String.length s in + if Trace.enabled "rsynctoken" then debugToken (fun() -> + Util.msg "transmitting string (%d bytes)\n" length); + pb.nbString <- pb.nbString + 1; + pb.stringSize <- pb.stringSize + length + | BLOCK n -> + if Trace.enabled "rsynctoken" then debugToken (fun() -> Util.msg + "transmitting %d block(s) (sequence %d->%d)\n" + 1 n (n)); + pb.nbBlock <- pb.nbBlock + k) + tokenList; + transmit tokenList + in +*) + + (* Enable token buffering *) + let tokenQueue = makeQueue srcLength in + let flushTokenQueue () = + flushQueue tokenQueue showProgress transmit true in + let transmit token = queueToken tokenQueue showProgress transmit token in + + (* Set up the hash table for fast checksum look-up *) + let hashTableLength = ref (hashTableLength sigs) in + let blockTable = hashSig !hashTableLength sigs in + logHash blockTable !hashTableLength; + + (* Create the compression buffer *) + let comprBuf = String.create comprBufSize in + + (* If there is data waiting to be sent, transmit it as a STRING token *) + let transmitString toBeSent offset = + if offset > toBeSent then + transmit (STRING (comprBuf, toBeSent, offset - toBeSent)) + else + return () + in + + (* Set up the rolling checksum data *) + let checksum = ref 0 in + let cksumOutgoing = ref ' ' in + let cksumTable = ref (Checksum.init blockSize) in + + let absolutePos = ref Uutil.Filesize.zero in + + (* Check the new window position and update the compression buffer + if its end has been reached *) + let rec slideWindow newOffset toBeSent length miss : unit Lwt.t = + if newOffset + blockSize <= length then + computeChecksum newOffset toBeSent length miss + else if length = comprBufSize then begin + transmitString toBeSent newOffset >>= (fun () -> + let chunkSize = length - newOffset in + if chunkSize > 0 then begin + assert(comprBufSize >= blockSize); + String.blit comprBuf newOffset comprBuf 0 chunkSize + end; + let rem = Uutil.Filesize.sub srcLength !absolutePos in + let avail = comprBufSize - chunkSize in + let l = + reallyRead infd comprBuf chunkSize + (if rem > comprBufSizeFS then avail else + min (Uutil.Filesize.toInt rem) avail) + in + absolutePos := + Uutil.Filesize.add !absolutePos (Uutil.Filesize.ofInt l); + let length = chunkSize + l in + debugToken (fun() -> Util.msg "updating the compression buffer\n"); + debugToken (fun() -> Util.msg "new length = %d bytes\n" length); + slideWindow 0 0 length miss) + end else + transmitString toBeSent length >>= (fun () -> + transmit EOF) + + (* Compute the window contents checksum, in a rolling fashion if there + was a miss *) + and computeChecksum newOffset toBeSent length miss = + let cksum = + if miss then + Checksum.roll !cksumTable !checksum !cksumOutgoing + (String.unsafe_get comprBuf (newOffset + blockSize - 1)) + else + Checksum.substring comprBuf newOffset blockSize + in + checksum := cksum; + cksumOutgoing := String.unsafe_get comprBuf newOffset; + processBlock newOffset toBeSent length cksum + + (* Try to match the current block with one existing in the old file *) + and processBlock offset toBeSent length checksum = + if Trace.enabled "transfer+" then + debugV (fun() -> Util.msg + "processBlock offset=%d toBeSent=%d length=%d blockSize = %d\n" + offset toBeSent length blockSize); + if Trace.enabled "rsynctoken" then assert + (0 <= toBeSent && toBeSent <= offset && offset + blockSize <= length); + match findEntry blockTable !hashTableLength checksum with + | [] -> miss offset toBeSent length + | entry -> + let blockNum = findBlock offset checksum entry None in + if blockNum = -1 then begin + pb.hitMiss <- pb.hitMiss + 1; + miss offset toBeSent length + end else begin + pb.hitHit <- pb.hitHit + 1; + hit offset toBeSent length blockNum + end + + (* In the hash table entry, find nodes with the right checksum and + match fingerprints *) + and findBlock offset checksum entry fingerprint = + match entry, fingerprint with + | [], _ -> + -1 + | (k, cs, fp) :: tl, None + when cs = checksum -> + let fingerprint = Digest.substring comprBuf offset blockSize in + findBlock offset checksum entry (Some fingerprint) + | (k, cs, fp) :: tl, Some fingerprint + when (cs = checksum) && (fp = fingerprint) -> + k + | _ :: tl, _ -> + findBlock offset checksum tl fingerprint + + (* Miss : slide the window one character ahead *) + and miss offset toBeSent length = + slideWindow (offset + 1) toBeSent length true + + (* Hit : send the data waiting and a BLOCK token, then slide the window + one block ahead *) + and hit offset toBeSent length blockNum = + transmitString toBeSent offset >>= (fun () -> + let sent = offset in + let toBeSent = sent + blockSize in + transmit (BLOCK blockNum) >>= (fun () -> + slideWindow (offset + blockSize) toBeSent length false)) + in + + (* Initialization and termination *) + slideWindow comprBufSize comprBufSize comprBufSize false >>= (fun () -> + flushTokenQueue () >>= (fun () -> + logMeasures pb; + Trace.showTimer timer; + return ())) + +end Deleted: branches/2.32/src/transfer.mli =================================================================== --- trunk/src/transfer.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/transfer.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,106 +0,0 @@ -(* Unison file synchronizer: src/transfer.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* - Rsync : general algorithm description - - The rsync algorithm is a technique for reducing the cost of a file - transfer by avoiding the transfer of blocks that are already at the - destination. - Imagine we have source and destination computers that have files X and - Y respectively, where X and Y are similar. The algorithm proceeds as - follows : - - The destination computer divides file Y into blocks of an agreed-upon - size N. - - For each block, the destination computer computes two functions of the - block's contents : - - A 128-bit fingerprint of the block, which with very high - probability is different from the fingerprints of different blocks. - - A small checksum, which can be computed in a "rolling" fashion. - More precisely, if we are given the checksum for the N-byte block - at offset k, and we are given the bytes at offsets k and N+k, we - can efficiently compute the checksum for the N-byte block at offset - k+1. - - The destination computer sends a list of fingerprints and checksums to - the source computer. Blocks are identified implicitly by the order in - which they appear in the list. - - The source computer searches through file X to identify blocks that - have the same fingerprints as blocks that appear in the list sent - from B. The checksums are used to find candidate blocks in a single - pass through file X. Blocks with identical fingerprints are presumed - to be identical. - - The source computer sends instructions for reconstructing file X at the - destination. These instructions avoid transmitting blocks of X that are - identical to other blocks in Y by providing the numbers of identical - blocks and the strings containing the differences. -*) - - -(* Transfer instruction giving data to build a file incrementally *) -type transfer_instruction = string * int * int - -type transmitter = transfer_instruction -> unit Lwt.t - - -(*************************************************************************) -(* GENERIC TRANSMISSION *) -(*************************************************************************) - -(* Send the whole source file encoded in transfer instructions *) -val send : - in_channel (* source file descriptor *) - -> Uutil.Filesize.t (* source file length *) - -> (int -> unit) (* progress report *) - -> transmitter (* transfer instruction transmitter *) - -> unit Lwt.t - -val receive : - out_channel (* destination file descriptor *) - -> (int -> unit) (* progress report *) - -> transfer_instruction (* transfer instruction received *) - -> bool (* Whether we have reach the end of the file *) - - -(*************************************************************************) -(* RSYNC TRANSMISSION *) -(*************************************************************************) - -module Rsync : - sig - - (*** DESTINATION HOST ***) - - (* The rsync compression can only be activated when the file size is - greater than the threshold *) - val aboveRsyncThreshold : Uutil.Filesize.t -> bool - - (* Built from the old file by the destination computer *) - type rsync_block_info - - (* Compute block informations from the old file *) - val rsyncPreprocess : - in_channel (* old file descriptor *) - -> rsync_block_info list - - (* Interpret a transfer instruction *) - val rsyncDecompress : - in_channel (* old file descriptor *) - -> out_channel (* output file descriptor *) - -> (int -> unit) (* progress report *) - -> transfer_instruction (* transfer instruction received *) - -> bool - - (*** SOURCE HOST ***) - - (* Using block informations, parse the new file and send transfer - instructions accordingly *) - val rsyncCompress : - rsync_block_info list - (* block info received from the destination *) - -> in_channel (* new file descriptor *) - -> Uutil.Filesize.t (* source file length *) - -> (int -> unit) (* progress report *) - -> transmitter (* transfer instruction transmitter *) - -> unit Lwt.t - - end Copied: branches/2.32/src/transfer.mli (from rev 320, trunk/src/transfer.mli) =================================================================== --- branches/2.32/src/transfer.mli (rev 0) +++ branches/2.32/src/transfer.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,106 @@ +(* Unison file synchronizer: src/transfer.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +(* + Rsync : general algorithm description + + The rsync algorithm is a technique for reducing the cost of a file + transfer by avoiding the transfer of blocks that are already at the + destination. + Imagine we have source and destination computers that have files X and + Y respectively, where X and Y are similar. The algorithm proceeds as + follows : + - The destination computer divides file Y into blocks of an agreed-upon + size N. + - For each block, the destination computer computes two functions of the + block's contents : + - A 128-bit fingerprint of the block, which with very high + probability is different from the fingerprints of different blocks. + - A small checksum, which can be computed in a "rolling" fashion. + More precisely, if we are given the checksum for the N-byte block + at offset k, and we are given the bytes at offsets k and N+k, we + can efficiently compute the checksum for the N-byte block at offset + k+1. + - The destination computer sends a list of fingerprints and checksums to + the source computer. Blocks are identified implicitly by the order in + which they appear in the list. + - The source computer searches through file X to identify blocks that + have the same fingerprints as blocks that appear in the list sent + from B. The checksums are used to find candidate blocks in a single + pass through file X. Blocks with identical fingerprints are presumed + to be identical. + - The source computer sends instructions for reconstructing file X at the + destination. These instructions avoid transmitting blocks of X that are + identical to other blocks in Y by providing the numbers of identical + blocks and the strings containing the differences. +*) + + +(* Transfer instruction giving data to build a file incrementally *) +type transfer_instruction = string * int * int + +type transmitter = transfer_instruction -> unit Lwt.t + + +(*************************************************************************) +(* GENERIC TRANSMISSION *) +(*************************************************************************) + +(* Send the whole source file encoded in transfer instructions *) +val send : + in_channel (* source file descriptor *) + -> Uutil.Filesize.t (* source file length *) + -> (int -> unit) (* progress report *) + -> transmitter (* transfer instruction transmitter *) + -> unit Lwt.t + +val receive : + out_channel (* destination file descriptor *) + -> (int -> unit) (* progress report *) + -> transfer_instruction (* transfer instruction received *) + -> bool (* Whether we have reach the end of the file *) + + +(*************************************************************************) +(* RSYNC TRANSMISSION *) +(*************************************************************************) + +module Rsync : + sig + + (*** DESTINATION HOST ***) + + (* The rsync compression can only be activated when the file size is + greater than the threshold *) + val aboveRsyncThreshold : Uutil.Filesize.t -> bool + + (* Built from the old file by the destination computer *) + type rsync_block_info + + (* Compute block informations from the old file *) + val rsyncPreprocess : + in_channel (* old file descriptor *) + -> rsync_block_info list + + (* Interpret a transfer instruction *) + val rsyncDecompress : + in_channel (* old file descriptor *) + -> out_channel (* output file descriptor *) + -> (int -> unit) (* progress report *) + -> transfer_instruction (* transfer instruction received *) + -> bool + + (*** SOURCE HOST ***) + + (* Using block informations, parse the new file and send transfer + instructions accordingly *) + val rsyncCompress : + rsync_block_info list + (* block info received from the destination *) + -> in_channel (* new file descriptor *) + -> Uutil.Filesize.t (* source file length *) + -> (int -> unit) (* progress report *) + -> transmitter (* transfer instruction transmitter *) + -> unit Lwt.t + + end Deleted: branches/2.32/src/transport.ml =================================================================== --- trunk/src/transport.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/transport.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,179 +0,0 @@ -(* Unison file synchronizer: src/transport.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -open Common -open Lwt - -let debug = Trace.debug "transport" - -(*****************************************************************************) -(* MAIN FUNCTIONS *) -(*****************************************************************************) - -let fileSize uiFrom uiTo = - match uiFrom, uiTo with - _, Updates (File (props, ContentsUpdated (_, _, ress)), _) -> - (Props.length props, Osx.ressLength ress) - | Updates (_, Previous (`FILE, props, _, ress)), - (NoUpdates | Updates (File (_, ContentsSame), _)) -> - (Props.length props, Osx.ressLength ress) - | _ -> - assert false - -let maxthreads = - Prefs.createInt "maxthreads" 20 - "!maximum number of simultaneous file transfers" - ("This preference controls how much concurrency is allowed during" - ^ " the transport phase. Normally, it should be set reasonably high " - ^ "(default is 20) to maximize performance, but when Unison is used " - ^ "over a low-bandwidth link it may be helpful to set it lower (e.g. " - ^ "to 1) so that Unison doesn't soak up all the available bandwidth." - ) - -let actionReg = Lwt_util.make_region (Prefs.read maxthreads) - -(* Logging for a thread: write a message before and a message after the - execution of the thread. *) -let logLwt (msgBegin: string) - (t: unit -> 'a Lwt.t) - (fMsgEnd: 'a -> string) - : 'a Lwt.t = - Trace.log msgBegin; - Lwt.bind (t ()) (fun v -> - Trace.log (fMsgEnd v); - Lwt.return v) - -(* [logLwtNumbered desc t] provides convenient logging for a thread given a - description [desc] of the thread [t ()], generate pair of messages of the - following form in the log: - * - [BGN] - ... - [END] - **) -let rLogCounter = ref 0 -let logLwtNumbered (lwtDescription: string) (lwtShortDescription: string) - (t: unit -> 'a Lwt.t): 'a Lwt.t = - let _ = (rLogCounter := (!rLogCounter) + 1; !rLogCounter) in - let lwtDescription = Util.replacesubstring lwtDescription "\n " "" in - logLwt (Printf.sprintf "[BGN] %s\n" lwtDescription) t - (fun _ -> - Printf.sprintf "[END] %s\n" lwtShortDescription) - -let stashCurrentVersionOnRoot: Common.root -> Path.t -> unit Lwt.t = - Remote.registerRootCmd - "stashCurrentVersion" - (fun (fspath, path) -> - Lwt.return (Stasher.stashCurrentVersion fspath (Update.translatePathLocal fspath path) None)) - -let stashCurrentVersions fromRoot toRoot path = - stashCurrentVersionOnRoot fromRoot path >>= (fun()-> - stashCurrentVersionOnRoot toRoot path) - -let doAction (fromRoot,toRoot) path fromContents toContents id = - Lwt_util.resize_region actionReg (Prefs.read maxthreads); - Lwt_util.resize_region Files.copyReg (Prefs.read maxthreads); - Lwt_util.run_in_region actionReg 1 (fun () -> - if not !Trace.sendLogMsgsToStderr then - Trace.statusDetail (Path.toString path); - Remote.Thread.unwindProtect (fun () -> - match fromContents, toContents with - (`ABSENT, _, _, _), (_, _, _, uiTo) -> - logLwtNumbered - ("Deleting " ^ Path.toString path ^ - "\n from "^ root2string toRoot) - ("Deleting " ^ Path.toString path) - (fun () -> Files.delete fromRoot path toRoot path uiTo) - (* No need to transfer the whole directory/file if there were only - property modifications on one side. (And actually, it would be - incorrect to transfer a directory in this case.) *) - | (_, (`Unchanged | `PropsChanged), fromProps, uiFrom), - (_, (`Unchanged | `PropsChanged), toProps, uiTo) -> - logLwtNumbered - ("Copying properties for " ^ Path.toString path - ^ "\n from " ^ root2string fromRoot ^ "\n to " ^ - root2string toRoot) - ("Copying properties for " ^ Path.toString path) - (fun () -> - Files.setProp - fromRoot path toRoot path fromProps toProps uiFrom uiTo) - | (`FILE, _, _, uiFrom), (`FILE, _, _, uiTo) -> - logLwtNumbered - ("Updating file " ^ Path.toString path ^ "\n from " ^ - root2string fromRoot ^ "\n to " ^ - root2string toRoot) - ("Updating file " ^ Path.toString path) - (fun () -> - Files.copy (`Update (fileSize uiFrom uiTo)) - fromRoot path uiFrom toRoot path uiTo id >>= (fun()-> - stashCurrentVersions fromRoot toRoot path)) - | (_, _, _, uiFrom), (_, _, _, uiTo) -> - logLwtNumbered - ("Copying " ^ Path.toString path ^ "\n from " ^ - root2string fromRoot ^ "\n to " ^ - root2string toRoot) - ("Copying " ^ Path.toString path) - (fun () -> - Files.copy `Copy - fromRoot path uiFrom toRoot path uiTo id >>= (fun()-> - stashCurrentVersions fromRoot toRoot path))) - (fun e -> Trace.log - (Printf.sprintf - "Failed: %s\n" (Util.printException e)); - return ())) - -let propagate root1 root2 reconItem id showMergeFn = - let path = reconItem.path in - match reconItem.replicas with - Problem p -> - Trace.log (Printf.sprintf "[ERROR] Skipping %s\n %s\n" - (Path.toString path) p); - return () - | Different(rc1,rc2,dir,_) -> - match !dir with - Conflict -> - Trace.log (Printf.sprintf "[CONFLICT] Skipping %s\n" - (Path.toString path)); - return () - | Replica1ToReplica2 -> - doAction (root1, root2) path rc1 rc2 id - | Replica2ToReplica1 -> - doAction (root2, root1) path rc2 rc1 id - | Merge -> - begin match (rc1,rc2) with - (`FILE, _, _, ui1), (`FILE, _, _, ui2) -> - Files.merge root1 root2 path id ui1 ui2 showMergeFn; - return () - | _ -> raise (Util.Transient "Can only merge two existing files") - end - -let transportItem reconItem id showMergeFn = - let (root1,root2) = Globals.roots() in - propagate root1 root2 reconItem id showMergeFn - -(* ---------------------------------------------------------------------- *) - -let logStart () = - Abort.reset (); - let tm = Util.localtime (Util.time()) in - let m = - Printf.sprintf - "%s%s started propagating changes at %02d:%02d:%02d on %02d %s %04d\n" - (if Prefs.read Trace.terse || Prefs.read Globals.batch then "" else "\n\n") - (String.uppercase Uutil.myNameAndVersion) - tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec - tm.Unix.tm_mday (Util.monthname tm.Unix.tm_mon) - (tm.Unix.tm_year+1900) in - Trace.logverbose m - -let logFinish () = - let tm = Util.localtime (Util.time()) in - let m = - Printf.sprintf - "%s finished propagating changes at %02d:%02d:%02d on %02d %s %04d\n%s" - (String.uppercase Uutil.myNameAndVersion) - tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec - tm.Unix.tm_mday (Util.monthname tm.Unix.tm_mon) - (tm.Unix.tm_year+1900) - (if Prefs.read Trace.terse || Prefs.read Globals.batch then "" else "\n\n") in - Trace.logverbose m Copied: branches/2.32/src/transport.ml (from rev 320, trunk/src/transport.ml) =================================================================== --- branches/2.32/src/transport.ml (rev 0) +++ branches/2.32/src/transport.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,194 @@ +(* Unison file synchronizer: src/transport.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +open Common +open Lwt + +let debug = Trace.debug "transport" + +(*****************************************************************************) +(* MAIN FUNCTIONS *) +(*****************************************************************************) + +let fileSize uiFrom uiTo = + match uiFrom, uiTo with + _, Updates (File (props, ContentsUpdated (_, _, ress)), _) -> + (Props.length props, Osx.ressLength ress) + | Updates (_, Previous (`FILE, props, _, ress)), + (NoUpdates | Updates (File (_, ContentsSame), _)) -> + (Props.length props, Osx.ressLength ress) + | _ -> + assert false + +let maxthreads = + Prefs.createInt "maxthreads" 20 + "!maximum number of simultaneous file transfers" + ("This preference controls how much concurrency is allowed during" + ^ " the transport phase. Normally, it should be set reasonably high " + ^ "(default is 20) to maximize performance, but when Unison is used " + ^ "over a low-bandwidth link it may be helpful to set it lower (e.g. " + ^ "to 1) so that Unison doesn't soak up all the available bandwidth." + ) + +let actionReg = Lwt_util.make_region (Prefs.read maxthreads) + +(* Logging for a thread: write a message before and a message after the + execution of the thread. *) +let logLwt (msgBegin: string) + (t: unit -> 'a Lwt.t) + (fMsgEnd: 'a -> string) + : 'a Lwt.t = + Trace.log msgBegin; + Lwt.bind (t ()) (fun v -> + Trace.log (fMsgEnd v); + Lwt.return v) + +(* [logLwtNumbered desc t] provides convenient logging for a thread given a + description [desc] of the thread [t ()], generate pair of messages of the + following form in the log: + * + [BGN] + ... + [END] + **) +let rLogCounter = ref 0 +let logLwtNumbered (lwtDescription: string) (lwtShortDescription: string) + (t: unit -> 'a Lwt.t): 'a Lwt.t = + let _ = (rLogCounter := (!rLogCounter) + 1; !rLogCounter) in + let lwtDescription = Util.replacesubstring lwtDescription "\n " "" in + logLwt (Printf.sprintf "[BGN] %s\n" lwtDescription) t + (fun _ -> + Printf.sprintf "[END] %s\n" lwtShortDescription) + +let stashCurrentVersionOnRoot: Common.root -> Path.t -> unit Lwt.t = + Remote.registerRootCmd + "stashCurrentVersion" + (fun (fspath, path) -> + Lwt.return (Stasher.stashCurrentVersion fspath (Update.translatePathLocal fspath path) None)) + +let stashCurrentVersions fromRoot toRoot path = + stashCurrentVersionOnRoot fromRoot path >>= (fun()-> + stashCurrentVersionOnRoot toRoot path) + +let doAction (fromRoot,toRoot) path fromContents toContents id = + Lwt_util.resize_region actionReg (Prefs.read maxthreads); + Lwt_util.resize_region Files.copyReg (Prefs.read maxthreads); + Lwt_util.run_in_region actionReg 1 (fun () -> + if not !Trace.sendLogMsgsToStderr then + Trace.statusDetail (Path.toString path); + Remote.Thread.unwindProtect (fun () -> + match fromContents, toContents with + (`ABSENT, _, _, _), (_, _, _, uiTo) -> + logLwtNumbered + ("Deleting " ^ Path.toString path ^ + "\n from "^ root2string toRoot) + ("Deleting " ^ Path.toString path) + (fun () -> Files.delete fromRoot path toRoot path uiTo) + (* No need to transfer the whole directory/file if there were only + property modifications on one side. (And actually, it would be + incorrect to transfer a directory in this case.) *) + | (_, (`Unchanged | `PropsChanged), fromProps, uiFrom), + (_, (`Unchanged | `PropsChanged), toProps, uiTo) -> + logLwtNumbered + ("Copying properties for " ^ Path.toString path + ^ "\n from " ^ root2string fromRoot ^ "\n to " ^ + root2string toRoot) + ("Copying properties for " ^ Path.toString path) + (fun () -> + Files.setProp + fromRoot path toRoot path fromProps toProps uiFrom uiTo) + | (`FILE, _, _, uiFrom), (`FILE, _, _, uiTo) -> + logLwtNumbered + ("Updating file " ^ Path.toString path ^ "\n from " ^ + root2string fromRoot ^ "\n to " ^ + root2string toRoot) + ("Updating file " ^ Path.toString path) + (fun () -> + Files.copy (`Update (fileSize uiFrom uiTo)) + fromRoot path uiFrom toRoot path uiTo id >>= (fun()-> + stashCurrentVersions fromRoot toRoot path)) + | (_, _, _, uiFrom), (_, _, _, uiTo) -> + logLwtNumbered + ("Copying " ^ Path.toString path ^ "\n from " ^ + root2string fromRoot ^ "\n to " ^ + root2string toRoot) + ("Copying " ^ Path.toString path) + (fun () -> + Files.copy `Copy + fromRoot path uiFrom toRoot path uiTo id >>= (fun()-> + stashCurrentVersions fromRoot toRoot path))) + (fun e -> Trace.log + (Printf.sprintf + "Failed: %s\n" (Util.printException e)); + return ())) + +let propagate root1 root2 reconItem id showMergeFn = + let path = reconItem.path in + match reconItem.replicas with + Problem p -> + Trace.log (Printf.sprintf "[ERROR] Skipping %s\n %s\n" + (Path.toString path) p); + return () + | Different(rc1,rc2,dir,_) -> + match !dir with + Conflict -> + Trace.log (Printf.sprintf "[CONFLICT] Skipping %s\n" + (Path.toString path)); + return () + | Replica1ToReplica2 -> + doAction (root1, root2) path rc1 rc2 id + | Replica2ToReplica1 -> + doAction (root2, root1) path rc2 rc1 id + | Merge -> + begin match (rc1,rc2) with + (`FILE, _, _, ui1), (`FILE, _, _, ui2) -> + Files.merge root1 root2 path id ui1 ui2 showMergeFn; + return () + | _ -> raise (Util.Transient "Can only merge two existing files") + end + +let transportItem reconItem id showMergeFn = + let (root1,root2) = Globals.roots() in + propagate root1 root2 reconItem id showMergeFn + +(* ---------------------------------------------------------------------- *) + +let logStart () = + Abort.reset (); + let tm = Util.localtime (Util.time()) in + let m = + Printf.sprintf + "%s%s started propagating changes at %02d:%02d:%02d on %02d %s %04d\n" + (if Prefs.read Trace.terse || Prefs.read Globals.batch then "" else "\n\n") + (String.uppercase Uutil.myNameAndVersion) + tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec + tm.Unix.tm_mday (Util.monthname tm.Unix.tm_mon) + (tm.Unix.tm_year+1900) in + Trace.logverbose m + +let logFinish () = + let tm = Util.localtime (Util.time()) in + let m = + Printf.sprintf + "%s finished propagating changes at %02d:%02d:%02d on %02d %s %04d\n%s" + (String.uppercase Uutil.myNameAndVersion) + tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec + tm.Unix.tm_mday (Util.monthname tm.Unix.tm_mon) + (tm.Unix.tm_year+1900) + (if Prefs.read Trace.terse || Prefs.read Globals.batch then "" else "\n\n") in + Trace.logverbose m Deleted: branches/2.32/src/transport.mli =================================================================== --- trunk/src/transport.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/transport.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,14 +0,0 @@ -(* Unison file synchronizer: src/transport.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* Executes the actions implied by the reconItem list. *) -val transportItem : - Common.reconItem (* Updates that need to be performed *) - -> Uutil.File.t (* id for progress reports *) - -> (string->string->bool) (* fn to display title / result of merge and confirm *) - -> unit Lwt.t - -(* Should be called respectively when starting the synchronization and - once it is finished *) -val logStart : unit -> unit -val logFinish : unit -> unit Copied: branches/2.32/src/transport.mli (from rev 320, trunk/src/transport.mli) =================================================================== --- branches/2.32/src/transport.mli (rev 0) +++ branches/2.32/src/transport.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,14 @@ +(* Unison file synchronizer: src/transport.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +(* Executes the actions implied by the reconItem list. *) +val transportItem : + Common.reconItem (* Updates that need to be performed *) + -> Uutil.File.t (* id for progress reports *) + -> (string->string->bool) (* fn to display title / result of merge and confirm *) + -> unit Lwt.t + +(* Should be called respectively when starting the synchronization and + once it is finished *) +val logStart : unit -> unit +val logFinish : unit -> unit Deleted: branches/2.32/src/tree.ml =================================================================== --- trunk/src/tree.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/tree.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,105 +0,0 @@ -(* Unison file synchronizer: src/tree.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -type ('a, 'b) t = - Node of ('a * ('a, 'b) t) list * 'b option - | Leaf of 'b - -type ('a, 'b) u = - { anc: (('a, 'b) u * 'a) option; - node: 'b option; - children: ('a * ('a, 'b) t) list} - -let start = - {anc = None; node = None; children = []} - -let add t v = - {t with node = Some v} - -let enter t n = {anc = Some (t, n); node = None; children = []} - -let leave t = - match t with - {anc = Some (t, n); node = None; children = []} -> - t - | {anc = Some (t, n); node = Some v; children = []} -> - {t with children = (n, Leaf v) :: t.children} - | {anc = Some (t, n); node = v; children = l} -> - {t with children = (n, (Node (Safelist.rev l, v))) :: t.children} - | {anc = None} -> - invalid_arg "Tree.leave" - -let finish t = - match t with - {anc = Some _} -> - invalid_arg "Tree.finish" - | {anc = None; node = Some v; children = []} -> - Leaf v - | {anc = None; node = v; children = l} -> - Node (Safelist.rev l, v) - -let rec leave_all t = - if t.anc = None then t else leave_all (leave t) - -let rec empty t = - {anc = - begin match t.anc with - Some (t', n) -> Some (empty t', n) - | None -> None - end; - node = None; - children = []} - -let slice t = - (finish (leave_all t), empty t) - -(****) - -let is_empty t = - match t with - Node ([], None) -> true - | _ -> false - -let rec map f g t = - match t with - Node (l, v) -> - Node (Safelist.map (fun (n, t') -> (f n, map f g t')) l, - match v with None -> None | Some v -> Some (g v)) - | Leaf v -> - Leaf (g v) - -let rec iteri t path pcons f = - match t with - Node (l, v) -> - begin match v with - Some v -> f path v - | None -> () - end; - Safelist.iter (fun (n, t') -> iteri t' (pcons path n) pcons f) l - | Leaf v -> - f path v - -let rec size_rec s t = - match t with - Node (l, v) -> - let s' = if v = None then s else s + 1 in - Safelist.fold_left (fun s (_, t') -> size_rec s t') s' l - | Leaf v -> - s + 1 - -let size t = size_rec 0 t - -let rec flatten t path pcons result = - match t with - Leaf v -> - (path, v) :: result - | Node (l, v) -> - let rem = - Safelist.fold_right - (fun (name, t') rem -> - flatten t' (pcons path name) pcons rem) - l result - in - match v with - None -> rem - | Some v -> (path, v) :: rem Copied: branches/2.32/src/tree.ml (from rev 320, trunk/src/tree.ml) =================================================================== --- branches/2.32/src/tree.ml (rev 0) +++ branches/2.32/src/tree.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,120 @@ +(* Unison file synchronizer: src/tree.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +type ('a, 'b) t = + Node of ('a * ('a, 'b) t) list * 'b option + | Leaf of 'b + +type ('a, 'b) u = + { anc: (('a, 'b) u * 'a) option; + node: 'b option; + children: ('a * ('a, 'b) t) list} + +let start = + {anc = None; node = None; children = []} + +let add t v = + {t with node = Some v} + +let enter t n = {anc = Some (t, n); node = None; children = []} + +let leave t = + match t with + {anc = Some (t, n); node = None; children = []} -> + t + | {anc = Some (t, n); node = Some v; children = []} -> + {t with children = (n, Leaf v) :: t.children} + | {anc = Some (t, n); node = v; children = l} -> + {t with children = (n, (Node (Safelist.rev l, v))) :: t.children} + | {anc = None} -> + invalid_arg "Tree.leave" + +let finish t = + match t with + {anc = Some _} -> + invalid_arg "Tree.finish" + | {anc = None; node = Some v; children = []} -> + Leaf v + | {anc = None; node = v; children = l} -> + Node (Safelist.rev l, v) + +let rec leave_all t = + if t.anc = None then t else leave_all (leave t) + +let rec empty t = + {anc = + begin match t.anc with + Some (t', n) -> Some (empty t', n) + | None -> None + end; + node = None; + children = []} + +let slice t = + (finish (leave_all t), empty t) + +(****) + +let is_empty t = + match t with + Node ([], None) -> true + | _ -> false + +let rec map f g t = + match t with + Node (l, v) -> + Node (Safelist.map (fun (n, t') -> (f n, map f g t')) l, + match v with None -> None | Some v -> Some (g v)) + | Leaf v -> + Leaf (g v) + +let rec iteri t path pcons f = + match t with + Node (l, v) -> + begin match v with + Some v -> f path v + | None -> () + end; + Safelist.iter (fun (n, t') -> iteri t' (pcons path n) pcons f) l + | Leaf v -> + f path v + +let rec size_rec s t = + match t with + Node (l, v) -> + let s' = if v = None then s else s + 1 in + Safelist.fold_left (fun s (_, t') -> size_rec s t') s' l + | Leaf v -> + s + 1 + +let size t = size_rec 0 t + +let rec flatten t path pcons result = + match t with + Leaf v -> + (path, v) :: result + | Node (l, v) -> + let rem = + Safelist.fold_right + (fun (name, t') rem -> + flatten t' (pcons path name) pcons rem) + l result + in + match v with + None -> rem + | Some v -> (path, v) :: rem Deleted: branches/2.32/src/tree.mli =================================================================== --- trunk/src/tree.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/tree.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,62 +0,0 @@ -(* Unison file synchronizer: src/tree.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* An ('a, 'b) t is a tree with 'a-labeled arcs and 'b-labeled nodes. *) -(* Labeling for the internal nodes is optional *) -type ('a, 'b) t = - Node of ('a * ('a, 'b) t) list * 'b option - | Leaf of 'b - -(* An "unfinished" tree *) -type ('a, 'b) u - -(* ------------------------------------------------------------------------- *) -(* Functions for unfinished tree (u-tree) *) -(* ------------------------------------------------------------------------- *) - -(* start an empty u-tree *) -val start : ('a, 'b) u - -(* add t v: add a node with label "v" at the current position *) -val add : ('a, 'b) u -> 'b -> ('a, 'b) u - -(* enter t n: create a new subtree, with leading arc labeled "v", at the *) -(* current position *) -val enter : ('a, 'b) u -> 'a -> ('a, 'b) u - -(* go up one-level *) -val leave : ('a, 'b) u -> ('a, 'b) u - -(* ------------------------------------------------------------------------- *) -(* From u-trees to trees *) -(* ------------------------------------------------------------------------- *) - -(* "finish" up the tree construction and deliver a tree precondition: *) -(* already at the top-level of the tree *) -val finish : ('a, 'b) u -> ('a, 'b) t - -(* from the u-tree, deliver a tree (by going back to top-level and "finish") *) -(* and the skeleton u-tree, which represents the current position *) -val slice : ('a, 'b) u -> ('a, 'b) t * ('a, 'b) u - -(* ------------------------------------------------------------------------- *) -(* Functions for trees *) -(* ------------------------------------------------------------------------- *) - -(* Test if the tree is empty *) -val is_empty : ('a, 'b) t -> bool - -(* pointwise renaming of arcs and nodes *) -val map : ('a -> 'c) -> ('b -> 'd) -> ('a, 'b) t -> ('c, 'd) t - -(* DFT the tree, keeping an accumulator for the path, and apply a function *) -(* to all the partial paths ended by a labeled node *) -val iteri : ('a, 'b) t -> 'c -> ('c -> 'a -> 'c) -> ('c -> 'b -> unit) -> unit - -(* count the number of labeled nodes *) -val size : ('a, 'b) t -> int - -(* DFT the tree, keep an accumulator for the path, and record all the *) -(* partial paths ended by a labeled node *) -val flatten : - ('a, 'b) t -> 'c -> ('c -> 'a -> 'c) -> ('c * 'b) list -> ('c * 'b) list Copied: branches/2.32/src/tree.mli (from rev 320, trunk/src/tree.mli) =================================================================== --- branches/2.32/src/tree.mli (rev 0) +++ branches/2.32/src/tree.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,62 @@ +(* Unison file synchronizer: src/tree.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +(* An ('a, 'b) t is a tree with 'a-labeled arcs and 'b-labeled nodes. *) +(* Labeling for the internal nodes is optional *) +type ('a, 'b) t = + Node of ('a * ('a, 'b) t) list * 'b option + | Leaf of 'b + +(* An "unfinished" tree *) +type ('a, 'b) u + +(* ------------------------------------------------------------------------- *) +(* Functions for unfinished tree (u-tree) *) +(* ------------------------------------------------------------------------- *) + +(* start an empty u-tree *) +val start : ('a, 'b) u + +(* add t v: add a node with label "v" at the current position *) +val add : ('a, 'b) u -> 'b -> ('a, 'b) u + +(* enter t n: create a new subtree, with leading arc labeled "v", at the *) +(* current position *) +val enter : ('a, 'b) u -> 'a -> ('a, 'b) u + +(* go up one-level *) +val leave : ('a, 'b) u -> ('a, 'b) u + +(* ------------------------------------------------------------------------- *) +(* From u-trees to trees *) +(* ------------------------------------------------------------------------- *) + +(* "finish" up the tree construction and deliver a tree precondition: *) +(* already at the top-level of the tree *) +val finish : ('a, 'b) u -> ('a, 'b) t + +(* from the u-tree, deliver a tree (by going back to top-level and "finish") *) +(* and the skeleton u-tree, which represents the current position *) +val slice : ('a, 'b) u -> ('a, 'b) t * ('a, 'b) u + +(* ------------------------------------------------------------------------- *) +(* Functions for trees *) +(* ------------------------------------------------------------------------- *) + +(* Test if the tree is empty *) +val is_empty : ('a, 'b) t -> bool + +(* pointwise renaming of arcs and nodes *) +val map : ('a -> 'c) -> ('b -> 'd) -> ('a, 'b) t -> ('c, 'd) t + +(* DFT the tree, keeping an accumulator for the path, and apply a function *) +(* to all the partial paths ended by a labeled node *) +val iteri : ('a, 'b) t -> 'c -> ('c -> 'a -> 'c) -> ('c -> 'b -> unit) -> unit + +(* count the number of labeled nodes *) +val size : ('a, 'b) t -> int + +(* DFT the tree, keep an accumulator for the path, and record all the *) +(* partial paths ended by a labeled node *) +val flatten : + ('a, 'b) t -> 'c -> ('c -> 'a -> 'c) -> ('c * 'b) list -> ('c * 'b) list Deleted: branches/2.32/src/ubase/rx.ml =================================================================== --- trunk/src/ubase/rx.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/ubase/rx.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,819 +0,0 @@ -(* Unison file synchronizer: src/ubase/rx.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) -(* - Inspired by some code and algorithms from Mark William Hopkins - (regexp.tar.gz, available in the comp.compilers file archive) -*) - -(* -Missing POSIX features ----------------------- -- Collating sequences -*) - -type v = - Cst of int list - | Alt of u list - | Seq of u list - | Rep of u * int * int option - | Bol | Eol - | Int of u list - | Dif of u * u - -and u = { desc : v; hash : int } - -(****) - -let hash x = - match x with - Cst l -> List.fold_left (fun h i -> h + 757 * i) 0 l - | Alt l -> 199 * List.fold_left (fun h y -> h + 883 * y.hash) 0 l - | Seq l -> 821 * List.fold_left (fun h y -> h + 883 * y.hash) 0 l - | Rep (y, i, Some j) -> 197 * y.hash + 137 * i + j - | Rep (y, i, None) -> 197 * y.hash + 137 * i + 552556457 - | Bol -> 165160782 - | Eol -> 152410806 - | Int l -> 71 * List.fold_left (fun h y -> h + 883 * y.hash) 0 l - | Dif (y, z) -> 379 * y.hash + 563 * z.hash - -let make x = {desc = x; hash = hash x} - -let epsilon = make (Seq []) -let empty = make (Alt []) - -(**** Printing ****) - -open Format - -let print_list sep print l = - match l with - [] -> () - | v::r -> print v; List.iter (fun v -> sep (); print v) r - -let rec print n t = - match t.desc with - Cst l -> - open_box 1; print_string "["; - print_list print_space print_int l; - print_string "]"; close_box () - | Alt tl -> - if n > 0 then begin open_box 1; print_string "(" end; - print_list (fun () -> print_string "|"; print_cut ()) (print 1) tl; - if n > 0 then begin print_string ")"; close_box () end - | Seq tl -> - if n > 1 then begin open_box 1; print_string "(" end; - print_list (fun () -> print_cut ()) (print 2) tl; - if n > 1 then begin print_string ")"; close_box () end - | Rep (t, 0, None) -> - print 2 t; print_string "*" - | Rep (t, i, None) -> - print 2 t; print_string "{"; print_int i; print_string ",}" - | Rep (t, i, Some j) -> - print 2 t; - print_string "{"; print_int i; print_string ","; - print_int j; print_string "}" - | _ -> assert false - -(**** Constructors for regular expressions *) - -let seq2 x y = - match x.desc, y.desc with - Alt [], _ | _, Alt [] -> empty - | Seq [], s -> y - | r, Seq [] -> x - | Seq r, Seq s -> make (Seq (r @ s)) - | Seq r, _ -> make (Seq (r @ [y])) - | _, Seq s -> make (Seq (x :: s)) - | r, s -> make (Seq [x; y]) - -let seq l = List.fold_right seq2 l epsilon - -let seq' l = match l with [] -> epsilon | [x] -> x | _ -> make (Seq l) - -let rec alt_merge r s = - match r, s with - [], _ -> s - | _, [] -> r - | {desc = Seq (x::m)} :: s, {desc = Seq (y::n)} :: r when x = y -> - alt_merge (seq2 x (alt2 (seq' m) (seq' n))::s) r - | x :: r', y :: s' -> - let c = compare x y in - if c = 0 then x :: alt_merge r' s' - else if c < 0 then x :: alt_merge r' s - else (* if c > 0 then *) y :: alt_merge r s' - -and alt2 x y = - let c = compare x y in - if c = 0 then x else - match x.desc, y.desc with - Alt [], _ -> y - | _, Alt [] -> x - | Alt r, Alt s -> make (Alt (alt_merge r s)) - | Alt [r], _ when r = y -> y - | _, Alt [s] when x = s -> x - | Alt r, _ -> make (Alt (alt_merge r [y])) - | _, Alt s -> make (Alt (alt_merge [x] s)) - | Seq (r::m), Seq (s::n) when r = s -> seq2 r (alt2 (seq' m) (seq' n)) - | _, _ -> make (if c < 0 then Alt [x; y] else Alt [y; x]) - -let alt l = List.fold_right alt2 l empty - -let rep x i j = - match x.desc with - Alt [] when i > 0 -> empty - | Alt [] | Seq [] -> epsilon - | _ -> - match i, j with - _, Some 0 -> epsilon - | 0, Some 1 -> alt2 epsilon x - | 1, Some 1 -> x - | _ -> make (Rep (x, i, j)) - -let rec int2 x y = - let c = compare x y in - if c = 0 then x else - match x.desc, y.desc with - Int [], _ -> y - | _, Int [] -> x - | Int r, Int s -> make (Int (alt_merge r s)) - | Int [r], _ when r = y -> y - | _, Int [s] when s = x -> x - | Int r, _ -> make (Int (alt_merge r [y])) - | _, Int s -> make (Int (alt_merge [x] s)) - | _, _ -> make (if c < 0 then Int [x; y] else Int [y; x]) - -let int l = List.fold_right int2 l empty - -let cst c = Cst [Char.code c] - -let rec dif x y = - if x = y then empty else - match x.desc, y.desc with - Dif (x1, y1), _ -> dif x1 (alt2 y1 y) - | Alt [], _ -> empty - | _, Alt [] -> x - | _ -> make (Dif (x, y)) - -(**** Computation of the next states of an automata ****) - -type pos = Pos_bol | Pos_other -let never = 0 -let always = (-1) -let when_eol = 2 - -let combine top bot op f l = - let rec combine v l = - match l with - [] -> v - | a::r -> - let c = f a in - if c = bot then c else combine (op v c) r - in - combine top l - -module ReTbl = - Hashtbl.Make - (struct - type t = u - let equal x y = x.hash = y.hash && x = y - let hash x = x.hash - end) - -let h = ReTbl.create 101 -let rec contains_epsilon pos x = -try ReTbl.find h x with Not_found -> -let res = - match x.desc with - Cst _ -> never - | Alt l -> combine never always (lor) (contains_epsilon pos) l - | Seq l -> combine always never (land) (contains_epsilon pos) l - | Rep (_, 0, _) -> always - | Rep (y, _, _) -> contains_epsilon pos y - | Bol -> if pos = Pos_bol then always else never - | Eol -> when_eol - | Int l -> combine always never (land) (contains_epsilon pos) l - | Dif (y, z) -> contains_epsilon pos y land - (lnot (contains_epsilon pos z)) -in -ReTbl.add h x res; res - -module DiffTbl = - Hashtbl.Make - (struct - type t = int * u - let equal ((c : int), x) (d, y) = c = d && x.hash = y.hash && x = y - let hash (c, x) = x.hash + 11 * c - end) - -let diff_cache = DiffTbl.create 101 - -let rec delta_seq nl pos c l = - match l with - [] -> - empty - | x::r -> - let rdx = seq2 (delta nl pos c x) (seq' r) in - let eps = contains_epsilon pos x in - if eps land always = always then - alt2 rdx (delta_seq nl pos c r) - else if eps land when_eol = when_eol && c = nl then - alt2 rdx (delta_seq nl pos c r) - else - rdx - -and delta nl pos c x = -let p = (c, x) in -try DiffTbl.find diff_cache p with Not_found -> -let res = - match x.desc with - Cst l -> if List.mem c l then epsilon else empty - | Alt l -> alt (List.map (delta nl pos c) l) - | Seq l -> delta_seq nl pos c l - | Rep (y, 0, None) -> seq2 (delta nl pos c y) x - | Rep (y, i, None) -> seq2 (delta nl pos c y) (rep y (i - 1) None) - | Rep (y, 0, Some j) -> seq2 (delta nl pos c y) (rep y 0 (Some (j - 1))) - | Rep (y, i, Some j) -> seq2 (delta nl pos c y) (rep y (i - 1) (Some (j-1))) - | Eol | Bol -> empty - | Int l -> int (List.map (delta nl pos c) l) - | Dif (y, z) -> dif (delta nl pos c y) (delta nl pos c z) -in -DiffTbl.add diff_cache p res; -res - -(**** String matching ****) - -type state = - { mutable valid : bool; - mutable next : state array; - pos : pos; - final : bool; - desc : u } - -type rx = - { initial : state; - categ : int array; - ncat : int; - states : state ReTbl.t } - -let unknown = - { valid = false; next = [||]; desc = empty ; pos = Pos_bol; final = false } - -let mk_state ncat pos desc = - { valid = desc <> empty; - next = Array.make ncat unknown; - pos = pos; - desc = desc; - final = contains_epsilon pos desc <> 0 } - -let find_state states ncat pos desc = - try - ReTbl.find states desc - with Not_found -> - let st = mk_state ncat pos desc in - ReTbl.add states desc st; - st - -let rec validate s i l rx cat st c = - let nl = cat.(Char.code '\n') in - let desc = delta nl st.pos c st.desc in - st.next.(c) <- - find_state rx.states rx.ncat (if c = nl then Pos_bol else Pos_other) desc; - loop s i l rx cat st - -and loop s i l rx cat st = - let rec loop i st = - let c = Array.unsafe_get cat (Char.code (String.unsafe_get s i)) in - let st' = Array.unsafe_get st.next c in - if st'.valid then begin - let i = i + 1 in - if i < l then - loop i st' - else - st'.final - end else if st' != unknown then - false - else - validate s i l rx cat st c - in - loop i st - -let match_str rx s = - let l = String.length s in - if l = 0 then rx.initial.final else - loop s 0 l rx rx.categ rx.initial - -(* Combining the final and valid fields may make things slightly faster - (one less memory access) *) -let rec validate_pref s i l l0 rx cat st c = - let nl = cat.(Char.code '\n') in - let desc = delta nl st.pos c st.desc in - st.next.(c) <- - find_state rx.states rx.ncat (if c = nl then Pos_bol else Pos_other) desc; - loop_pref s i l l0 rx cat st - -and loop_pref s i l l0 rx cat st = - let rec loop i l0 st = - let c = Array.unsafe_get cat (Char.code (String.unsafe_get s i)) in - let st' = Array.unsafe_get st.next c in - if st'.valid then begin - let i = i + 1 in - let l0 = if st'.final then i else l0 in - if i < l then - loop i l0 st' - else - l0 - end else if st' != unknown then - l0 - else - validate_pref s i l l0 rx cat st c - in - loop i l0 st - -let match_pref rx s p = - let l = String.length s in - if p < 0 || p > l then invalid_arg "Rx.rep"; - let l0 = if rx.initial.final then p else -1 in - let l0 = - if l = p then l0 else - loop_pref s p l l0 rx rx.categ rx.initial - in - if l0 >= 0 then Some (l0 - p) else None - -let mk_rx init categ ncat = - let states = ReTbl.create 97 in - { initial = find_state states ncat Pos_bol init; - categ = categ; - ncat = ncat; - states = states } - -(**** Character sets ****) - -let rec cunion l l' = - match l, l' with - _, [] -> l - | [], _ -> l' - | (c1, c2)::r, (c1', c2')::r' -> - if c2 + 1 < c1' then - (c1, c2)::cunion r l' - else if c2' + 1 < c1 then - (c1', c2')::cunion l r' - else if c2 < c2' then - cunion r ((min c1 c1', c2')::r') - else - cunion ((min c1 c1', c2)::r) r' - -let rec cinter l l' = - match l, l' with - _, [] -> [] - | [], _ -> [] - | (c1, c2)::r, (c1', c2')::r' -> - if c2 < c1' then - cinter r l' - else if c2' < c1 then - cinter l r' - else if c2 < c2' then - (max c1 c1', c2)::cinter r l' - else - (max c1 c1', c2')::cinter l r' - -let rec cnegate mi ma l = - match l with - [] -> - if mi <= ma then [(mi, ma)] else [] - | (c1, c2)::r when ma < c1 -> - if mi <= ma then [(mi, ma)] else [] - | (c1, c2)::r when mi < c1 -> - (mi, c1 - 1) :: cnegate c1 ma l - | (c1, c2)::r (* when c1 <= mi *) -> - cnegate (max mi (c2 + 1)) ma r - -let csingle c = let i = Char.code c in [i, i] - -let cadd c l = cunion (csingle c) l - -let cseq c c' = - let i = Char.code c in let i' = Char.code c' in - if i <= i' then [i, i'] else [i', i] - -let rec ctrans o l = - match l with - [] -> [] - | (c1, c2) :: r -> - if c2 + o < 0 || c1 + o > 255 then - ctrans o r - else - (c1 + o, c2 + o) :: ctrans o r - -let cany = [0, 255] - -type cset = (int * int) list - -(**** Compilation of a regular expression ****) - -type regexp = - Set of cset - | Sequence of regexp list - | Alternative of regexp list - | Repeat of regexp * int * int option - | Beg_of_line | End_of_line - | Intersection of regexp list - | Difference of regexp * regexp - -let rec split s cm = - match s with - [] -> () - | (i, j)::r -> cm.(i) <- true; cm.(j + 1) <- true; split r cm - -let rec colorize c regexp = - let rec colorize regexp = - match regexp with - Set s -> split s c - | Sequence l -> List.iter colorize l - | Alternative l -> List.iter colorize l - | Repeat (r, _, _) -> colorize r - | Beg_of_line | End_of_line -> split (csingle '\n') c - | Intersection l -> List.iter colorize l - | Difference (s, t) -> colorize s; colorize t - in - colorize regexp - -let make_cmap () = Array.make 257 false - -let flatten_cmap cm = - let c = Array.make 256 0 in - let v = ref 0 in - for i = 1 to 255 do - if cm.(i) then incr v; - c.(i) <- !v - done; - (c, !v + 1) - -let rec interval i j = if i > j then [] else i :: interval (i + 1) j - -let rec cset_hash_rec l = - match l with - [] -> 0 - | (i, j)::r -> i + 13 * j + 257 * cset_hash_rec r -let cset_hash l = (cset_hash_rec l) land 0x3FFFFFFF - -module CSetMap = - Map.Make - (struct - type t = int * (int * int) list - let compare (i, u) (j, v) = - let c = compare i j in if c <> 0 then c else compare u v - end) - -let trans_set cache cm s = - match s with - [i, j] when i = j -> - [cm.(i)] - | _ -> - let v = (cset_hash_rec s, s) in - try - CSetMap.find v !cache - with Not_found -> - let l = - List.fold_right (fun (i, j) l -> cunion [cm.(i), cm.(j)] l) s [] - in - let res = - List.flatten (List.map (fun (i, j) -> interval i j) l) - in - cache := CSetMap.add v res !cache; - res - -let rec trans_seq cache c r rem = - match r with - Sequence l -> List.fold_right (trans_seq cache c) l rem - | _ -> seq2 (translate cache c r) rem - -and translate cache c r = - match r with - Set s -> make (Cst (trans_set cache c s)) - | Alternative l -> alt (List.map (translate cache c) l) - | Sequence l -> trans_seq cache c r epsilon - | Repeat (r', i, j) -> rep (translate cache c r') i j - | Beg_of_line -> make Bol - | End_of_line -> make Eol - | Intersection l -> int (List.map (translate cache c) l) - | Difference (r', r'') -> dif (translate cache c r') (translate cache c r'') - -let compile regexp = - let c = make_cmap () in - colorize c regexp; - let (cat, ncat) = flatten_cmap c in - let r = translate (ref (CSetMap.empty)) cat regexp in - mk_rx r cat ncat - -(**** Regexp type ****) - -type t = {def : regexp; mutable comp: rx option; mutable comp': rx option} - -let force r = - match r.comp with - Some r' -> r' - | None -> let r' = compile r.def in r.comp <- Some r'; r' - -let anything = Repeat (Set [0, 255], 0, None) -let force' r = - match r.comp' with - Some r' -> r' - | None -> - let r1 = Sequence [anything; r.def; anything] in - let r' = compile r1 in r.comp' <- Some r'; r' - -let wrap r = {def = r; comp = None; comp' = None} -let def r = r.def - -let alt rl = wrap (Alternative (List.map def rl)) -let seq rl = wrap (Sequence (List.map def rl)) -let empty = alt [] -let epsilon = seq [] -let rep r i j = - if i < 0 then invalid_arg "Rx.rep"; - begin match j with Some j when j < i -> invalid_arg "Rx.rep" | _ -> () end; - wrap (Repeat (def r, i, j)) -let rep0 r = rep r 0 None -let rep1 r = rep r 1 None -let opt r = alt [epsilon; r] -let bol = wrap Beg_of_line -let eol = wrap End_of_line -let any = wrap (Set [0, 255]) -let notnl = wrap (Set (cnegate 0 255 (csingle '\n'))) -let inter rl = wrap (Intersection (List.map def rl)) -let diff r r' = wrap (Difference (def r, def r')) - -let set str = - let s = ref [] in - for i = 0 to String.length str - 1 do - s := cunion (csingle str.[i]) !s - done; - wrap (Set !s) - -let str s = - let l = ref [] in - for i = String.length s - 1 downto 0 do - l := Set (csingle s.[i]) :: !l - done; - wrap (Sequence !l) - -let match_string t s = match_str (force t) s -let match_substring t s = match_str (force' t) s -let match_prefix t s p = match_pref (force t) s p - -let uppercase = - cunion (cseq 'A' 'Z') (cunion (cseq '\192' '\214') (cseq '\216' '\222')) - -let lowercase = ctrans 32 uppercase - -let rec case_insens r = - match r with - Set s -> - Set (cunion s (cunion (ctrans 32 (cinter s uppercase)) - (ctrans (-32) (cinter s lowercase)))) - | Sequence l -> - Sequence (List.map case_insens l) - | Alternative l -> - Alternative (List.map case_insens l) - | Repeat (r, i, j) -> - Repeat (case_insens r, i, j) - | Beg_of_line | End_of_line -> - r - | Intersection l -> - Intersection (List.map case_insens l) - | Difference (r, r') -> - Difference (case_insens r, case_insens r') - -let case_insensitive r = - wrap (case_insens (def r)) - -(**** Parser ****) - -exception Parse_error -exception Not_supported - -let parse s = - let i = ref 0 in - let l = String.length s in - let eos () = !i = l in - let test c = not (eos ()) && s.[!i] = c in - let accept c = let r = test c in if r then incr i; r in - let get () = let r = s.[!i] in incr i; r in - let unget () = decr i in - - let rec regexp () = regexp' (branch ()) - and regexp' left = - if accept '|' then regexp' (Alternative [left; branch ()]) else left - and branch () = branch' (piece ()) - and branch' left = - if eos () || test '|' || test ')' then left - else branch' (Sequence [left; piece ()]) - and piece () = - let r = atom () in - if accept '*' then Repeat (r, 0, None) else - if accept '+' then Repeat (r, 1, None) else - if accept '?' then Alternative [Sequence []; r] else - if accept '{' then - match integer () with - Some i -> - let j = if accept ',' then integer () else Some i in - if not (accept '}') then raise Parse_error; - begin match j with - Some j when j < i -> raise Parse_error | _ -> () - end; - Repeat (r, i, j) - | None -> - unget (); r - else - r - and atom () = - if accept '.' then Set cany else - if accept '(' then begin - let r = regexp () in - if not (accept ')') then raise Parse_error; - r - end else - if accept '^' then Beg_of_line else - if accept '$' then End_of_line else - if accept '[' then begin - if accept '^' then - Set (cnegate 0 255 (bracket [])) - else - Set (bracket []) - end else - if accept '\\' then begin - if eos () then raise Parse_error; - match get () with - '|' | '(' | ')' | '*' | '+' | '?' - | '[' | '.' | '^' | '$' | '{' | '\\' as c -> Set (csingle c) - | _ -> raise Parse_error - end else begin - if eos () then raise Parse_error; - match get () with - '*' | '+' | '?' | '{' | '\\' -> raise Parse_error - | c -> Set (csingle c) - end - and integer () = - if eos () then None else - match get () with - '0'..'9' as d -> integer' (Char.code d - Char.code '0') - | _ -> unget (); None - and integer' i = - if eos () then Some i else - match get () with - '0'..'9' as d -> - let i' = 10 * i + (Char.code d - Char.code '0') in - if i' < i then raise Parse_error; - integer' i' - | _ -> - unget (); Some i - and bracket s = - if s <> [] && accept ']' then s else begin - let c = char () in - if accept '-' then begin - if accept ']' then (cadd c (cadd '-' s)) else begin - let c' = char () in - bracket (cunion (cseq c c') s) - end - end else - bracket (cadd c s) - end - and char () = - if eos () then raise Parse_error; - let c = get () in - if c = '[' then begin - if accept '=' || accept ':' then raise Not_supported; - if accept '.' then begin - if eos () then raise Parse_error; - let c = get () in - if not (accept '.') then raise Not_supported; - if not (accept ']') then raise Parse_error; - c - end else - c - end else - c - in - let res = regexp () in - if not (eos ()) then raise Parse_error; - res - -let rx s = wrap (parse s) - -(**** File globbing ****) - -let gany = cnegate 0 255 (csingle '/') -let notdot = cnegate 0 255 (cunion (csingle '.') (csingle '/')) -let dot = csingle '.' - -type loc = Beg | BegAny | Mid - -let beg_start = - Alternative [Sequence []; Sequence [Set notdot; Repeat (Set gany, 0, None)]] - -let beg_start' = - Sequence [Set notdot; Repeat (Set gany, 0, None)] - -let glob_parse init s = - let i = ref 0 in - let l = String.length s in - let eos () = !i = l in - let test c = not (eos ()) && s.[!i] = c in - let accept c = let r = test c in if r then incr i; r in - let get () = let r = s.[!i] in incr i; r in - (* let unget () = decr i in *) - - let rec expr () = expr' init (Sequence []) - and expr' beg left = - if eos () then - match beg with - Mid | Beg -> left - | BegAny -> Sequence [left; beg_start] - else - let (piec, beg) = piece beg in expr' beg (Sequence [left; piec]) - and piece beg = - if accept '*' then begin - if beg <> Mid then - (Sequence [], BegAny) - else - (Repeat (Set gany, 0, None), Mid) - end else if accept '?' then - (begin match beg with - Beg -> Set notdot - | BegAny -> Sequence [Set notdot; Repeat (Set gany, 0, None)] - | Mid -> Set gany - end, - Mid) - else if accept '[' then begin - (* let mask = if beg <> Mid then notdot else gany in *) - let set = - if accept '^' || accept '!' then - cnegate 0 255 (bracket []) - else - bracket [] - in - (begin match beg with - Beg -> Set (cinter notdot set) - | BegAny -> Alternative [Sequence [beg_start; Set (cinter notdot set)]; - Sequence [beg_start'; Set (cinter dot set)]] - | Mid -> Set (cinter gany set) - end, - Mid) - end else - let c = char () in - ((if beg <> BegAny then - Set (csingle c) - else if c = '.' then - Sequence [beg_start'; Set (csingle c)] - else - Sequence [beg_start; Set (csingle c)]), - if c = '/' then init else Mid) - and bracket s = - if s <> [] && accept ']' then s else begin - let c = char () in - if accept '-' then begin - if accept ']' then (cadd c (cadd '-' s)) else begin - let c' = char () in - bracket (cunion (cseq c c') s) - end - end else - bracket (cadd c s) - end - and char () = - ignore (accept '\\'); - if eos () then raise Parse_error; - get () - in - let res = expr () in - res - -let rec mul l l' = - List.flatten (List.map (fun s -> List.map (fun s' -> s ^ s') l') l) - -let explode str = - let l = String.length str in - let rec expl inner s i acc beg = - if i >= l then begin - if inner then raise Parse_error; - (mul beg [String.sub str s (i - s)], i) - end else - match str.[i] with - '\\' -> expl inner s (i + 2) acc beg - | '{' -> - let (t, i') = expl true (i + 1) (i + 1) [] [""] in - expl inner i' i' acc - (mul beg (mul [String.sub str s (i - s)] t)) - | ',' when inner -> - expl inner (i + 1) (i + 1) - (mul beg [String.sub str s (i - s)] @ acc) [""] - | '}' when inner -> - (mul beg [String.sub str s (i - s)] @ acc, i + 1) - | _ -> - expl inner s (i + 1) acc beg - in - List.rev (fst (expl false 0 0 [] [""])) - -let glob' nodot s = wrap (glob_parse (if nodot then Beg else Mid) s) -let glob s = glob' true s -let globx' nodot s = alt (List.map (glob' nodot) (explode s)) -let globx s = globx' true s Copied: branches/2.32/src/ubase/rx.ml (from rev 320, trunk/src/ubase/rx.ml) =================================================================== --- branches/2.32/src/ubase/rx.ml (rev 0) +++ branches/2.32/src/ubase/rx.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,834 @@ +(* Unison file synchronizer: src/ubase/rx.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + +(* + Inspired by some code and algorithms from Mark William Hopkins + (regexp.tar.gz, available in the comp.compilers file archive) +*) + +(* +Missing POSIX features +---------------------- +- Collating sequences +*) + +type v = + Cst of int list + | Alt of u list + | Seq of u list + | Rep of u * int * int option + | Bol | Eol + | Int of u list + | Dif of u * u + +and u = { desc : v; hash : int } + +(****) + +let hash x = + match x with + Cst l -> List.fold_left (fun h i -> h + 757 * i) 0 l + | Alt l -> 199 * List.fold_left (fun h y -> h + 883 * y.hash) 0 l + | Seq l -> 821 * List.fold_left (fun h y -> h + 883 * y.hash) 0 l + | Rep (y, i, Some j) -> 197 * y.hash + 137 * i + j + | Rep (y, i, None) -> 197 * y.hash + 137 * i + 552556457 + | Bol -> 165160782 + | Eol -> 152410806 + | Int l -> 71 * List.fold_left (fun h y -> h + 883 * y.hash) 0 l + | Dif (y, z) -> 379 * y.hash + 563 * z.hash + +let make x = {desc = x; hash = hash x} + +let epsilon = make (Seq []) +let empty = make (Alt []) + +(**** Printing ****) + +open Format + +let print_list sep print l = + match l with + [] -> () + | v::r -> print v; List.iter (fun v -> sep (); print v) r + +let rec print n t = + match t.desc with + Cst l -> + open_box 1; print_string "["; + print_list print_space print_int l; + print_string "]"; close_box () + | Alt tl -> + if n > 0 then begin open_box 1; print_string "(" end; + print_list (fun () -> print_string "|"; print_cut ()) (print 1) tl; + if n > 0 then begin print_string ")"; close_box () end + | Seq tl -> + if n > 1 then begin open_box 1; print_string "(" end; + print_list (fun () -> print_cut ()) (print 2) tl; + if n > 1 then begin print_string ")"; close_box () end + | Rep (t, 0, None) -> + print 2 t; print_string "*" + | Rep (t, i, None) -> + print 2 t; print_string "{"; print_int i; print_string ",}" + | Rep (t, i, Some j) -> + print 2 t; + print_string "{"; print_int i; print_string ","; + print_int j; print_string "}" + | _ -> assert false + +(**** Constructors for regular expressions *) + +let seq2 x y = + match x.desc, y.desc with + Alt [], _ | _, Alt [] -> empty + | Seq [], s -> y + | r, Seq [] -> x + | Seq r, Seq s -> make (Seq (r @ s)) + | Seq r, _ -> make (Seq (r @ [y])) + | _, Seq s -> make (Seq (x :: s)) + | r, s -> make (Seq [x; y]) + +let seq l = List.fold_right seq2 l epsilon + +let seq' l = match l with [] -> epsilon | [x] -> x | _ -> make (Seq l) + +let rec alt_merge r s = + match r, s with + [], _ -> s + | _, [] -> r + | {desc = Seq (x::m)} :: s, {desc = Seq (y::n)} :: r when x = y -> + alt_merge (seq2 x (alt2 (seq' m) (seq' n))::s) r + | x :: r', y :: s' -> + let c = compare x y in + if c = 0 then x :: alt_merge r' s' + else if c < 0 then x :: alt_merge r' s + else (* if c > 0 then *) y :: alt_merge r s' + +and alt2 x y = + let c = compare x y in + if c = 0 then x else + match x.desc, y.desc with + Alt [], _ -> y + | _, Alt [] -> x + | Alt r, Alt s -> make (Alt (alt_merge r s)) + | Alt [r], _ when r = y -> y + | _, Alt [s] when x = s -> x + | Alt r, _ -> make (Alt (alt_merge r [y])) + | _, Alt s -> make (Alt (alt_merge [x] s)) + | Seq (r::m), Seq (s::n) when r = s -> seq2 r (alt2 (seq' m) (seq' n)) + | _, _ -> make (if c < 0 then Alt [x; y] else Alt [y; x]) + +let alt l = List.fold_right alt2 l empty + +let rep x i j = + match x.desc with + Alt [] when i > 0 -> empty + | Alt [] | Seq [] -> epsilon + | _ -> + match i, j with + _, Some 0 -> epsilon + | 0, Some 1 -> alt2 epsilon x + | 1, Some 1 -> x + | _ -> make (Rep (x, i, j)) + +let rec int2 x y = + let c = compare x y in + if c = 0 then x else + match x.desc, y.desc with + Int [], _ -> y + | _, Int [] -> x + | Int r, Int s -> make (Int (alt_merge r s)) + | Int [r], _ when r = y -> y + | _, Int [s] when s = x -> x + | Int r, _ -> make (Int (alt_merge r [y])) + | _, Int s -> make (Int (alt_merge [x] s)) + | _, _ -> make (if c < 0 then Int [x; y] else Int [y; x]) + +let int l = List.fold_right int2 l empty + +let cst c = Cst [Char.code c] + +let rec dif x y = + if x = y then empty else + match x.desc, y.desc with + Dif (x1, y1), _ -> dif x1 (alt2 y1 y) + | Alt [], _ -> empty + | _, Alt [] -> x + | _ -> make (Dif (x, y)) + +(**** Computation of the next states of an automata ****) + +type pos = Pos_bol | Pos_other +let never = 0 +let always = (-1) +let when_eol = 2 + +let combine top bot op f l = + let rec combine v l = + match l with + [] -> v + | a::r -> + let c = f a in + if c = bot then c else combine (op v c) r + in + combine top l + +module ReTbl = + Hashtbl.Make + (struct + type t = u + let equal x y = x.hash = y.hash && x = y + let hash x = x.hash + end) + +let h = ReTbl.create 101 +let rec contains_epsilon pos x = +try ReTbl.find h x with Not_found -> +let res = + match x.desc with + Cst _ -> never + | Alt l -> combine never always (lor) (contains_epsilon pos) l + | Seq l -> combine always never (land) (contains_epsilon pos) l + | Rep (_, 0, _) -> always + | Rep (y, _, _) -> contains_epsilon pos y + | Bol -> if pos = Pos_bol then always else never + | Eol -> when_eol + | Int l -> combine always never (land) (contains_epsilon pos) l + | Dif (y, z) -> contains_epsilon pos y land + (lnot (contains_epsilon pos z)) +in +ReTbl.add h x res; res + +module DiffTbl = + Hashtbl.Make + (struct + type t = int * u + let equal ((c : int), x) (d, y) = c = d && x.hash = y.hash && x = y + let hash (c, x) = x.hash + 11 * c + end) + +let diff_cache = DiffTbl.create 101 + +let rec delta_seq nl pos c l = + match l with + [] -> + empty + | x::r -> + let rdx = seq2 (delta nl pos c x) (seq' r) in + let eps = contains_epsilon pos x in + if eps land always = always then + alt2 rdx (delta_seq nl pos c r) + else if eps land when_eol = when_eol && c = nl then + alt2 rdx (delta_seq nl pos c r) + else + rdx + +and delta nl pos c x = +let p = (c, x) in +try DiffTbl.find diff_cache p with Not_found -> +let res = + match x.desc with + Cst l -> if List.mem c l then epsilon else empty + | Alt l -> alt (List.map (delta nl pos c) l) + | Seq l -> delta_seq nl pos c l + | Rep (y, 0, None) -> seq2 (delta nl pos c y) x + | Rep (y, i, None) -> seq2 (delta nl pos c y) (rep y (i - 1) None) + | Rep (y, 0, Some j) -> seq2 (delta nl pos c y) (rep y 0 (Some (j - 1))) + | Rep (y, i, Some j) -> seq2 (delta nl pos c y) (rep y (i - 1) (Some (j-1))) + | Eol | Bol -> empty + | Int l -> int (List.map (delta nl pos c) l) + | Dif (y, z) -> dif (delta nl pos c y) (delta nl pos c z) +in +DiffTbl.add diff_cache p res; +res + +(**** String matching ****) + +type state = + { mutable valid : bool; + mutable next : state array; + pos : pos; + final : bool; + desc : u } + +type rx = + { initial : state; + categ : int array; + ncat : int; + states : state ReTbl.t } + +let unknown = + { valid = false; next = [||]; desc = empty ; pos = Pos_bol; final = false } + +let mk_state ncat pos desc = + { valid = desc <> empty; + next = Array.make ncat unknown; + pos = pos; + desc = desc; + final = contains_epsilon pos desc <> 0 } + +let find_state states ncat pos desc = + try + ReTbl.find states desc + with Not_found -> + let st = mk_state ncat pos desc in + ReTbl.add states desc st; + st + +let rec validate s i l rx cat st c = + let nl = cat.(Char.code '\n') in + let desc = delta nl st.pos c st.desc in + st.next.(c) <- + find_state rx.states rx.ncat (if c = nl then Pos_bol else Pos_other) desc; + loop s i l rx cat st + +and loop s i l rx cat st = + let rec loop i st = + let c = Array.unsafe_get cat (Char.code (String.unsafe_get s i)) in + let st' = Array.unsafe_get st.next c in + if st'.valid then begin + let i = i + 1 in + if i < l then + loop i st' + else + st'.final + end else if st' != unknown then + false + else + validate s i l rx cat st c + in + loop i st + +let match_str rx s = + let l = String.length s in + if l = 0 then rx.initial.final else + loop s 0 l rx rx.categ rx.initial + +(* Combining the final and valid fields may make things slightly faster + (one less memory access) *) +let rec validate_pref s i l l0 rx cat st c = + let nl = cat.(Char.code '\n') in + let desc = delta nl st.pos c st.desc in + st.next.(c) <- + find_state rx.states rx.ncat (if c = nl then Pos_bol else Pos_other) desc; + loop_pref s i l l0 rx cat st + +and loop_pref s i l l0 rx cat st = + let rec loop i l0 st = + let c = Array.unsafe_get cat (Char.code (String.unsafe_get s i)) in + let st' = Array.unsafe_get st.next c in + if st'.valid then begin + let i = i + 1 in + let l0 = if st'.final then i else l0 in + if i < l then + loop i l0 st' + else + l0 + end else if st' != unknown then + l0 + else + validate_pref s i l l0 rx cat st c + in + loop i l0 st + +let match_pref rx s p = + let l = String.length s in + if p < 0 || p > l then invalid_arg "Rx.rep"; + let l0 = if rx.initial.final then p else -1 in + let l0 = + if l = p then l0 else + loop_pref s p l l0 rx rx.categ rx.initial + in + if l0 >= 0 then Some (l0 - p) else None + +let mk_rx init categ ncat = + let states = ReTbl.create 97 in + { initial = find_state states ncat Pos_bol init; + categ = categ; + ncat = ncat; + states = states } + +(**** Character sets ****) + +let rec cunion l l' = + match l, l' with + _, [] -> l + | [], _ -> l' + | (c1, c2)::r, (c1', c2')::r' -> + if c2 + 1 < c1' then + (c1, c2)::cunion r l' + else if c2' + 1 < c1 then + (c1', c2')::cunion l r' + else if c2 < c2' then + cunion r ((min c1 c1', c2')::r') + else + cunion ((min c1 c1', c2)::r) r' + +let rec cinter l l' = + match l, l' with + _, [] -> [] + | [], _ -> [] + | (c1, c2)::r, (c1', c2')::r' -> + if c2 < c1' then + cinter r l' + else if c2' < c1 then + cinter l r' + else if c2 < c2' then + (max c1 c1', c2)::cinter r l' + else + (max c1 c1', c2')::cinter l r' + +let rec cnegate mi ma l = + match l with + [] -> + if mi <= ma then [(mi, ma)] else [] + | (c1, c2)::r when ma < c1 -> + if mi <= ma then [(mi, ma)] else [] + | (c1, c2)::r when mi < c1 -> + (mi, c1 - 1) :: cnegate c1 ma l + | (c1, c2)::r (* when c1 <= mi *) -> + cnegate (max mi (c2 + 1)) ma r + +let csingle c = let i = Char.code c in [i, i] + +let cadd c l = cunion (csingle c) l + +let cseq c c' = + let i = Char.code c in let i' = Char.code c' in + if i <= i' then [i, i'] else [i', i] + +let rec ctrans o l = + match l with + [] -> [] + | (c1, c2) :: r -> + if c2 + o < 0 || c1 + o > 255 then + ctrans o r + else + (c1 + o, c2 + o) :: ctrans o r + +let cany = [0, 255] + +type cset = (int * int) list + +(**** Compilation of a regular expression ****) + +type regexp = + Set of cset + | Sequence of regexp list + | Alternative of regexp list + | Repeat of regexp * int * int option + | Beg_of_line | End_of_line + | Intersection of regexp list + | Difference of regexp * regexp + +let rec split s cm = + match s with + [] -> () + | (i, j)::r -> cm.(i) <- true; cm.(j + 1) <- true; split r cm + +let rec colorize c regexp = + let rec colorize regexp = + match regexp with + Set s -> split s c + | Sequence l -> List.iter colorize l + | Alternative l -> List.iter colorize l + | Repeat (r, _, _) -> colorize r + | Beg_of_line | End_of_line -> split (csingle '\n') c + | Intersection l -> List.iter colorize l + | Difference (s, t) -> colorize s; colorize t + in + colorize regexp + +let make_cmap () = Array.make 257 false + +let flatten_cmap cm = + let c = Array.make 256 0 in + let v = ref 0 in + for i = 1 to 255 do + if cm.(i) then incr v; + c.(i) <- !v + done; + (c, !v + 1) + +let rec interval i j = if i > j then [] else i :: interval (i + 1) j + +let rec cset_hash_rec l = + match l with + [] -> 0 + | (i, j)::r -> i + 13 * j + 257 * cset_hash_rec r +let cset_hash l = (cset_hash_rec l) land 0x3FFFFFFF + +module CSetMap = + Map.Make + (struct + type t = int * (int * int) list + let compare (i, u) (j, v) = + let c = compare i j in if c <> 0 then c else compare u v + end) + +let trans_set cache cm s = + match s with + [i, j] when i = j -> + [cm.(i)] + | _ -> + let v = (cset_hash_rec s, s) in + try + CSetMap.find v !cache + with Not_found -> + let l = + List.fold_right (fun (i, j) l -> cunion [cm.(i), cm.(j)] l) s [] + in + let res = + List.flatten (List.map (fun (i, j) -> interval i j) l) + in + cache := CSetMap.add v res !cache; + res + +let rec trans_seq cache c r rem = + match r with + Sequence l -> List.fold_right (trans_seq cache c) l rem + | _ -> seq2 (translate cache c r) rem + +and translate cache c r = + match r with + Set s -> make (Cst (trans_set cache c s)) + | Alternative l -> alt (List.map (translate cache c) l) + | Sequence l -> trans_seq cache c r epsilon + | Repeat (r', i, j) -> rep (translate cache c r') i j + | Beg_of_line -> make Bol + | End_of_line -> make Eol + | Intersection l -> int (List.map (translate cache c) l) + | Difference (r', r'') -> dif (translate cache c r') (translate cache c r'') + +let compile regexp = + let c = make_cmap () in + colorize c regexp; + let (cat, ncat) = flatten_cmap c in + let r = translate (ref (CSetMap.empty)) cat regexp in + mk_rx r cat ncat + +(**** Regexp type ****) + +type t = {def : regexp; mutable comp: rx option; mutable comp': rx option} + +let force r = + match r.comp with + Some r' -> r' + | None -> let r' = compile r.def in r.comp <- Some r'; r' + +let anything = Repeat (Set [0, 255], 0, None) +let force' r = + match r.comp' with + Some r' -> r' + | None -> + let r1 = Sequence [anything; r.def; anything] in + let r' = compile r1 in r.comp' <- Some r'; r' + +let wrap r = {def = r; comp = None; comp' = None} +let def r = r.def + +let alt rl = wrap (Alternative (List.map def rl)) +let seq rl = wrap (Sequence (List.map def rl)) +let empty = alt [] +let epsilon = seq [] +let rep r i j = + if i < 0 then invalid_arg "Rx.rep"; + begin match j with Some j when j < i -> invalid_arg "Rx.rep" | _ -> () end; + wrap (Repeat (def r, i, j)) +let rep0 r = rep r 0 None +let rep1 r = rep r 1 None +let opt r = alt [epsilon; r] +let bol = wrap Beg_of_line +let eol = wrap End_of_line +let any = wrap (Set [0, 255]) +let notnl = wrap (Set (cnegate 0 255 (csingle '\n'))) +let inter rl = wrap (Intersection (List.map def rl)) +let diff r r' = wrap (Difference (def r, def r')) + +let set str = + let s = ref [] in + for i = 0 to String.length str - 1 do + s := cunion (csingle str.[i]) !s + done; + wrap (Set !s) + +let str s = + let l = ref [] in + for i = String.length s - 1 downto 0 do + l := Set (csingle s.[i]) :: !l + done; + wrap (Sequence !l) + +let match_string t s = match_str (force t) s +let match_substring t s = match_str (force' t) s +let match_prefix t s p = match_pref (force t) s p + +let uppercase = + cunion (cseq 'A' 'Z') (cunion (cseq '\192' '\214') (cseq '\216' '\222')) + +let lowercase = ctrans 32 uppercase + +let rec case_insens r = + match r with + Set s -> + Set (cunion s (cunion (ctrans 32 (cinter s uppercase)) + (ctrans (-32) (cinter s lowercase)))) + | Sequence l -> + Sequence (List.map case_insens l) + | Alternative l -> + Alternative (List.map case_insens l) + | Repeat (r, i, j) -> + Repeat (case_insens r, i, j) + | Beg_of_line | End_of_line -> + r + | Intersection l -> + Intersection (List.map case_insens l) + | Difference (r, r') -> + Difference (case_insens r, case_insens r') + +let case_insensitive r = + wrap (case_insens (def r)) + +(**** Parser ****) + +exception Parse_error +exception Not_supported + +let parse s = + let i = ref 0 in + let l = String.length s in + let eos () = !i = l in + let test c = not (eos ()) && s.[!i] = c in + let accept c = let r = test c in if r then incr i; r in + let get () = let r = s.[!i] in incr i; r in + let unget () = decr i in + + let rec regexp () = regexp' (branch ()) + and regexp' left = + if accept '|' then regexp' (Alternative [left; branch ()]) else left + and branch () = branch' (piece ()) + and branch' left = + if eos () || test '|' || test ')' then left + else branch' (Sequence [left; piece ()]) + and piece () = + let r = atom () in + if accept '*' then Repeat (r, 0, None) else + if accept '+' then Repeat (r, 1, None) else + if accept '?' then Alternative [Sequence []; r] else + if accept '{' then + match integer () with + Some i -> + let j = if accept ',' then integer () else Some i in + if not (accept '}') then raise Parse_error; + begin match j with + Some j when j < i -> raise Parse_error | _ -> () + end; + Repeat (r, i, j) + | None -> + unget (); r + else + r + and atom () = + if accept '.' then Set cany else + if accept '(' then begin + let r = regexp () in + if not (accept ')') then raise Parse_error; + r + end else + if accept '^' then Beg_of_line else + if accept '$' then End_of_line else + if accept '[' then begin + if accept '^' then + Set (cnegate 0 255 (bracket [])) + else + Set (bracket []) + end else + if accept '\\' then begin + if eos () then raise Parse_error; + match get () with + '|' | '(' | ')' | '*' | '+' | '?' + | '[' | '.' | '^' | '$' | '{' | '\\' as c -> Set (csingle c) + | _ -> raise Parse_error + end else begin + if eos () then raise Parse_error; + match get () with + '*' | '+' | '?' | '{' | '\\' -> raise Parse_error + | c -> Set (csingle c) + end + and integer () = + if eos () then None else + match get () with + '0'..'9' as d -> integer' (Char.code d - Char.code '0') + | _ -> unget (); None + and integer' i = + if eos () then Some i else + match get () with + '0'..'9' as d -> + let i' = 10 * i + (Char.code d - Char.code '0') in + if i' < i then raise Parse_error; + integer' i' + | _ -> + unget (); Some i + and bracket s = + if s <> [] && accept ']' then s else begin + let c = char () in + if accept '-' then begin + if accept ']' then (cadd c (cadd '-' s)) else begin + let c' = char () in + bracket (cunion (cseq c c') s) + end + end else + bracket (cadd c s) + end + and char () = + if eos () then raise Parse_error; + let c = get () in + if c = '[' then begin + if accept '=' || accept ':' then raise Not_supported; + if accept '.' then begin + if eos () then raise Parse_error; + let c = get () in + if not (accept '.') then raise Not_supported; + if not (accept ']') then raise Parse_error; + c + end else + c + end else + c + in + let res = regexp () in + if not (eos ()) then raise Parse_error; + res + +let rx s = wrap (parse s) + +(**** File globbing ****) + +let gany = cnegate 0 255 (csingle '/') +let notdot = cnegate 0 255 (cunion (csingle '.') (csingle '/')) +let dot = csingle '.' + +type loc = Beg | BegAny | Mid + +let beg_start = + Alternative [Sequence []; Sequence [Set notdot; Repeat (Set gany, 0, None)]] + +let beg_start' = + Sequence [Set notdot; Repeat (Set gany, 0, None)] + +let glob_parse init s = + let i = ref 0 in + let l = String.length s in + let eos () = !i = l in + let test c = not (eos ()) && s.[!i] = c in + let accept c = let r = test c in if r then incr i; r in + let get () = let r = s.[!i] in incr i; r in + (* let unget () = decr i in *) + + let rec expr () = expr' init (Sequence []) + and expr' beg left = + if eos () then + match beg with + Mid | Beg -> left + | BegAny -> Sequence [left; beg_start] + else + let (piec, beg) = piece beg in expr' beg (Sequence [left; piec]) + and piece beg = + if accept '*' then begin + if beg <> Mid then + (Sequence [], BegAny) + else + (Repeat (Set gany, 0, None), Mid) + end else if accept '?' then + (begin match beg with + Beg -> Set notdot + | BegAny -> Sequence [Set notdot; Repeat (Set gany, 0, None)] + | Mid -> Set gany + end, + Mid) + else if accept '[' then begin + (* let mask = if beg <> Mid then notdot else gany in *) + let set = + if accept '^' || accept '!' then + cnegate 0 255 (bracket []) + else + bracket [] + in + (begin match beg with + Beg -> Set (cinter notdot set) + | BegAny -> Alternative [Sequence [beg_start; Set (cinter notdot set)]; + Sequence [beg_start'; Set (cinter dot set)]] + | Mid -> Set (cinter gany set) + end, + Mid) + end else + let c = char () in + ((if beg <> BegAny then + Set (csingle c) + else if c = '.' then + Sequence [beg_start'; Set (csingle c)] + else + Sequence [beg_start; Set (csingle c)]), + if c = '/' then init else Mid) + and bracket s = + if s <> [] && accept ']' then s else begin + let c = char () in + if accept '-' then begin + if accept ']' then (cadd c (cadd '-' s)) else begin + let c' = char () in + bracket (cunion (cseq c c') s) + end + end else + bracket (cadd c s) + end + and char () = + ignore (accept '\\'); + if eos () then raise Parse_error; + get () + in + let res = expr () in + res + +let rec mul l l' = + List.flatten (List.map (fun s -> List.map (fun s' -> s ^ s') l') l) + +let explode str = + let l = String.length str in + let rec expl inner s i acc beg = + if i >= l then begin + if inner then raise Parse_error; + (mul beg [String.sub str s (i - s)], i) + end else + match str.[i] with + '\\' -> expl inner s (i + 2) acc beg + | '{' -> + let (t, i') = expl true (i + 1) (i + 1) [] [""] in + expl inner i' i' acc + (mul beg (mul [String.sub str s (i - s)] t)) + | ',' when inner -> + expl inner (i + 1) (i + 1) + (mul beg [String.sub str s (i - s)] @ acc) [""] + | '}' when inner -> + (mul beg [String.sub str s (i - s)] @ acc, i + 1) + | _ -> + expl inner s (i + 1) acc beg + in + List.rev (fst (expl false 0 0 [] [""])) + +let glob' nodot s = wrap (glob_parse (if nodot then Beg else Mid) s) +let glob s = glob' true s +let globx' nodot s = alt (List.map (glob' nodot) (explode s)) +let globx s = globx' true s Deleted: branches/2.32/src/ubase/rx.mli =================================================================== --- trunk/src/ubase/rx.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/ubase/rx.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,55 +0,0 @@ -(* Unison file synchronizer: src/ubase/rx.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -type t - -(* Posix regular expression *) -val rx : string -> t - -(* File globbing *) -val glob : string -> t -val glob' : bool -> string -> t - (* Same, but allows to choose whether dots at the beginning of a - file name need to be explicitly matched (true) or not (false) *) -val globx : string -> t -val globx' : bool -> string -> t - (* These two functions also recognize the pattern {...} *) - -(* String expression (literal match) *) -val str : string -> t - -(* Operations on regular expressions *) -val alt : t list -> t (* Alternative *) -val seq : t list -> t (* Sequence *) -val empty : t (* Match nothing *) -val epsilon : t (* Empty word *) -val rep : t -> int -> int option -> t (* Repeated matches *) -val rep0 : t -> t (* 0 or more matches *) -val rep1 : t -> t (* 1 or more matches *) -val opt : t -> t (* 0 or 1 matches *) -val bol : t (* Beginning of line *) -val eol : t (* End of line *) -val any : t (* Any character *) -val notnl : t (* Any character but a newline *) -val set : string -> t (* Any character of the string *) -val inter : t list -> t (* All subexpressions must match *) -val diff : t -> t -> t (* The first expression matches - but not the second *) -val case_insensitive : t -> t (* Case insensitive matching *) - -(* Test whether a regular expression matches a string *) -val match_string : t -> string -> bool - -(* Test whether a regular expression matches a substring of the given - string *) -val match_substring : t -> string -> bool - -(* Test whether a regular expression matches some characters of a - string starting at a given position. Return the length of - the matched prefix. *) -val match_prefix : t -> string -> int -> int option - -(* Errors that can be raised during the parsing of Posix regular - expressions *) -exception Parse_error -exception Not_supported Copied: branches/2.32/src/ubase/rx.mli (from rev 320, trunk/src/ubase/rx.mli) =================================================================== --- branches/2.32/src/ubase/rx.mli (rev 0) +++ branches/2.32/src/ubase/rx.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,55 @@ +(* Unison file synchronizer: src/ubase/rx.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +type t + +(* Posix regular expression *) +val rx : string -> t + +(* File globbing *) +val glob : string -> t +val glob' : bool -> string -> t + (* Same, but allows to choose whether dots at the beginning of a + file name need to be explicitly matched (true) or not (false) *) +val globx : string -> t +val globx' : bool -> string -> t + (* These two functions also recognize the pattern {...} *) + +(* String expression (literal match) *) +val str : string -> t + +(* Operations on regular expressions *) +val alt : t list -> t (* Alternative *) +val seq : t list -> t (* Sequence *) +val empty : t (* Match nothing *) +val epsilon : t (* Empty word *) +val rep : t -> int -> int option -> t (* Repeated matches *) +val rep0 : t -> t (* 0 or more matches *) +val rep1 : t -> t (* 1 or more matches *) +val opt : t -> t (* 0 or 1 matches *) +val bol : t (* Beginning of line *) +val eol : t (* End of line *) +val any : t (* Any character *) +val notnl : t (* Any character but a newline *) +val set : string -> t (* Any character of the string *) +val inter : t list -> t (* All subexpressions must match *) +val diff : t -> t -> t (* The first expression matches + but not the second *) +val case_insensitive : t -> t (* Case insensitive matching *) + +(* Test whether a regular expression matches a string *) +val match_string : t -> string -> bool + +(* Test whether a regular expression matches a substring of the given + string *) +val match_substring : t -> string -> bool + +(* Test whether a regular expression matches some characters of a + string starting at a given position. Return the length of + the matched prefix. *) +val match_prefix : t -> string -> int -> int option + +(* Errors that can be raised during the parsing of Posix regular + expressions *) +exception Parse_error +exception Not_supported Deleted: branches/2.32/src/ubase/safelist.ml =================================================================== --- trunk/src/ubase/safelist.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/ubase/safelist.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,157 +0,0 @@ -(* Unison file synchronizer: src/ubase/safelist.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -let filterBoth f l = - let rec loop r1 r2 = function - [] -> (List.rev r1, List.rev r2) - | hd::tl -> - if f hd then loop (hd::r1) r2 tl - else loop r1 (hd::r2) tl - in loop [] [] l - -let filterMap f l = - let rec loop r = function - [] -> List.rev r - | hd::tl -> begin - match f hd with - None -> loop r tl - | Some x -> loop (x::r) tl - end - in loop [] l - -let filterMap2 f l = - let rec loop r s = function - [] -> List.rev r, List.rev s - | hd::tl -> begin - let (a, b) = f hd in - let r' = match a with None -> r | Some x -> x::r in - let s' = match b with None -> s | Some x -> x::s in - loop r' s' tl - end - in loop [] [] l - -(* These are tail-recursive versions of the standard ones from the - List module *) -let rec concat_rec accu = - function - [] -> List.rev accu - | l::r -> concat_rec (List.rev_append l accu) r -let concat l = concat_rec [] l -let flatten = concat - -let append l l' = - match l' with [] -> l | _ -> List.rev_append (List.rev l) l' - -let rev_map f l = - let rec rmap_f accu = function - | [] -> accu - | a::l -> rmap_f (f a :: accu) l - in - rmap_f [] l - -let map f l = List.rev (rev_map f l) - -let rev_map2 f l1 l2 = - let rec rmap2_f accu l1 l2 = - match (l1, l2) with - | ([], []) -> accu - | (a1::l1, a2::l2) -> rmap2_f (f a1 a2 :: accu) l1 l2 - | (_, _) -> invalid_arg "List.rev_map2" - in - rmap2_f [] l1 l2 -;; - -let map2 f l1 l2 = List.rev (rev_map2 f l1 l2) - -let rec allElementsEqual = function - [] -> true - | [a] -> true - | a::b::rest -> a=b && (allElementsEqual (b::rest)) - -let rec fold_left f accu l = - match l with - [] -> accu - | a::_ -> - (* We don't want l to be live when f is called *) - let l' = List.tl l in - fold_left f (f accu a) l' - -let split l = - let rec loop acc1 acc2 = function - [] -> (List.rev acc1, List.rev acc2) - | (x,y)::l -> loop (x::acc1) (y::acc2) l - in - loop [] [] l - -let rec transpose_rec accu l = - match l with - [] | []::_ -> - accu - | [x]::_ -> - (map (function [x] -> x | _ -> invalid_arg "Safelist.transpose") l)::accu - | _ -> - let (l0, r) = - fold_left - (fun (l0, r) l1 -> - match l1 with - [] -> invalid_arg "Safelist.transpose (2)" - | a::r1 -> (a::l0, r1::r)) - ([], []) l - in - transpose_rec ((List.rev l0)::accu) (List.rev r) - -let transpose l = List.rev (transpose_rec [] l) - -let combine l1 l2 = - let rec loop acc = function - ([], []) -> List.rev acc - | (a1::l1r, a2::l2r) -> loop ((a1, a2)::acc) (l1r,l2r) - | (_, _) -> invalid_arg "Util.combine" - in - loop [] (l1,l2) - -let remove_assoc x l = - let rec loop acc = function - | [] -> List.rev acc - | (a, b as pair) :: rest -> - if a = x then loop acc rest else loop (pair::acc) rest - in - loop [] l - -let fold_right f l accu = - fold_left (fun x y -> f y x) accu (List.rev l) - -let flatten_map f l = flatten (map f l) - -let remove x l = - let rec loop acc = function - | [] -> List.rev acc - | a :: rest -> - if a = x then loop acc rest else loop (a::acc) rest - in - loop [] l - -let iteri f l = - let rec loop n = function - | [] -> () - | h::t -> ((f n h); loop (n+1) t) - in loop 0 l - -(* These are already tail recursive in the List module *) -let iter = List.iter -let iter2 = List.iter2 -let rev = List.rev -let rev_append = List.rev_append -let hd = List.hd -let tl = List.tl -let nth = List.nth -let length = List.length -let mem = List.mem -let assoc = List.assoc -let for_all = List.for_all -let exists = List.exists -let find = List.find -let filter = List.filter -let stable_sort = List.stable_sort -let sort = List.sort -let partition = List.partition Copied: branches/2.32/src/ubase/safelist.ml (from rev 320, trunk/src/ubase/safelist.ml) =================================================================== --- branches/2.32/src/ubase/safelist.ml (rev 0) +++ branches/2.32/src/ubase/safelist.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,172 @@ +(* Unison file synchronizer: src/ubase/safelist.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +let filterBoth f l = + let rec loop r1 r2 = function + [] -> (List.rev r1, List.rev r2) + | hd::tl -> + if f hd then loop (hd::r1) r2 tl + else loop r1 (hd::r2) tl + in loop [] [] l + +let filterMap f l = + let rec loop r = function + [] -> List.rev r + | hd::tl -> begin + match f hd with + None -> loop r tl + | Some x -> loop (x::r) tl + end + in loop [] l + +let filterMap2 f l = + let rec loop r s = function + [] -> List.rev r, List.rev s + | hd::tl -> begin + let (a, b) = f hd in + let r' = match a with None -> r | Some x -> x::r in + let s' = match b with None -> s | Some x -> x::s in + loop r' s' tl + end + in loop [] [] l + +(* These are tail-recursive versions of the standard ones from the + List module *) +let rec concat_rec accu = + function + [] -> List.rev accu + | l::r -> concat_rec (List.rev_append l accu) r +let concat l = concat_rec [] l +let flatten = concat + +let append l l' = + match l' with [] -> l | _ -> List.rev_append (List.rev l) l' + +let rev_map f l = + let rec rmap_f accu = function + | [] -> accu + | a::l -> rmap_f (f a :: accu) l + in + rmap_f [] l + +let map f l = List.rev (rev_map f l) + +let rev_map2 f l1 l2 = + let rec rmap2_f accu l1 l2 = + match (l1, l2) with + | ([], []) -> accu + | (a1::l1, a2::l2) -> rmap2_f (f a1 a2 :: accu) l1 l2 + | (_, _) -> invalid_arg "List.rev_map2" + in + rmap2_f [] l1 l2 +;; + +let map2 f l1 l2 = List.rev (rev_map2 f l1 l2) + +let rec allElementsEqual = function + [] -> true + | [a] -> true + | a::b::rest -> a=b && (allElementsEqual (b::rest)) + +let rec fold_left f accu l = + match l with + [] -> accu + | a::_ -> + (* We don't want l to be live when f is called *) + let l' = List.tl l in + fold_left f (f accu a) l' + +let split l = + let rec loop acc1 acc2 = function + [] -> (List.rev acc1, List.rev acc2) + | (x,y)::l -> loop (x::acc1) (y::acc2) l + in + loop [] [] l + +let rec transpose_rec accu l = + match l with + [] | []::_ -> + accu + | [x]::_ -> + (map (function [x] -> x | _ -> invalid_arg "Safelist.transpose") l)::accu + | _ -> + let (l0, r) = + fold_left + (fun (l0, r) l1 -> + match l1 with + [] -> invalid_arg "Safelist.transpose (2)" + | a::r1 -> (a::l0, r1::r)) + ([], []) l + in + transpose_rec ((List.rev l0)::accu) (List.rev r) + +let transpose l = List.rev (transpose_rec [] l) + +let combine l1 l2 = + let rec loop acc = function + ([], []) -> List.rev acc + | (a1::l1r, a2::l2r) -> loop ((a1, a2)::acc) (l1r,l2r) + | (_, _) -> invalid_arg "Util.combine" + in + loop [] (l1,l2) + +let remove_assoc x l = + let rec loop acc = function + | [] -> List.rev acc + | (a, b as pair) :: rest -> + if a = x then loop acc rest else loop (pair::acc) rest + in + loop [] l + +let fold_right f l accu = + fold_left (fun x y -> f y x) accu (List.rev l) + +let flatten_map f l = flatten (map f l) + +let remove x l = + let rec loop acc = function + | [] -> List.rev acc + | a :: rest -> + if a = x then loop acc rest else loop (a::acc) rest + in + loop [] l + +let iteri f l = + let rec loop n = function + | [] -> () + | h::t -> ((f n h); loop (n+1) t) + in loop 0 l + +(* These are already tail recursive in the List module *) +let iter = List.iter +let iter2 = List.iter2 +let rev = List.rev +let rev_append = List.rev_append +let hd = List.hd +let tl = List.tl +let nth = List.nth +let length = List.length +let mem = List.mem +let assoc = List.assoc +let for_all = List.for_all +let exists = List.exists +let find = List.find +let filter = List.filter +let stable_sort = List.stable_sort +let sort = List.sort +let partition = List.partition Deleted: branches/2.32/src/ubase/safelist.mli =================================================================== --- trunk/src/ubase/safelist.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/ubase/safelist.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,46 +0,0 @@ -(* Unison file synchronizer: src/ubase/safelist.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* All functions here are tail recursive and will work for arbitrary - sized lists (unlike some of the standard ones). The intention is that - the built-in List module should not be referred to outside this module. *) - -(* Functions from built-in List module *) -val map : ('a -> 'b) -> 'a list -> 'b list -val rev_map : ('a -> 'b) -> 'a list -> 'b list -val append : 'a list -> 'a list -> 'a list -val rev_append : 'a list -> 'a list -> 'a list -val concat : 'a list list -> 'a list -val combine : 'a list -> 'b list -> ('a * 'b) list -val iter : ('a -> unit) -> 'a list -> unit -val iteri : (int -> 'a -> unit) -> 'a list -> unit (* zero-based *) -val rev : 'a list -> 'a list -val fold_right : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b -val hd : 'a list -> 'a -val tl : 'a list -> 'a list -val nth : 'a list -> int -> 'a -val length : 'a list -> int -val mem : 'a -> 'a list -> bool -val flatten : 'a list list -> 'a list -val assoc : 'a -> ('a * 'b) list -> 'b -val for_all : ('a -> bool) -> 'a list -> bool -val exists : ('a -> bool) -> 'a list -> bool -val split : ('a * 'b) list -> 'a list * 'b list -val find : ('a -> bool) -> 'a list -> 'a -val filter : ('a -> bool) -> 'a list -> 'a list -val partition : ('a -> bool) -> 'a list -> 'a list * 'a list -val remove_assoc : 'a -> ('a * 'b) list -> ('a * 'b) list -val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a -val map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list -val iter2 : ('a -> 'b -> unit) -> 'a list -> 'b list -> unit -val stable_sort : ('a -> 'a -> int) -> 'a list -> 'a list -val sort : ('a -> 'a -> int) -> 'a list -> 'a list - -(* Other useful list-processing functions *) -val filterMap : ('a -> 'b option) -> 'a list -> 'b list -val filterMap2 : ('a -> 'b option * 'c option) -> 'a list -> 'b list * 'c list -val transpose : 'a list list -> 'a list list -val filterBoth : ('a -> bool) -> 'a list -> ('a list * 'a list) -val allElementsEqual : 'a list -> bool -val flatten_map : ('a -> 'b list) -> 'a list -> 'b list -val remove : 'a -> 'a list -> 'a list Copied: branches/2.32/src/ubase/safelist.mli (from rev 320, trunk/src/ubase/safelist.mli) =================================================================== --- branches/2.32/src/ubase/safelist.mli (rev 0) +++ branches/2.32/src/ubase/safelist.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,46 @@ +(* Unison file synchronizer: src/ubase/safelist.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +(* All functions here are tail recursive and will work for arbitrary + sized lists (unlike some of the standard ones). The intention is that + the built-in List module should not be referred to outside this module. *) + +(* Functions from built-in List module *) +val map : ('a -> 'b) -> 'a list -> 'b list +val rev_map : ('a -> 'b) -> 'a list -> 'b list +val append : 'a list -> 'a list -> 'a list +val rev_append : 'a list -> 'a list -> 'a list +val concat : 'a list list -> 'a list +val combine : 'a list -> 'b list -> ('a * 'b) list +val iter : ('a -> unit) -> 'a list -> unit +val iteri : (int -> 'a -> unit) -> 'a list -> unit (* zero-based *) +val rev : 'a list -> 'a list +val fold_right : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b +val hd : 'a list -> 'a +val tl : 'a list -> 'a list +val nth : 'a list -> int -> 'a +val length : 'a list -> int +val mem : 'a -> 'a list -> bool +val flatten : 'a list list -> 'a list +val assoc : 'a -> ('a * 'b) list -> 'b +val for_all : ('a -> bool) -> 'a list -> bool +val exists : ('a -> bool) -> 'a list -> bool +val split : ('a * 'b) list -> 'a list * 'b list +val find : ('a -> bool) -> 'a list -> 'a +val filter : ('a -> bool) -> 'a list -> 'a list +val partition : ('a -> bool) -> 'a list -> 'a list * 'a list +val remove_assoc : 'a -> ('a * 'b) list -> ('a * 'b) list +val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a +val map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list +val iter2 : ('a -> 'b -> unit) -> 'a list -> 'b list -> unit +val stable_sort : ('a -> 'a -> int) -> 'a list -> 'a list +val sort : ('a -> 'a -> int) -> 'a list -> 'a list + +(* Other useful list-processing functions *) +val filterMap : ('a -> 'b option) -> 'a list -> 'b list +val filterMap2 : ('a -> 'b option * 'c option) -> 'a list -> 'b list * 'c list +val transpose : 'a list list -> 'a list list +val filterBoth : ('a -> bool) -> 'a list -> ('a list * 'a list) +val allElementsEqual : 'a list -> bool +val flatten_map : ('a -> 'b list) -> 'a list -> 'b list +val remove : 'a -> 'a list -> 'a list Deleted: branches/2.32/src/ubase/trace.ml =================================================================== --- trunk/src/ubase/trace.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/ubase/trace.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,239 +0,0 @@ -(* Unison file synchronizer: src/ubase/trace.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* ---------------------------------------------------------------------- *) -(* Choosing where messages go *) - -type trace_printer_choices = [`Stdout | `Stderr | `FormatStdout] - -let traceprinter = ref (`Stderr : trace_printer_choices) - -let redirect x = (traceprinter := x) - -(* ---------------------------------------------------------------------- *) -(* Debugging messages *) - -let debugmods = - Prefs.createStringList "debug" - "!debug module xxx ('all' -> everything, 'verbose' -> more)" - ("This preference is used to make Unison print various sorts of " - ^ "information about what it is doing internally on the standard " - ^ "error stream. It can be used many times, each time with the name " - ^ "of a module for which debugging information should be printed. " - ^ "Possible arguments for \\verb|debug| can be found " - ^ "by looking for calls to \\verb|Util.debug| in the " - ^ "sources (using, e.g., \\verb|grep|). " - ^ "Setting \\verb|-debug all| causes information from {\\em all} " - ^ "modules to be printed (this mode of usage is the first one to try, " - ^ "if you are trying to understand something that Unison seems to be " - ^ "doing wrong); \\verb|-debug verbose| turns on some additional " - ^ "debugging output from some modules (e.g., it will show exactly " - ^ "what bytes are being sent across the network).") - -let debugtimes = - Prefs.createBool "debugtimes" - false "*annotate debugging messages with timestamps" "" - -let runningasserver = ref false - -let debugging() = (Prefs.read debugmods) <> [] - -let enabled modname = - let m = Prefs.read debugmods in - let en = - m <> [] && ( (* tracing labeled "" is enabled if anything is *) - (modname = "") - || (* '-debug verbose' enables everything *) - (Safelist.mem "verbose" m) - || (* '-debug all+' likewise *) - (Safelist.mem "all+" m) - || (* '-debug all' enables all tracing not marked + *) - (Safelist.mem "all" m && not (Util.endswith modname "+")) - || (* '-debug m' enables m and '-debug m+' enables m+ *) - (Safelist.mem modname m) - || (* '-debug m+' also enables m *) - (Safelist.mem (modname ^ "+") m) - ) in - en - -let enable modname onoff = - let m = Prefs.read debugmods in - let m' = if onoff then (modname::m) else (Safelist.remove modname m) in - Prefs.set debugmods m' - -let debug modname thunk = - if enabled modname then begin - let s = if !runningasserver then "server: " else "" in - let time = - if Prefs.read debugtimes then - let tm = Util.localtime (Util.time()) in - Printf.sprintf "%02d:%02d:%02d" - tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec - else "" in - if time<>"" || s<>"" || modname<>"" then begin - let time = if time="" || (s=""&&modname="") then time else time^": " in - match !traceprinter with - | `Stdout -> Printf.printf "[%s%s%s] " time s modname - | `Stderr -> Printf.eprintf "[%s%s%s] " time s modname - | `FormatStdout -> Format.printf "[%s%s%s] " time s modname - end; - thunk(); - flush stderr - end - -(* We set the debugPrinter variable in the Util module so that other modules - lower down in the module dependency graph (so that they can't just - import Trace) can also print debugging messages. *) -let _ = Util.debugPrinter := Some(debug) - - -(* ---------------------------------------------------------------------- *) -(* Logging *) - -let logging = - Prefs.createBool "log" true - "!record actions in logfile" - "When this flag is set, Unison will log all changes to the filesystems - on a file." - -let logfile = - Prefs.createString "logfile" - (Util.fileInHomeDir "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 - you prefer another file." - -let logch = ref None - -let rec getLogch() = - Util.convertUnixErrorsToFatal "getLogch" (fun() -> - match !logch with - None -> - let file = Prefs.read logfile in - let ch = - open_out_gen [Open_wronly; Open_append; Open_creat] 0o600 file in - logch := Some (ch, file); - ch - | Some(ch, file) -> - if Prefs.read logfile = file then ch else begin - close_out ch; - logch := None; getLogch () - end) - -let sendLogMsgsToStderr = ref true - -let writeLog s = - if !sendLogMsgsToStderr then begin - match !traceprinter with - | `Stdout -> Printf.printf "%s" s - | `Stderr -> Util.msg "%s" s - | `FormatStdout -> Format.printf "%s " s - end else debug "" (fun() -> - match !traceprinter with - | `Stdout -> Printf.printf "%s" s - | `Stderr -> Util.msg "%s" s - | `FormatStdout -> Format.printf "%s " s); - if Prefs.read logging then begin - let ch = getLogch() in - output_string ch s; - flush ch - end - -(* ---------------------------------------------------------------------- *) -(* Formatting and displaying messages *) - -let terse = - Prefs.createBool "terse" false "suppress status messages" - ("When this preference is set to {\\tt true}, the user " - ^ "interface will not print status messages.") - -type msgtype = Msg | StatusMajor | StatusMinor | Log -type msg = msgtype * string - -let defaultMessageDisplayer s = - if not (Prefs.read terse) then begin - let show() = if s<>"" then Util.msg "%s\n" s in - if enabled "" then debug "" show - else if not !runningasserver then show() - end - -let messageDisplayer = ref defaultMessageDisplayer - -let defaultStatusFormatter s1 s2 = s1 ^ " " ^ s2 - -let statusFormatter = ref defaultStatusFormatter - -let statusMsgMajor = ref "" -let statusMsgMinor = ref "" - -let displayMessageLocally (mt,s) = - let display = !messageDisplayer in - let displayStatus() = - display (!statusFormatter !statusMsgMajor !statusMsgMinor) in - match mt with - Msg -> display s - | StatusMajor -> statusMsgMajor := s; statusMsgMinor := ""; displayStatus() - | StatusMinor -> statusMsgMinor := s; displayStatus() - | Log -> writeLog s - -let messageForwarder = ref None - -let displayMessage m = - match !messageForwarder with - None -> displayMessageLocally m - | Some(f) -> f m - -(* ---------------------------------------------------------------------- *) -(* Convenience functions for displaying various kinds of messages *) - -let message s = displayMessage (Msg, s) - -let status s = - displayMessage (StatusMajor, s) - -let statusMinor s = displayMessage (StatusMinor, s) - -let statusDetail s = - let ss = if not !runningasserver then s else (Util.padto 30 s) ^ " [server]" in - displayMessage (StatusMinor, ss) - -let log s = displayMessage (Log, s) - -let logverbose s = - let temp = !sendLogMsgsToStderr in - sendLogMsgsToStderr := !sendLogMsgsToStderr && not (Prefs.read terse); - displayMessage (Log, s); - sendLogMsgsToStderr := temp - -(* ---------------------------------------------------------------------- *) -(* Timing *) - -let printTimers = - Prefs.createBool "timers" false - "*print timing information" "" - -type timer = string * float - -let gettime () = Unix.gettimeofday() - -let startTimer desc = - if Prefs.read(printTimers) then - (message (desc ^ "..."); (desc, gettime())) - else - (desc,0.0) - -let startTimerQuietly desc = - if Prefs.read(printTimers) then - (desc, gettime()) - else - (desc,0.0) - -let showTimer (desc, t1) = - (* Showing timer values from the server process does not work at the moment: - it confuses the RPC mechanism *) - if not !runningasserver then - if Prefs.read(printTimers) then - let t2 = gettime() in - message (Printf.sprintf "%s (%.2f seconds)" desc (t2 -. t1)) - Copied: branches/2.32/src/ubase/trace.ml (from rev 320, trunk/src/ubase/trace.ml) =================================================================== --- branches/2.32/src/ubase/trace.ml (rev 0) +++ branches/2.32/src/ubase/trace.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,254 @@ +(* Unison file synchronizer: src/ubase/trace.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +(* ---------------------------------------------------------------------- *) +(* Choosing where messages go *) + +type trace_printer_choices = [`Stdout | `Stderr | `FormatStdout] + +let traceprinter = ref (`Stderr : trace_printer_choices) + +let redirect x = (traceprinter := x) + +(* ---------------------------------------------------------------------- *) +(* Debugging messages *) + +let debugmods = + Prefs.createStringList "debug" + "!debug module xxx ('all' -> everything, 'verbose' -> more)" + ("This preference is used to make Unison print various sorts of " + ^ "information about what it is doing internally on the standard " + ^ "error stream. It can be used many times, each time with the name " + ^ "of a module for which debugging information should be printed. " + ^ "Possible arguments for \\verb|debug| can be found " + ^ "by looking for calls to \\verb|Util.debug| in the " + ^ "sources (using, e.g., \\verb|grep|). " + ^ "Setting \\verb|-debug all| causes information from {\\em all} " + ^ "modules to be printed (this mode of usage is the first one to try, " + ^ "if you are trying to understand something that Unison seems to be " + ^ "doing wrong); \\verb|-debug verbose| turns on some additional " + ^ "debugging output from some modules (e.g., it will show exactly " + ^ "what bytes are being sent across the network).") + +let debugtimes = + Prefs.createBool "debugtimes" + false "*annotate debugging messages with timestamps" "" + +let runningasserver = ref false + +let debugging() = (Prefs.read debugmods) <> [] + +let enabled modname = + let m = Prefs.read debugmods in + let en = + m <> [] && ( (* tracing labeled "" is enabled if anything is *) + (modname = "") + || (* '-debug verbose' enables everything *) + (Safelist.mem "verbose" m) + || (* '-debug all+' likewise *) + (Safelist.mem "all+" m) + || (* '-debug all' enables all tracing not marked + *) + (Safelist.mem "all" m && not (Util.endswith modname "+")) + || (* '-debug m' enables m and '-debug m+' enables m+ *) + (Safelist.mem modname m) + || (* '-debug m+' also enables m *) + (Safelist.mem (modname ^ "+") m) + ) in + en + +let enable modname onoff = + let m = Prefs.read debugmods in + let m' = if onoff then (modname::m) else (Safelist.remove modname m) in + Prefs.set debugmods m' + +let debug modname thunk = + if enabled modname then begin + let s = if !runningasserver then "server: " else "" in + let time = + if Prefs.read debugtimes then + let tm = Util.localtime (Util.time()) in + Printf.sprintf "%02d:%02d:%02d" + tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec + else "" in + if time<>"" || s<>"" || modname<>"" then begin + let time = if time="" || (s=""&&modname="") then time else time^": " in + match !traceprinter with + | `Stdout -> Printf.printf "[%s%s%s] " time s modname + | `Stderr -> Printf.eprintf "[%s%s%s] " time s modname + | `FormatStdout -> Format.printf "[%s%s%s] " time s modname + end; + thunk(); + flush stderr + end + +(* We set the debugPrinter variable in the Util module so that other modules + lower down in the module dependency graph (so that they can't just + import Trace) can also print debugging messages. *) +let _ = Util.debugPrinter := Some(debug) + + +(* ---------------------------------------------------------------------- *) +(* Logging *) + +let logging = + Prefs.createBool "log" true + "!record actions in logfile" + "When this flag is set, Unison will log all changes to the filesystems + on a file." + +let logfile = + Prefs.createString "logfile" + (Util.fileInHomeDir "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 + you prefer another file." + +let logch = ref None + +let rec getLogch() = + Util.convertUnixErrorsToFatal "getLogch" (fun() -> + match !logch with + None -> + let file = Prefs.read logfile in + let ch = + open_out_gen [Open_wronly; Open_append; Open_creat] 0o600 file in + logch := Some (ch, file); + ch + | Some(ch, file) -> + if Prefs.read logfile = file then ch else begin + close_out ch; + logch := None; getLogch () + end) + +let sendLogMsgsToStderr = ref true + +let writeLog s = + if !sendLogMsgsToStderr then begin + match !traceprinter with + | `Stdout -> Printf.printf "%s" s + | `Stderr -> Util.msg "%s" s + | `FormatStdout -> Format.printf "%s " s + end else debug "" (fun() -> + match !traceprinter with + | `Stdout -> Printf.printf "%s" s + | `Stderr -> Util.msg "%s" s + | `FormatStdout -> Format.printf "%s " s); + if Prefs.read logging then begin + let ch = getLogch() in + output_string ch s; + flush ch + end + +(* ---------------------------------------------------------------------- *) +(* Formatting and displaying messages *) + +let terse = + Prefs.createBool "terse" false "suppress status messages" + ("When this preference is set to {\\tt true}, the user " + ^ "interface will not print status messages.") + +type msgtype = Msg | StatusMajor | StatusMinor | Log +type msg = msgtype * string + +let defaultMessageDisplayer s = + if not (Prefs.read terse) then begin + let show() = if s<>"" then Util.msg "%s\n" s in + if enabled "" then debug "" show + else if not !runningasserver then show() + end + +let messageDisplayer = ref defaultMessageDisplayer + +let defaultStatusFormatter s1 s2 = s1 ^ " " ^ s2 + +let statusFormatter = ref defaultStatusFormatter + +let statusMsgMajor = ref "" +let statusMsgMinor = ref "" + +let displayMessageLocally (mt,s) = + let display = !messageDisplayer in + let displayStatus() = + display (!statusFormatter !statusMsgMajor !statusMsgMinor) in + match mt with + Msg -> display s + | StatusMajor -> statusMsgMajor := s; statusMsgMinor := ""; displayStatus() + | StatusMinor -> statusMsgMinor := s; displayStatus() + | Log -> writeLog s + +let messageForwarder = ref None + +let displayMessage m = + match !messageForwarder with + None -> displayMessageLocally m + | Some(f) -> f m + +(* ---------------------------------------------------------------------- *) +(* Convenience functions for displaying various kinds of messages *) + +let message s = displayMessage (Msg, s) + +let status s = + displayMessage (StatusMajor, s) + +let statusMinor s = displayMessage (StatusMinor, s) + +let statusDetail s = + let ss = if not !runningasserver then s else (Util.padto 30 s) ^ " [server]" in + displayMessage (StatusMinor, ss) + +let log s = displayMessage (Log, s) + +let logverbose s = + let temp = !sendLogMsgsToStderr in + sendLogMsgsToStderr := !sendLogMsgsToStderr && not (Prefs.read terse); + displayMessage (Log, s); + sendLogMsgsToStderr := temp + +(* ---------------------------------------------------------------------- *) +(* Timing *) + +let printTimers = + Prefs.createBool "timers" false + "*print timing information" "" + +type timer = string * float + +let gettime () = Unix.gettimeofday() + +let startTimer desc = + if Prefs.read(printTimers) then + (message (desc ^ "..."); (desc, gettime())) + else + (desc,0.0) + +let startTimerQuietly desc = + if Prefs.read(printTimers) then + (desc, gettime()) + else + (desc,0.0) + +let showTimer (desc, t1) = + (* Showing timer values from the server process does not work at the moment: + it confuses the RPC mechanism *) + if not !runningasserver then + if Prefs.read(printTimers) then + let t2 = gettime() in + message (Printf.sprintf "%s (%.2f seconds)" desc (t2 -. t1)) + Deleted: branches/2.32/src/ubase/trace.mli =================================================================== --- trunk/src/ubase/trace.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/ubase/trace.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,109 +0,0 @@ -(* Unison file synchronizer: src/ubase/trace.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* ---------------------------------------------------------------------- *) -(* Debugging support *) - -(* Show a low-level debugging message. The first argument is the - name of the module from which the debugging message originates: this is - used to control which messages are printing (by looking at the value of - the 'debug' preference, a list of strings). The second argument is a - thunk that, if executed, should print the actual message to stderr. Note - that, since control of debugging depends on preferences, it is not possible - to see debugging output generated before the preferences have been - loaded. *) -val debug : string -> (unit->unit) -> unit - -val debugmods : string list Prefs.t - -(* Check whether a particular debugging flag is enabled *) -val enabled : string -> bool - -(* Enable/disable a particular flag *) -val enable : string -> bool -> unit - -(* When running in server mode, we use this ref to know to indicate this in - debugging messages *) -val runningasserver : bool ref - -(* Tell the Trace module which local stream to use for tracing and - debugging messages *) -val redirect : [`Stdout | `Stderr | `FormatStdout] -> unit - -(* ---------------------------------------------------------------------- *) -(* Tracing *) - -(* The function used to display a message on the machine where the - user is going to see it. The default value just prints the string - on stderr. The graphical user interface should install an - appropriate function here when it starts. In the server process, this - variable's value is ignored. *) -val messageDisplayer : (string -> unit) ref - -(* The function used to format a status message (with a major and a minor - part) into a string for display. Should be set by the user interface. *) -val statusFormatter : (string -> string -> string) ref - -(* The internal type of messages (it is exposed because it appears in the - types of the following) *) -type msg - -(* The internal routine used for formatting a message to be displayed - locally. It calls !messageDisplayer to do the actual work. *) -val displayMessageLocally : msg -> unit - -(* This can be set to function that should be used to get messages to - the machine where the user can see it, if we are running on some - other machine. (On the client machine, this variable's value is None. - On the server, it should be set to something that moves the message - across the network and then calls displayMessageLocally on the - client.) *) -val messageForwarder : (msg -> unit) option ref - -(* Allow outside access to the logging preference, so that the main program - can turn it off by default *) -val logging : bool Prefs.t - -(* ---------------------------------------------------------------------- *) -(* Messages *) - -(* Suppress all message printing *) -val terse - : bool Prefs.t - -(* Show a string to the user. *) -val message : string -> unit - -(* Show a change of "top-level" status (what phase we're in) *) -val status : string -> unit - -(* Show a change of "detail" status (what file we're working on) *) -val statusMinor : string -> unit - -(* Show a change of "detail" status unless we want to avoid generating - too much output (e.g. because we're using the text ui) *) -val statusDetail : string -> unit - -(* Write a message just to the log file (no extra '\n' will be added: include - one explicitly if you want one) *) -val log : string -> unit - -(* Like 'log', but only send message to log file if -terse preference is set *) -val logverbose : string -> unit - -(* When set to true (default), log messages will also be printed to stderr *) -val sendLogMsgsToStderr : bool ref - -(* ---------------------------------------------------------------------- *) -(* Timers (for performance measurements during development) *) - -type timer - -(* Create a new timer, print a description, and start it ticking *) -val startTimer : string -> timer - -(* Create a new timer without printing a description *) -val startTimerQuietly : string -> timer - -(* Display the current time on a timer (and its description) *) -val showTimer : timer -> unit Copied: branches/2.32/src/ubase/trace.mli (from rev 320, trunk/src/ubase/trace.mli) =================================================================== --- branches/2.32/src/ubase/trace.mli (rev 0) +++ branches/2.32/src/ubase/trace.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,109 @@ +(* Unison file synchronizer: src/ubase/trace.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +(* ---------------------------------------------------------------------- *) +(* Debugging support *) + +(* Show a low-level debugging message. The first argument is the + name of the module from which the debugging message originates: this is + used to control which messages are printing (by looking at the value of + the 'debug' preference, a list of strings). The second argument is a + thunk that, if executed, should print the actual message to stderr. Note + that, since control of debugging depends on preferences, it is not possible + to see debugging output generated before the preferences have been + loaded. *) +val debug : string -> (unit->unit) -> unit + +val debugmods : string list Prefs.t + +(* Check whether a particular debugging flag is enabled *) +val enabled : string -> bool + +(* Enable/disable a particular flag *) +val enable : string -> bool -> unit + +(* When running in server mode, we use this ref to know to indicate this in + debugging messages *) +val runningasserver : bool ref + +(* Tell the Trace module which local stream to use for tracing and + debugging messages *) +val redirect : [`Stdout | `Stderr | `FormatStdout] -> unit + +(* ---------------------------------------------------------------------- *) +(* Tracing *) + +(* The function used to display a message on the machine where the + user is going to see it. The default value just prints the string + on stderr. The graphical user interface should install an + appropriate function here when it starts. In the server process, this + variable's value is ignored. *) +val messageDisplayer : (string -> unit) ref + +(* The function used to format a status message (with a major and a minor + part) into a string for display. Should be set by the user interface. *) +val statusFormatter : (string -> string -> string) ref + +(* The internal type of messages (it is exposed because it appears in the + types of the following) *) +type msg + +(* The internal routine used for formatting a message to be displayed + locally. It calls !messageDisplayer to do the actual work. *) +val displayMessageLocally : msg -> unit + +(* This can be set to function that should be used to get messages to + the machine where the user can see it, if we are running on some + other machine. (On the client machine, this variable's value is None. + On the server, it should be set to something that moves the message + across the network and then calls displayMessageLocally on the + client.) *) +val messageForwarder : (msg -> unit) option ref + +(* Allow outside access to the logging preference, so that the main program + can turn it off by default *) +val logging : bool Prefs.t + +(* ---------------------------------------------------------------------- *) +(* Messages *) + +(* Suppress all message printing *) +val terse + : bool Prefs.t + +(* Show a string to the user. *) +val message : string -> unit + +(* Show a change of "top-level" status (what phase we're in) *) +val status : string -> unit + +(* Show a change of "detail" status (what file we're working on) *) +val statusMinor : string -> unit + +(* Show a change of "detail" status unless we want to avoid generating + too much output (e.g. because we're using the text ui) *) +val statusDetail : string -> unit + +(* Write a message just to the log file (no extra '\n' will be added: include + one explicitly if you want one) *) +val log : string -> unit + +(* Like 'log', but only send message to log file if -terse preference is set *) +val logverbose : string -> unit + +(* When set to true (default), log messages will also be printed to stderr *) +val sendLogMsgsToStderr : bool ref + +(* ---------------------------------------------------------------------- *) +(* Timers (for performance measurements during development) *) + +type timer + +(* Create a new timer, print a description, and start it ticking *) +val startTimer : string -> timer + +(* Create a new timer without printing a description *) +val startTimerQuietly : string -> timer + +(* Display the current time on a timer (and its description) *) +val showTimer : timer -> unit Deleted: branches/2.32/src/ubase/uarg.ml =================================================================== --- trunk/src/ubase/uarg.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/ubase/uarg.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,112 +0,0 @@ -(* Unison file synchronizer: src/ubase/uarg.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* by Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* Slightly modified by BCP, July 1999 *) - -type spec = - | Unit of (unit -> unit) (* Call the function with unit argument *) - | Set of bool ref (* Set the reference to true *) - | Clear of bool ref (* Set the reference to false *) - | Bool of (bool -> unit) (* Pass true to the function *) - | String of (string -> unit) (* Call the function with a string argument *) - | Int of (int -> unit) (* Call the function with an int argument *) - | Float of (float -> unit) (* Call the function with a float argument *) - | Rest of (string -> unit) (* Stop interpreting keywords and call the - function with each remaining argument *) - -exception Bad of string - -type error = - | Unknown of string - | Wrong of string * string * string (* option, actual, expected *) - | Missing of string - | Message of string - -open Printf - -let rec assoc3 x l = - match l with - | [] -> raise Not_found - | (y1, y2, y3)::t when y1 = x -> y2 - | _::t -> assoc3 x t -;; - -let usage speclist errmsg = - printf "%s\n" errmsg; - Safelist.iter - (function (key, _, doc) -> - if String.length doc > 0 && doc.[0] <> '*' - then printf " %s %s\n" key doc) - (Safelist.rev speclist) -;; - -let current = ref 0;; - -let parse speclist anonfun errmsg = - let initpos = !current in - let stop error = - let progname = - if initpos < Array.length Sys.argv then Sys.argv.(initpos) else "(?)" in - begin match error with - | Unknown s when s = "-help" -> () - | Unknown s -> - eprintf "%s: unknown option `%s'.\n" progname s - | Missing s -> - eprintf "%s: option `%s' needs an argument.\n" progname s - | Wrong (opt, arg, expected) -> - eprintf "%s: wrong argument `%s'; option `%s' expects %s.\n" - progname arg opt expected - | Message s -> - eprintf "%s: %s.\n" progname s - end; - usage speclist errmsg; - exit 2; - in - let l = Array.length Sys.argv in - incr current; - while !current < l do - let ss = Sys.argv.(!current) in - if String.length ss >= 1 & String.get ss 0 = '-' then begin - let args = Util.splitIntoWords ss '=' in - let s = Safelist.nth args 0 in - let arg conv mesg = - match args with - [_] -> - if !current + 1 >= l then stop (Missing s) else - let a = Sys.argv.(!current+1) in - incr current; - (try conv a with Failure _ -> stop (Wrong (s, a, mesg))) - | [_;a] -> (try conv a with Failure _ -> stop (Wrong (s, a, mesg))) - | _ -> stop (Message (sprintf "Garbled argument %s" s)) in - let action = - try assoc3 s speclist - with Not_found -> stop (Unknown s) - in - begin try - match action with - | Unit f -> f (); - | Set r -> r := true; - | Clear r -> r := false; - | Bool f -> - begin match args with - [_] -> f true - | _ -> f (arg bool_of_string "a boolean") - end - | String f -> f (arg (fun s-> s) "") - | Int f -> f (arg int_of_string "an integer") - | Float f -> f (arg float_of_string "a float") - | Rest f -> - while !current < l-1 do - f Sys.argv.(!current+1); - incr current; - done; - with Bad m -> stop (Message m); - end; - incr current; - end else begin - (try anonfun ss with Bad m -> stop (Message m)); - incr current; - end; - done; -;; Copied: branches/2.32/src/ubase/uarg.ml (from rev 320, trunk/src/ubase/uarg.ml) =================================================================== --- branches/2.32/src/ubase/uarg.ml (rev 0) +++ branches/2.32/src/ubase/uarg.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,112 @@ +(* Unison file synchronizer: src/ubase/uarg.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +(* by Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* Slightly modified by BCP, July 1999 *) + +type spec = + | Unit of (unit -> unit) (* Call the function with unit argument *) + | Set of bool ref (* Set the reference to true *) + | Clear of bool ref (* Set the reference to false *) + | Bool of (bool -> unit) (* Pass true to the function *) + | String of (string -> unit) (* Call the function with a string argument *) + | Int of (int -> unit) (* Call the function with an int argument *) + | Float of (float -> unit) (* Call the function with a float argument *) + | Rest of (string -> unit) (* Stop interpreting keywords and call the + function with each remaining argument *) + +exception Bad of string + +type error = + | Unknown of string + | Wrong of string * string * string (* option, actual, expected *) + | Missing of string + | Message of string + +open Printf + +let rec assoc3 x l = + match l with + | [] -> raise Not_found + | (y1, y2, y3)::t when y1 = x -> y2 + | _::t -> assoc3 x t +;; + +let usage speclist errmsg = + printf "%s\n" errmsg; + Safelist.iter + (function (key, _, doc) -> + if String.length doc > 0 && doc.[0] <> '*' + then printf " %s %s\n" key doc) + (Safelist.rev speclist) +;; + +let current = ref 0;; + +let parse speclist anonfun errmsg = + let initpos = !current in + let stop error = + let progname = + if initpos < Array.length Sys.argv then Sys.argv.(initpos) else "(?)" in + begin match error with + | Unknown s when s = "-help" -> () + | Unknown s -> + eprintf "%s: unknown option `%s'.\n" progname s + | Missing s -> + eprintf "%s: option `%s' needs an argument.\n" progname s + | Wrong (opt, arg, expected) -> + eprintf "%s: wrong argument `%s'; option `%s' expects %s.\n" + progname arg opt expected + | Message s -> + eprintf "%s: %s.\n" progname s + end; + usage speclist errmsg; + exit 2; + in + let l = Array.length Sys.argv in + incr current; + while !current < l do + let ss = Sys.argv.(!current) in + if String.length ss >= 1 & String.get ss 0 = '-' then begin + let args = Util.splitIntoWords ss '=' in + let s = Safelist.nth args 0 in + let arg conv mesg = + match args with + [_] -> + if !current + 1 >= l then stop (Missing s) else + let a = Sys.argv.(!current+1) in + incr current; + (try conv a with Failure _ -> stop (Wrong (s, a, mesg))) + | [_;a] -> (try conv a with Failure _ -> stop (Wrong (s, a, mesg))) + | _ -> stop (Message (sprintf "Garbled argument %s" s)) in + let action = + try assoc3 s speclist + with Not_found -> stop (Unknown s) + in + begin try + match action with + | Unit f -> f (); + | Set r -> r := true; + | Clear r -> r := false; + | Bool f -> + begin match args with + [_] -> f true + | _ -> f (arg bool_of_string "a boolean") + end + | String f -> f (arg (fun s-> s) "") + | Int f -> f (arg int_of_string "an integer") + | Float f -> f (arg float_of_string "a float") + | Rest f -> + while !current < l-1 do + f Sys.argv.(!current+1); + incr current; + done; + with Bad m -> stop (Message m); + end; + incr current; + end else begin + (try anonfun ss with Bad m -> stop (Message m)); + incr current; + end; + done; +;; Deleted: branches/2.32/src/ubase/util.ml =================================================================== --- trunk/src/ubase/util.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/ubase/util.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,438 +0,0 @@ -(* Unison file synchronizer: src/ubase/util.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(*****************************************************************************) -(* CASE INSENSITIVE COMPARISON *) -(*****************************************************************************) -let nocase_cmp a b = - let alen = String.length a in - let blen = String.length b in - let minlen = if alen=minlen then compare alen blen - else - let c = - compare (Char.lowercase(String.get a i)) (Char.lowercase(String.get b i)) in - if c<>0 then c else loop (i+1) in - loop 0 -let nocase_eq a b = (0 = (nocase_cmp a b)) - - -(*****************************************************************************) -(* PRE-BUILT MAP AND SET MODULES *) -(*****************************************************************************) - -module StringMap = - Map.Make(struct - type t = string - let compare = compare - end) - -module StringSet = - Set.Make(struct - type t = string - let compare = compare - end) - -let stringSetFromList l = - Safelist.fold_right StringSet.add l StringSet.empty - -(*****************************************************************************) -(* Debugging / error messages *) -(*****************************************************************************) - -let infos = ref "" - -let clear_infos () = - if !infos <> "" then begin - print_string "\r"; - print_string (String.make (String.length !infos) ' '); - print_string "\r"; - flush stdout - end -let show_infos () = - if !infos <> "" then begin print_string !infos; flush stdout end -let set_infos s = - if s <> !infos then begin clear_infos (); infos := s; show_infos () end - -let msg f = - clear_infos (); Uprintf.eprintf (fun () -> flush stderr; show_infos ()) f - -let msg : ('a, out_channel, unit) format -> 'a = msg - -(* ------------- Formatting stuff --------------- *) - -let curr_formatter = ref Format.std_formatter - -let format f = Format.fprintf (!curr_formatter) f -let format : ('a, Format.formatter, unit) format -> 'a = format - -let format_to_string f = - let old_formatter = !curr_formatter in - curr_formatter := Format.str_formatter; - f (); - let s = Format.flush_str_formatter () in - curr_formatter := old_formatter; - s - -let flush () = Format.pp_print_flush (!curr_formatter) () - -(*****************************************************************************) -(* GLOBAL DEBUGGING SWITCH *) -(*****************************************************************************) - -let debugPrinter = ref None - -let debug s th = - match !debugPrinter with - None -> assert false - | Some p -> p s th - -(* This should be set by the UI to a function that can be used to warn users *) -let warnPrinter = ref None - -(* The rest of the program invokes this function to warn users. *) -let warn message = - match !warnPrinter with - None -> () - | Some p -> p message - -(*****************************************************************************) -(* EXCEPTION HANDLING *) -(*****************************************************************************) - -exception Fatal of string -exception Transient of string - -let encodeException m kind e = - let reraise s = - match kind with - `Fatal -> raise (Fatal s) - | `Transient -> raise (Transient s) - in - let kindStr = - match kind with - `Fatal -> "Fatal" - | `Transient -> "Transient" - in - match e with - Unix.Unix_error(err,fnname,param) -> - let s = "Error in " ^ m ^ ":\n" - ^ (Unix.error_message err) - ^ " [" ^ fnname ^ "(" ^ param ^ ")]" in - debug "exn" - (fun() -> msg "Converting a Unix error to %s:\n%s\n" kindStr s); - reraise s - | Transient(s) -> - debug "exn" (fun() -> - if kind = `Fatal then - msg "In %s: Converting a Transient error to %s:\n%s\n" m kindStr s - else - msg "In %s: Propagating Transient error\n" m); - reraise s - | Not_found -> - let s = "Not_found raised in " ^ m - ^ " (this indicates a bug!)" in - debug "exn" - (fun() -> msg "Converting a Not_found to %s:\n%s\n" kindStr s); - reraise s - | Invalid_argument a -> - let s = "Invalid_argument("^a^") raised in " ^ m - ^ " (this indicates a bug!)" in - debug "exn" - (fun() -> msg "Converting an Invalid_argument to %s:\n%s\n" kindStr s); - reraise s - | Sys_error(s) -> - let s = "Error in " ^ m ^ ":\n" ^ s in - debug "exn" - (fun() -> msg "Converting a Sys_error to %s:\n%s\n" kindStr s); - reraise s - | Sys_blocked_io -> - let s = "Blocked IO error in " ^ m in - debug "exn" - (fun() -> msg "Converting a Sys_blocked_io to %s:\n%s\n" kindStr s); - reraise s - | _ -> - raise e - -let convertUnixErrorsToExn m f n e = - try f() - with - Unix.Unix_error(err,fnname,param) -> - let s = "Error in " ^ m ^ ":\n" - ^ (Unix.error_message err) - ^ " [" ^ fnname ^ "(" ^ param ^ ")]" in - debug "exn" - (fun() -> msg "Converting a Unix error to %s:\n%s\n" n s); - raise (e s) - | Transient(s) -> - debug "exn" (fun() -> - if n="Fatal" then - msg "In %s: Converting a Transient error to %s:\n%s\n" m n s - else - msg "In %s: Propagating Transient error\n" m); - raise (e s) - | Not_found -> - let s = "Not_found raised in " ^ m - ^ " (this indicates a bug!)" in - debug "exn" (fun() -> msg "Converting a Not_found to %s:\n%s\n" n s); - raise (e s) - | End_of_file -> - let s = "End_of_file exception raised in " ^ m - ^ " (this indicates a bug!)" in - debug "exn" (fun() -> msg "Converting an End_of_file to %s:\n%s\n" n s); - raise (e s) - | Sys_error(s) -> - let s = "Error in " ^ m ^ ":\n" ^ s in - debug "exn" (fun() -> msg "Converting a Sys_error to %s:\n%s\n" n s); - raise (e s) - | Sys_blocked_io -> - let s = "Blocked IO error in " ^ m in - debug "exn" (fun() -> msg "Converting a Sys_blocked_io to %s:\n%s\n" - n s); - raise (e s) - -let convertUnixErrorsToFatal m f = - convertUnixErrorsToExn m f "Fatal" (fun str -> Fatal(str)) - -let convertUnixErrorsToTransient m f = - convertUnixErrorsToExn m f "Transient" (fun str -> Transient(str)) - -let unwindProtect f cleanup = - try - f () - with - Transient _ as e -> - debug "exn" (fun () -> msg "Exception caught by unwindProtect\n"); - convertUnixErrorsToFatal "unwindProtect" (fun()-> cleanup e); - raise e - -let finalize f cleanup = - try - let res = f () in - cleanup (); - res - with - Transient _ as e -> - debug "exn" (fun () -> msg "Exception caught by finalize\n"); - convertUnixErrorsToFatal "finalize" cleanup; - raise e - -type confirmation = - Succeeded - | Failed of string - -let ignoreTransientErrors thunk = - try - thunk() - with - Transient(s) -> () - -let printException e = - try - raise e - with - Transient s -> s - | Fatal s -> s - | e -> Printexc.to_string e - -(* Safe version of Unix getenv -- raises a comprehensible error message if - called with an env variable that doesn't exist *) -let safeGetenv var = - convertUnixErrorsToFatal - "querying environment" - (fun () -> - try Unix.getenv var - with Not_found -> - raise (Fatal ("Environment variable " ^ var ^ " not found"))) - -let process_status_to_string = function - Unix.WEXITED i -> Printf.sprintf "Exited with status %d" i - | Unix.WSIGNALED i -> Printf.sprintf "Killed by signal %d" i - | Unix.WSTOPPED i -> Printf.sprintf "Stopped by signal %d" i - -(*****************************************************************************) -(* OS TYPE *) -(*****************************************************************************) - -let osType = - match Sys.os_type with - "Win32" | "Cygwin" -> `Win32 - | "Unix" -> `Unix - | other -> raise (Fatal ("Unknown OS: " ^ other)) - -let isCygwin = (Sys.os_type = "Cygwin") - -(*****************************************************************************) -(* MISCELLANEOUS *) -(*****************************************************************************) - -let monthname n = - Safelist.nth - ["Jan";"Feb";"Mar";"Apr";"May";"Jun";"Jul";"Aug";"Sep";"Oct";"Nov";"Dec"] - n - -let localtime f = - convertUnixErrorsToTransient "localtime" (fun()-> Unix.localtime f) - -let time () = - convertUnixErrorsToTransient "time" Unix.time - -let time2string timef = - try - let time = localtime timef in -(* Old-style: - Printf.sprintf - "%2d:%.2d:%.2d on %2d %3s, %4d" - time.Unix.tm_hour - time.Unix.tm_min - time.Unix.tm_sec - time.Unix.tm_mday - (monthname time.Unix.tm_mon) - (time.Unix.tm_year + 1900) -*) - Printf.sprintf - "%4d-%02d-%02d at %2d:%.2d:%.2d" - (time.Unix.tm_year + 1900) - (time.Unix.tm_mon + 1) - time.Unix.tm_mday - time.Unix.tm_hour - time.Unix.tm_min - time.Unix.tm_sec - with Transient _ -> - "(invalid date)" - -let percentageOfTotal current total = - (int_of_float ((float current) *. 100.0 /. (float total))) - -let percent2string p = Printf.sprintf "%3d%%" (truncate (max 0. (min 100. p))) - -let extractValueFromOption = function - None -> raise (Fatal "extractValueFromOption failed") - | Some(v) -> v - -let option2string (prt: 'a -> string) = function - Some x -> prt x - | None -> "N.A." - -(*****************************************************************************) -(* String utility functions *) -(*****************************************************************************) - -let truncateString string length = - let actualLength = String.length string in - if actualLength <= length then string^(String.make (length - actualLength) ' ') - else if actualLength < 3 then string - else (String.sub string 0 (length - 3))^ "..." - -let findsubstring s1 s2 = - let l1 = String.length s1 in - let l2 = String.length s2 in - let rec loop i = - if i+l1 > l2 then None - else if s1 = String.sub s2 i l1 then Some(i) - else loop (i+1) - in loop 0 - -let rec replacesubstring s fromstring tostring = - match findsubstring fromstring s with - None -> s - | Some(i) -> - let before = String.sub s 0 i in - let afterpos = i + (String.length fromstring) in - let after = String.sub s afterpos ((String.length s) - afterpos) in - before ^ tostring ^ (replacesubstring after fromstring tostring) - -let replacesubstrings s pairs = - Safelist.fold_left - (fun s' (froms,tos) -> replacesubstring s' froms tos) - s pairs - -let startswith s1 s2 = - let l1 = String.length s1 in - let l2 = String.length s2 in - if l1 < l2 then false else - let rec loop i = - if i>=l2 then true - else if s1.[i] <> s2.[i] then false - else loop (i+1) - in loop 0 - -let endswith s1 s2 = - let l1 = String.length s1 in - let l2 = String.length s2 in - let offset = l1 - l2 in - if l1 < l2 then false else - let rec loop i = - if i>=l2 then true - else if s1.[i+offset] <> s2.[i] then false - else loop (i+1) - in loop 0 - -let concatmap sep f l = - String.concat sep (Safelist.map f l) - -let rec trimWhitespace s = - let l = String.length s in - if l=0 then s - else if s.[0]=' ' || s.[0]='\t' || s.[0]='\n' || s.[0]='\r' then - trimWhitespace (String.sub s 1 (l-1)) - else if s.[l-1]=' ' || s.[l-1]='\t' || s.[l-1]='\n' || s.[l-1]='\r' then - trimWhitespace (String.sub s 0 (l-1)) - else - s - -let splitIntoWords (s:string) (c:char) = - let rec inword acc start pos = - if pos >= String.length(s) || s.[pos] = c then - betweenwords ((String.sub s start (pos-start)) :: acc) pos - else inword acc start (pos+1) - and betweenwords acc pos = - if pos >= (String.length s) then (Safelist.rev acc) - else if s.[pos]=c then betweenwords acc (pos+1) - else inword acc pos pos - in betweenwords [] 0 - -let rec splitIntoWordsByString s sep = - match findsubstring sep s with - None -> [s] - | Some(i) -> - let before = String.sub s 0 i in - let afterpos = i + (String.length sep) in - let after = String.sub s afterpos ((String.length s) - afterpos) in - before :: (splitIntoWordsByString after sep) - -let padto n s = s ^ (String.make (max 0 (n - String.length s)) ' ') - -(*****************************************************************************) -(* Building pathnames in the user's home dir *) -(*****************************************************************************) - -let fileInHomeDir n = - if (osType = `Unix) || isCygwin then - Filename.concat (safeGetenv "HOME") n - else if osType = `Win32 then - let dirString = - try Unix.getenv "HOME" (* Windows 9x with Cygwin HOME set *) - with Not_found -> - try Unix.getenv "USERPROFILE" (* Windows NT/2K standard *) - with Not_found -> - try Unix.getenv "UNISON" (* Use UNISON dir if it is set *) - with Not_found -> - "c:/" (* Default *) in - Filename.concat dirString n - else - assert false (* osType can't be anything else *) - -(*****************************************************************************) -(* "Upcall" for building pathnames in the .unison dir *) -(*****************************************************************************) - -let fileInUnisonDirFn = ref None - -let supplyFileInUnisonDirFn f = fileInUnisonDirFn := Some(f) - -let fileInUnisonDir n = - match !fileInUnisonDirFn with - None -> assert false - | Some(f) -> f n Copied: branches/2.32/src/ubase/util.ml (from rev 320, trunk/src/ubase/util.ml) =================================================================== --- branches/2.32/src/ubase/util.ml (rev 0) +++ branches/2.32/src/ubase/util.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,453 @@ +(* Unison file synchronizer: src/ubase/util.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +(*****************************************************************************) +(* CASE INSENSITIVE COMPARISON *) +(*****************************************************************************) +let nocase_cmp a b = + let alen = String.length a in + let blen = String.length b in + let minlen = if alen=minlen then compare alen blen + else + let c = + compare (Char.lowercase(String.get a i)) (Char.lowercase(String.get b i)) in + if c<>0 then c else loop (i+1) in + loop 0 +let nocase_eq a b = (0 = (nocase_cmp a b)) + + +(*****************************************************************************) +(* PRE-BUILT MAP AND SET MODULES *) +(*****************************************************************************) + +module StringMap = + Map.Make(struct + type t = string + let compare = compare + end) + +module StringSet = + Set.Make(struct + type t = string + let compare = compare + end) + +let stringSetFromList l = + Safelist.fold_right StringSet.add l StringSet.empty + +(*****************************************************************************) +(* Debugging / error messages *) +(*****************************************************************************) + +let infos = ref "" + +let clear_infos () = + if !infos <> "" then begin + print_string "\r"; + print_string (String.make (String.length !infos) ' '); + print_string "\r"; + flush stdout + end +let show_infos () = + if !infos <> "" then begin print_string !infos; flush stdout end +let set_infos s = + if s <> !infos then begin clear_infos (); infos := s; show_infos () end + +let msg f = + clear_infos (); Uprintf.eprintf (fun () -> flush stderr; show_infos ()) f + +let msg : ('a, out_channel, unit) format -> 'a = msg + +(* ------------- Formatting stuff --------------- *) + +let curr_formatter = ref Format.std_formatter + +let format f = Format.fprintf (!curr_formatter) f +let format : ('a, Format.formatter, unit) format -> 'a = format + +let format_to_string f = + let old_formatter = !curr_formatter in + curr_formatter := Format.str_formatter; + f (); + let s = Format.flush_str_formatter () in + curr_formatter := old_formatter; + s + +let flush () = Format.pp_print_flush (!curr_formatter) () + +(*****************************************************************************) +(* GLOBAL DEBUGGING SWITCH *) +(*****************************************************************************) + +let debugPrinter = ref None + +let debug s th = + match !debugPrinter with + None -> assert false + | Some p -> p s th + +(* This should be set by the UI to a function that can be used to warn users *) +let warnPrinter = ref None + +(* The rest of the program invokes this function to warn users. *) +let warn message = + match !warnPrinter with + None -> () + | Some p -> p message + +(*****************************************************************************) +(* EXCEPTION HANDLING *) +(*****************************************************************************) + +exception Fatal of string +exception Transient of string + +let encodeException m kind e = + let reraise s = + match kind with + `Fatal -> raise (Fatal s) + | `Transient -> raise (Transient s) + in + let kindStr = + match kind with + `Fatal -> "Fatal" + | `Transient -> "Transient" + in + match e with + Unix.Unix_error(err,fnname,param) -> + let s = "Error in " ^ m ^ ":\n" + ^ (Unix.error_message err) + ^ " [" ^ fnname ^ "(" ^ param ^ ")]" in + debug "exn" + (fun() -> msg "Converting a Unix error to %s:\n%s\n" kindStr s); + reraise s + | Transient(s) -> + debug "exn" (fun() -> + if kind = `Fatal then + msg "In %s: Converting a Transient error to %s:\n%s\n" m kindStr s + else + msg "In %s: Propagating Transient error\n" m); + reraise s + | Not_found -> + let s = "Not_found raised in " ^ m + ^ " (this indicates a bug!)" in + debug "exn" + (fun() -> msg "Converting a Not_found to %s:\n%s\n" kindStr s); + reraise s + | Invalid_argument a -> + let s = "Invalid_argument("^a^") raised in " ^ m + ^ " (this indicates a bug!)" in + debug "exn" + (fun() -> msg "Converting an Invalid_argument to %s:\n%s\n" kindStr s); + reraise s + | Sys_error(s) -> + let s = "Error in " ^ m ^ ":\n" ^ s in + debug "exn" + (fun() -> msg "Converting a Sys_error to %s:\n%s\n" kindStr s); + reraise s + | Sys_blocked_io -> + let s = "Blocked IO error in " ^ m in + debug "exn" + (fun() -> msg "Converting a Sys_blocked_io to %s:\n%s\n" kindStr s); + reraise s + | _ -> + raise e + +let convertUnixErrorsToExn m f n e = + try f() + with + Unix.Unix_error(err,fnname,param) -> + let s = "Error in " ^ m ^ ":\n" + ^ (Unix.error_message err) + ^ " [" ^ fnname ^ "(" ^ param ^ ")]" in + debug "exn" + (fun() -> msg "Converting a Unix error to %s:\n%s\n" n s); + raise (e s) + | Transient(s) -> + debug "exn" (fun() -> + if n="Fatal" then + msg "In %s: Converting a Transient error to %s:\n%s\n" m n s + else + msg "In %s: Propagating Transient error\n" m); + raise (e s) + | Not_found -> + let s = "Not_found raised in " ^ m + ^ " (this indicates a bug!)" in + debug "exn" (fun() -> msg "Converting a Not_found to %s:\n%s\n" n s); + raise (e s) + | End_of_file -> + let s = "End_of_file exception raised in " ^ m + ^ " (this indicates a bug!)" in + debug "exn" (fun() -> msg "Converting an End_of_file to %s:\n%s\n" n s); + raise (e s) + | Sys_error(s) -> + let s = "Error in " ^ m ^ ":\n" ^ s in + debug "exn" (fun() -> msg "Converting a Sys_error to %s:\n%s\n" n s); + raise (e s) + | Sys_blocked_io -> + let s = "Blocked IO error in " ^ m in + debug "exn" (fun() -> msg "Converting a Sys_blocked_io to %s:\n%s\n" + n s); + raise (e s) + +let convertUnixErrorsToFatal m f = + convertUnixErrorsToExn m f "Fatal" (fun str -> Fatal(str)) + +let convertUnixErrorsToTransient m f = + convertUnixErrorsToExn m f "Transient" (fun str -> Transient(str)) + +let unwindProtect f cleanup = + try + f () + with + Transient _ as e -> + debug "exn" (fun () -> msg "Exception caught by unwindProtect\n"); + convertUnixErrorsToFatal "unwindProtect" (fun()-> cleanup e); + raise e + +let finalize f cleanup = + try + let res = f () in + cleanup (); + res + with + Transient _ as e -> + debug "exn" (fun () -> msg "Exception caught by finalize\n"); + convertUnixErrorsToFatal "finalize" cleanup; + raise e + +type confirmation = + Succeeded + | Failed of string + +let ignoreTransientErrors thunk = + try + thunk() + with + Transient(s) -> () + +let printException e = + try + raise e + with + Transient s -> s + | Fatal s -> s + | e -> Printexc.to_string e + +(* Safe version of Unix getenv -- raises a comprehensible error message if + called with an env variable that doesn't exist *) +let safeGetenv var = + convertUnixErrorsToFatal + "querying environment" + (fun () -> + try Unix.getenv var + with Not_found -> + raise (Fatal ("Environment variable " ^ var ^ " not found"))) + +let process_status_to_string = function + Unix.WEXITED i -> Printf.sprintf "Exited with status %d" i + | Unix.WSIGNALED i -> Printf.sprintf "Killed by signal %d" i + | Unix.WSTOPPED i -> Printf.sprintf "Stopped by signal %d" i + +(*****************************************************************************) +(* OS TYPE *) +(*****************************************************************************) + +let osType = + match Sys.os_type with + "Win32" | "Cygwin" -> `Win32 + | "Unix" -> `Unix + | other -> raise (Fatal ("Unknown OS: " ^ other)) + +let isCygwin = (Sys.os_type = "Cygwin") + +(*****************************************************************************) +(* MISCELLANEOUS *) +(*****************************************************************************) + +let monthname n = + Safelist.nth + ["Jan";"Feb";"Mar";"Apr";"May";"Jun";"Jul";"Aug";"Sep";"Oct";"Nov";"Dec"] + n + +let localtime f = + convertUnixErrorsToTransient "localtime" (fun()-> Unix.localtime f) + +let time () = + convertUnixErrorsToTransient "time" Unix.time + +let time2string timef = + try + let time = localtime timef in +(* Old-style: + Printf.sprintf + "%2d:%.2d:%.2d on %2d %3s, %4d" + time.Unix.tm_hour + time.Unix.tm_min + time.Unix.tm_sec + time.Unix.tm_mday + (monthname time.Unix.tm_mon) + (time.Unix.tm_year + 1900) +*) + Printf.sprintf + "%4d-%02d-%02d at %2d:%.2d:%.2d" + (time.Unix.tm_year + 1900) + (time.Unix.tm_mon + 1) + time.Unix.tm_mday + time.Unix.tm_hour + time.Unix.tm_min + time.Unix.tm_sec + with Transient _ -> + "(invalid date)" + +let percentageOfTotal current total = + (int_of_float ((float current) *. 100.0 /. (float total))) + +let percent2string p = Printf.sprintf "%3d%%" (truncate (max 0. (min 100. p))) + +let extractValueFromOption = function + None -> raise (Fatal "extractValueFromOption failed") + | Some(v) -> v + +let option2string (prt: 'a -> string) = function + Some x -> prt x + | None -> "N.A." + +(*****************************************************************************) +(* String utility functions *) +(*****************************************************************************) + +let truncateString string length = + let actualLength = String.length string in + if actualLength <= length then string^(String.make (length - actualLength) ' ') + else if actualLength < 3 then string + else (String.sub string 0 (length - 3))^ "..." + +let findsubstring s1 s2 = + let l1 = String.length s1 in + let l2 = String.length s2 in + let rec loop i = + if i+l1 > l2 then None + else if s1 = String.sub s2 i l1 then Some(i) + else loop (i+1) + in loop 0 + +let rec replacesubstring s fromstring tostring = + match findsubstring fromstring s with + None -> s + | Some(i) -> + let before = String.sub s 0 i in + let afterpos = i + (String.length fromstring) in + let after = String.sub s afterpos ((String.length s) - afterpos) in + before ^ tostring ^ (replacesubstring after fromstring tostring) + +let replacesubstrings s pairs = + Safelist.fold_left + (fun s' (froms,tos) -> replacesubstring s' froms tos) + s pairs + +let startswith s1 s2 = + let l1 = String.length s1 in + let l2 = String.length s2 in + if l1 < l2 then false else + let rec loop i = + if i>=l2 then true + else if s1.[i] <> s2.[i] then false + else loop (i+1) + in loop 0 + +let endswith s1 s2 = + let l1 = String.length s1 in + let l2 = String.length s2 in + let offset = l1 - l2 in + if l1 < l2 then false else + let rec loop i = + if i>=l2 then true + else if s1.[i+offset] <> s2.[i] then false + else loop (i+1) + in loop 0 + +let concatmap sep f l = + String.concat sep (Safelist.map f l) + +let rec trimWhitespace s = + let l = String.length s in + if l=0 then s + else if s.[0]=' ' || s.[0]='\t' || s.[0]='\n' || s.[0]='\r' then + trimWhitespace (String.sub s 1 (l-1)) + else if s.[l-1]=' ' || s.[l-1]='\t' || s.[l-1]='\n' || s.[l-1]='\r' then + trimWhitespace (String.sub s 0 (l-1)) + else + s + +let splitIntoWords (s:string) (c:char) = + let rec inword acc start pos = + if pos >= String.length(s) || s.[pos] = c then + betweenwords ((String.sub s start (pos-start)) :: acc) pos + else inword acc start (pos+1) + and betweenwords acc pos = + if pos >= (String.length s) then (Safelist.rev acc) + else if s.[pos]=c then betweenwords acc (pos+1) + else inword acc pos pos + in betweenwords [] 0 + +let rec splitIntoWordsByString s sep = + match findsubstring sep s with + None -> [s] + | Some(i) -> + let before = String.sub s 0 i in + let afterpos = i + (String.length sep) in + let after = String.sub s afterpos ((String.length s) - afterpos) in + before :: (splitIntoWordsByString after sep) + +let padto n s = s ^ (String.make (max 0 (n - String.length s)) ' ') + +(*****************************************************************************) +(* Building pathnames in the user's home dir *) +(*****************************************************************************) + +let fileInHomeDir n = + if (osType = `Unix) || isCygwin then + Filename.concat (safeGetenv "HOME") n + else if osType = `Win32 then + let dirString = + try Unix.getenv "HOME" (* Windows 9x with Cygwin HOME set *) + with Not_found -> + try Unix.getenv "USERPROFILE" (* Windows NT/2K standard *) + with Not_found -> + try Unix.getenv "UNISON" (* Use UNISON dir if it is set *) + with Not_found -> + "c:/" (* Default *) in + Filename.concat dirString n + else + assert false (* osType can't be anything else *) + +(*****************************************************************************) +(* "Upcall" for building pathnames in the .unison dir *) +(*****************************************************************************) + +let fileInUnisonDirFn = ref None + +let supplyFileInUnisonDirFn f = fileInUnisonDirFn := Some(f) + +let fileInUnisonDir n = + match !fileInUnisonDirFn with + None -> assert false + | Some(f) -> f n Deleted: branches/2.32/src/ubase/util.mli =================================================================== --- trunk/src/ubase/util.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/ubase/util.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,120 +0,0 @@ -(* Unison file synchronizer: src/ubase/util.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* Miscellaneous utility functions and datatypes *) - -(* ---------------------------------------------------------------------- *) -(* Exceptions *) - -exception Fatal of string -exception Transient of string - -val encodeException : string -> [`Transient | `Fatal] -> exn -> 'a -val convertUnixErrorsToTransient : string -> (unit -> 'a) -> 'a -val convertUnixErrorsToFatal : string -> (unit -> 'a) -> 'a -val ignoreTransientErrors : (unit -> unit) -> unit - -(* [unwindProtect e1 e2] executes e1, catching the above two exceptions and - executing e2 (passing it the exception packet, so that it can log a - message or whatever) before re-raising them *) -val unwindProtect : (unit -> 'a) -> (exn -> unit) -> 'a - -(* [finalize e1 e2] executes e1 and then e2. If e1 raises either of the - above two exceptions e2 is still executed and the exception is reraised *) -val finalize : (unit -> 'a) -> (unit -> unit) -> 'a - -(* For data structures that need to record when operations have succeeded or - failed *) -type confirmation = - Succeeded - | Failed of string - -val printException : exn -> string - -val process_status_to_string : Unix.process_status -> string - -(* ---------------------------------------------------------------------- *) -(* Strings *) - -(* Case insensitive comparison *) -val nocase_cmp : string -> string -> int -val nocase_eq : string -> string -> bool - -(* Ready-build set and map implementations *) -module StringSet : Set.S with type elt = string -module StringMap : Map.S with type key = string -val stringSetFromList : string list -> StringSet.t - -(* String manipulation *) -val truncateString : string -> int -> string -val startswith : string -> string -> bool -val endswith : string -> string -> bool -val findsubstring : string -> string -> int option -val replacesubstring : string -> string -> string -> string (* IN,FROM,TO *) -val replacesubstrings : string -> (string * string) list -> string -val concatmap : string -> ('a -> string) -> 'a list -> string -val trimWhitespace : string -> string -val splitIntoWords : string -> char -> string list -val splitIntoWordsByString : string -> string -> string list -val padto : int -> string -> string - -(* ---------------------------------------------------------------------- *) -(* Miscellaneous *) - -(* Architecture *) -val osType : [`Unix | `Win32] -val isCygwin: bool (* osType will be `Win32 in this case *) - -(* Options *) -val extractValueFromOption : 'a option -> 'a -val option2string: ('a -> string) -> ('a option -> string) - -(* Miscellaneous *) -val time2string : float -> string -val percentageOfTotal : - int -> (* current value *) - int -> (* total value *) - int (* percentage of total *) -val monthname : int -> string -val percent2string : float -> string -val fileInHomeDir : string -> string - -(* Just like the versions in the Unix module, but raising Transient - instead of Unix_error *) -val localtime : float -> Unix.tm -val time : unit -> float - -(* Global debugging printer (it's exposed as a ref so that modules loaded - before Trace can use it; the ref will always be set to Some(Trace.debug)) *) -val debugPrinter : ((string -> (unit->unit) -> unit) option) ref -(* A synonym for Trace.debug *) -val debug : string -> (unit->unit) -> unit - -(* The UI must supply a function to warn the user *) -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 -> string) -> unit -(* Use it like this: *) -val fileInUnisonDir : string -> string - -(* Printing and formatting functions *) - -val format : ('a, Format.formatter, unit) format -> 'a -(** Format some text on the current formatting channel. - This is the only formatting function that should be called anywhere in the program! *) - -val flush : unit -> unit - -val format_to_string : (unit -> unit) -> string -(** [format_to_string f] runs [f] in a context where the Format functions are redirected to - a string, which it returns. *) - -(* Format and print messages on the standard error stream, being careful to - flush the stream after each one *) -val msg : ('a, out_channel, unit) format -> 'a - -(* Set the info line *) -val set_infos : string -> unit Copied: branches/2.32/src/ubase/util.mli (from rev 320, trunk/src/ubase/util.mli) =================================================================== --- branches/2.32/src/ubase/util.mli (rev 0) +++ branches/2.32/src/ubase/util.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,120 @@ +(* Unison file synchronizer: src/ubase/util.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +(* Miscellaneous utility functions and datatypes *) + +(* ---------------------------------------------------------------------- *) +(* Exceptions *) + +exception Fatal of string +exception Transient of string + +val encodeException : string -> [`Transient | `Fatal] -> exn -> 'a +val convertUnixErrorsToTransient : string -> (unit -> 'a) -> 'a +val convertUnixErrorsToFatal : string -> (unit -> 'a) -> 'a +val ignoreTransientErrors : (unit -> unit) -> unit + +(* [unwindProtect e1 e2] executes e1, catching the above two exceptions and + executing e2 (passing it the exception packet, so that it can log a + message or whatever) before re-raising them *) +val unwindProtect : (unit -> 'a) -> (exn -> unit) -> 'a + +(* [finalize e1 e2] executes e1 and then e2. If e1 raises either of the + above two exceptions e2 is still executed and the exception is reraised *) +val finalize : (unit -> 'a) -> (unit -> unit) -> 'a + +(* For data structures that need to record when operations have succeeded or + failed *) +type confirmation = + Succeeded + | Failed of string + +val printException : exn -> string + +val process_status_to_string : Unix.process_status -> string + +(* ---------------------------------------------------------------------- *) +(* Strings *) + +(* Case insensitive comparison *) +val nocase_cmp : string -> string -> int +val nocase_eq : string -> string -> bool + +(* Ready-build set and map implementations *) +module StringSet : Set.S with type elt = string +module StringMap : Map.S with type key = string +val stringSetFromList : string list -> StringSet.t + +(* String manipulation *) +val truncateString : string -> int -> string +val startswith : string -> string -> bool +val endswith : string -> string -> bool +val findsubstring : string -> string -> int option +val replacesubstring : string -> string -> string -> string (* IN,FROM,TO *) +val replacesubstrings : string -> (string * string) list -> string +val concatmap : string -> ('a -> string) -> 'a list -> string +val trimWhitespace : string -> string +val splitIntoWords : string -> char -> string list +val splitIntoWordsByString : string -> string -> string list +val padto : int -> string -> string + +(* ---------------------------------------------------------------------- *) +(* Miscellaneous *) + +(* Architecture *) +val osType : [`Unix | `Win32] +val isCygwin: bool (* osType will be `Win32 in this case *) + +(* Options *) +val extractValueFromOption : 'a option -> 'a +val option2string: ('a -> string) -> ('a option -> string) + +(* Miscellaneous *) +val time2string : float -> string +val percentageOfTotal : + int -> (* current value *) + int -> (* total value *) + int (* percentage of total *) +val monthname : int -> string +val percent2string : float -> string +val fileInHomeDir : string -> string + +(* Just like the versions in the Unix module, but raising Transient + instead of Unix_error *) +val localtime : float -> Unix.tm +val time : unit -> float + +(* Global debugging printer (it's exposed as a ref so that modules loaded + before Trace can use it; the ref will always be set to Some(Trace.debug)) *) +val debugPrinter : ((string -> (unit->unit) -> unit) option) ref +(* A synonym for Trace.debug *) +val debug : string -> (unit->unit) -> unit + +(* The UI must supply a function to warn the user *) +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 -> string) -> unit +(* Use it like this: *) +val fileInUnisonDir : string -> string + +(* Printing and formatting functions *) + +val format : ('a, Format.formatter, unit) format -> 'a +(** Format some text on the current formatting channel. + This is the only formatting function that should be called anywhere in the program! *) + +val flush : unit -> unit + +val format_to_string : (unit -> unit) -> string +(** [format_to_string f] runs [f] in a context where the Format functions are redirected to + a string, which it returns. *) + +(* Format and print messages on the standard error stream, being careful to + flush the stream after each one *) +val msg : ('a, out_channel, unit) format -> 'a + +(* Set the info line *) +val set_infos : string -> unit Deleted: branches/2.32/src/ui.mli =================================================================== --- trunk/src/ui.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/ui.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,11 +0,0 @@ -(* Unison file synchronizer: src/ui.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* The module Ui provides only the user interface signature. - Implementations are provided by Uitext and Uitk. *) - -module type SIG = sig - val start : unit -> unit -end - - Copied: branches/2.32/src/ui.mli (from rev 320, trunk/src/ui.mli) =================================================================== --- branches/2.32/src/ui.mli (rev 0) +++ branches/2.32/src/ui.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,11 @@ +(* Unison file synchronizer: src/ui.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +(* The module Ui provides only the user interface signature. + Implementations are provided by Uitext and Uitk. *) + +module type SIG = sig + val start : unit -> unit +end + + Deleted: branches/2.32/src/uicommon.ml =================================================================== --- trunk/src/uicommon.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/uicommon.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,704 +0,0 @@ -(* Unison file synchronizer: src/uicommon.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -open Common -open Lwt - -(********************************************************************** - UI selection - **********************************************************************) - -type interface = - Text - | Graphic - -module type UI = -sig - val start : interface -> unit - val defaultUi : interface -end - - -(********************************************************************** - Preferences - **********************************************************************) - -let auto = - Prefs.createBool "auto" false "automatically accept default (nonconflicting) actions" - ("When set to {\\tt true}, this flag causes the user " - ^ "interface to skip asking for confirmations on " - ^ "non-conflicting changes. (More precisely, when the user interface " - ^ "is done setting the propagation direction for one entry and is about " - ^ "to move to the next, it will skip over all non-conflicting entries " - ^ "and go directly to the next conflict.)" ) - -(* This has to be here rather than in uigtk.ml, because it is part of what - gets sent to the server at startup *) -let mainWindowHeight = - Prefs.createInt "height" 20 - "!height (in lines) of main window in graphical interface" - ("Used to set the height (in lines) of the main window in the graphical " - ^ "user interface.") - -let reuseToplevelWindows = - Prefs.createBool "reusewindows" false - "*reuse top-level windows instead of making new ones" "" -(* Not sure if this should actually be made available to users... - ("When true, causes the graphical interface to re-use top-level windows " - ^ "(e.g., the small window that says ``Connecting...'') rather than " - ^ "destroying them and creating fresh ones. ") -*) -(* For convenience: *) -let _ = Prefs.alias reuseToplevelWindows "rw" - - -let expert = - Prefs.createBool "expert" false - "*Enable some developers-only functionality in the UI" "" - -let profileLabel = - Prefs.createString "label" "" - "!provide a descriptive string label for this profile" - ("Used in a profile to provide a descriptive string documenting its " - ^ "settings. (This is useful for users that switch between several " - ^ "profiles, especially using the `fast switch' feature of the " - ^ "graphical user interface.)") - -let profileKey = - Prefs.createString "key" "" - "!define a keyboard shortcut for this profile (in some UIs)" - ("Used in a profile to define a numeric key (0-9) that can be used in " - ^ "the graphical user interface to switch immediately to this profile.") -(* This preference is not actually referred to in the code anywhere, since - the keyboard shortcuts are constructed by a separate scan of the preference - file in uigtk.ml, but it must be present to prevent the preferences module - from complaining about 'key = n' lines in profiles. *) - -let contactquietly = - Prefs.createBool "contactquietly" false - "!suppress the 'contacting server' message during startup" - ("If this flag is set, Unison will skip displaying the " - ^ "`Contacting server' message (which some users find annoying) " - ^ "during startup.") - -let contactingServerMsg () = - Printf.sprintf "Contacting server..." - -let repeat = - Prefs.createString "repeat" "" - "!synchronize repeatedly (text interface only)" - ("Setting this preference causes the text-mode interface to synchronize " - ^ "repeatedly, rather than doing it just once and stopping. If the " - ^ "argument is a number, Unison will pause for that many seconds before " - ^ "beginning again.") - -(* ^ "If the argument is a path, Unison will wait for the " - ^ "file at this path---called a {\\em changelog}---to " - ^ "be modified (on either the client or the server " - ^ "machine), read the contents of the changelog (which should be a newline-" - ^ "separated list of paths) on both client and server, " - ^ "combine the results, " - ^ "and start again, using the list of paths read from the changelogs as the " - ^ " '-path' preference for the new run. The idea is that an external " - ^ "process will watch the filesystem and, when it thinks something may have " - ^ "changed, write the changed pathname to its local changelog where Unison " - ^ "will find it the next time it looks. If the changelogs have not been " - ^ "modified, Unison will wait, checking them again every few seconds." -*) - -let retry = - Prefs.createInt "retry" 0 - "!re-try failed synchronizations N times (text ui only)" - ("Setting this preference causes the text-mode interface to try again " - ^ "to synchronize " - ^ "updated paths where synchronization fails. Each such path will be " - ^ "tried N times." - ) - -let confirmmerge = - Prefs.createBool "confirmmerge" false - "!ask for confirmation before commiting results of a merge" - ("Setting this preference causes both the text and graphical interfaces" - ^ " to ask the user if the results of a merge command may be commited " - ^ " to the replica or not. Since the merge command works on temporary files," - ^ " the user can then cancel all the effects of applying the merge if it" - ^ " turns out that the result is not satisfactory. In " - ^ " batch-mode, this preference has no effect. Default is false.") - -let runTestsPrefName = "selftest" -let runtests = - Prefs.createBool runTestsPrefName false - "!run internal tests and exit" - ("Run internal tests and exit. This option is mostly for developers and must be used " - ^ "carefully: in particular, " - ^ "it will delete the contents of both roots, so that it can install its own files " - ^ "for testing. This flag only makes sense on the command line. When it is " - ^ "provided, no preference file is read: all preferences must be specified on the" - ^ "command line. Also, since the self-test procedure involves overwriting the roots " - ^ "and backup directory, the names of the roots and of the backupdir preference " - ^ "must include the string " - ^ "\"test\" or else the tests will be aborted. (If these are not given " - ^ "on the command line, dummy " - ^ "subdirectories in the current directory will be created automatically.)") - -(* This ref is set to Test.test during initialization, avoiding a circular - dependency *) -let testFunction = ref (fun () -> assert false) - -(********************************************************************** - Formatting functions - **********************************************************************) - -(* When no archives were found, we omit 'new' in status descriptions, since - *all* files would be marked new and this won't make sense to the user. *) -let choose s1 s2 = if !Update.foundArchives then s1 else s2 - -let showprev = - Prefs.createBool "showprev" false - "*Show previous properties, if they differ from current" - "" - -(* The next function produces nothing unless the "showprev" - preference is set. This is because it tends to make the - output trace too long and annoying. *) -let prevProps newprops ui = - if not (Prefs.read showprev) then "" - else match ui with - NoUpdates | Error _ - -> "" - | Updates (_, New) -> - " (new)" - | Updates (_, Previous(_,oldprops,_,_)) -> - (* || Props.similar newprops oldprops *) - " (was: "^(Props.toString oldprops)^")" - -let replicaContent2string rc sep = - let (typ, status, desc, ui) = rc in - let d s = s ^ sep ^ Props.toString desc ^ prevProps desc ui in - match typ, status with - `ABSENT, `Unchanged -> - "absent" - | _, `Unchanged -> - "unchanged " - ^(Util.truncateString (Fileinfo.type2string typ) 7) - ^ sep - ^(Props.toString desc) - | `ABSENT, `Deleted -> "deleted" - | `FILE, `Created -> - d (choose "new file " "file ") - | `FILE, `Modified -> - d "changed file " - | `FILE, `PropsChanged -> - d "changed props " - | `SYMLINK, `Created -> - d (choose "new symlink " "symlink ") - | `SYMLINK, `Modified -> - d "changed symlink " - | `DIRECTORY, `Created -> - d (choose "new dir " "dir ") - | `DIRECTORY, `Modified -> - d "changed dir " - | `DIRECTORY, `PropsChanged -> - d "dir props changed" - - (* Some cases that can't happen... *) - | `ABSENT, (`Created | `Modified | `PropsChanged) - | `SYMLINK, `PropsChanged - | (`FILE|`SYMLINK|`DIRECTORY), `Deleted -> - assert false - -let replicaContent2shortString rc = - let (typ, status, _, _) = rc in - match typ, status with - _, `Unchanged -> " " - | `ABSENT, `Deleted -> "deleted " - | `FILE, `Created -> choose "new file" "file " - | `FILE, `Modified -> "changed " - | `FILE, `PropsChanged -> "props " - | `SYMLINK, `Created -> choose "new link" "link " - | `SYMLINK, `Modified -> "chgd lnk" - | `DIRECTORY, `Created -> choose "new dir " "dir " - | `DIRECTORY, `Modified -> "chgd dir" - | `DIRECTORY, `PropsChanged -> "props " - (* Cases that can't happen... *) - | `ABSENT, (`Created | `Modified | `PropsChanged) - | `SYMLINK, `PropsChanged - | (`FILE|`SYMLINK|`DIRECTORY), `Deleted - -> assert false - -let roots2niceStrings length = function - (Local,fspath1), (Local,fspath2) -> - let name1, name2 = Fspath.differentSuffix fspath1 fspath2 in - (Util.truncateString name1 length, Util.truncateString name2 length) - | (Local,fspath1), (Remote host, fspath2) -> - (Util.truncateString "local" length, Util.truncateString host length) - | (Remote host, fspath1), (Local,fspath2) -> - (Util.truncateString host length, Util.truncateString "local" length) - | _ -> assert false (* BOGUS? *) - -let details2string theRi sep = - match theRi.replicas with - Problem s -> - Printf.sprintf "Error: %s\n" s - | Different(rc1, rc2, _, _) -> - let root1str, root2str = - roots2niceStrings 12 (Globals.roots()) in - Printf.sprintf "%s : %s\n%s : %s" - root1str (replicaContent2string rc1 sep) - root2str (replicaContent2string rc2 sep) - -let displayPath previousPath path = - let previousNames = Path.toNames previousPath in - let names = Path.toNames path in - if names = [] then "/" else - (* Strip the greatest common prefix of previousNames and names - from names. level is the number of names in the greatest - common prefix. *) - let rec loop level names1 names2 = - match (names1,names2) with - (hd1::tl1,hd2::tl2) -> - if Name.compare hd1 hd2 = 0 - then loop (level+1) tl1 tl2 - else (level,names2) - | _ -> (level,names2) in - let (level,suffixNames) = loop 0 previousNames names in - let suffixPath = - Safelist.fold_left Path.child Path.empty suffixNames in - let spaces = String.make (level*3) ' ' in - spaces ^ (Path.toString suffixPath) - -let roots2string () = - let replica1, replica2 = roots2niceStrings 12 (Globals.roots()) in - (Printf.sprintf "%s %s " replica1 replica2) - -let direction2niceString = function - Conflict -> "<-?->" - | Replica1ToReplica2 -> "---->" - | Replica2ToReplica1 -> "<----" - | Merge -> "<-M->" - -let reconItem2string oldPath theRI status = - let theLine = - match theRI.replicas with - Problem s -> - " error " ^ status - | Different(rc1, rc2, dir, _) -> - let signs = - Printf.sprintf "%s %s %s" - (replicaContent2shortString rc1) - (direction2niceString (!dir)) - (replicaContent2shortString rc2) in - Printf.sprintf "%s %s" signs status in - Printf.sprintf "%s %s" theLine (displayPath oldPath theRI.path) - -let exn2string = function - Sys.Break -> "Terminated!" - | Util.Fatal(s) -> Printf.sprintf "Fatal error: %s" s - | Util.Transient(s) -> Printf.sprintf "Error: %s" s - | other -> Printf.sprintf "Uncaught exception %s" (Printexc.to_string other) - -(* precondition: uc = File (Updates(_, ..) on both sides *) -let showDiffs ri printer errprinter id = - let p = ri.path in - match ri.replicas with - Problem _ -> - errprinter - "Can't diff files: there was a problem during update detection" - | Different((`FILE, _, _, ui1), (`FILE, _, _, ui2), _, _) -> - let (root1,root2) = Globals.roots() in - begin - try Files.diff root1 p ui1 root2 p ui2 printer id - with Util.Transient e -> errprinter e - end - | Different _ -> - errprinter "Can't diff: path doesn't refer to a file in both replicas" - - -exception Synch_props of Common.reconItem - -(********************************************************************** - Common error messages - **********************************************************************) - -let dangerousPathMsg dangerousPaths = - if dangerousPaths = [Path.empty] then - "The root of one of the replicas has been completely emptied.\n\ - Unison may delete everything in the other replica. (Set the \n\ - 'confirmbigdel' preference to false to disable this check.)" - else - Printf.sprintf - "The following paths have been completely emptied in one replica:\n \ - %s\n\ - Unison may delete everything below these paths in the other replica.\n - (Set the 'confirmbigdel' preference to false to disable this check.)" - (String.concat "\n " - (Safelist.map (fun p -> "'" ^ (Path.toString p) ^ "'") - dangerousPaths)) - -(********************************************************************** - Useful patterns for ignoring paths - **********************************************************************) - -let quote s = - let len = String.length s in - let buf = String.create (2 * len) in - let pos = ref 0 in - for i = 0 to len - 1 do - match s.[i] with - '*' | '?' | '[' | '{' as c -> - buf.[!pos] <- '\\'; buf.[!pos + 1] <- c; pos := !pos + 2 - | c -> - buf.[!pos] <- c; pos := !pos + 1 - done; - "{" ^ String.sub buf 0 !pos ^ "}" - -let ignorePath path = "Path " ^ quote (Path.toString path) - -let ignoreName path = - match Path.finalName path with - Some name -> "Name " ^ quote (Name.toString name) - | None -> assert false - -let ignoreExt path = - match Path.finalName path with - Some name -> - let str = Name.toString name in - begin try - let pos = String.rindex str '.' in - let ext = String.sub str pos (String.length str - pos) in - "Name {,.}*" ^ quote ext - with Not_found -> (* str does not contain '.' *) - "Name " ^ quote str - end - | None -> - assert false - -let addIgnorePattern theRegExp = - if theRegExp = "Path " then - raise (Util.Transient "Can't ignore the root path!"); - Globals.addRegexpToIgnore theRegExp; - let r = Prefs.add "ignore" theRegExp in - Trace.status r; - (* Make sure the server has the same ignored paths (in case, for - example, we do a "rescan") *) - Lwt_unix.run (Globals.propagatePrefs ()) - -(********************************************************************** - Profile and command-line parsing - **********************************************************************) - -let coreUsageMsg = - "Usage: " ^ Uutil.myName - ^ " [options]\n" - ^ " or " ^ Uutil.myName - ^ " root1 root2 [options]\n" - ^ " or " ^ Uutil.myName - ^ " profilename [options]\n" - -let shortUsageMsg = - coreUsageMsg ^ "\n" - ^ "For a list of options, type \"" ^ Uutil.myName ^ " -help\".\n" - ^ "For a tutorial on basic usage, type \"" ^ Uutil.myName - ^ " -doc tutorial\".\n" - ^ "For other documentation, type \"" ^ Uutil.myName ^ " -doc topics\".\n" - -let usageMsg = coreUsageMsg - -let debug = Trace.debug "startup" - -(* ---- *) - -(* Determine the case sensitivity of a root (does filename FOO==foo?) *) -let architecture = - Remote.registerRootCmd - "architecture" - (fun (_,()) -> return (Util.osType = `Win32, Osx.isMacOSX)) - -(* During startup the client determines the case sensitivity of each root. - If any root is case insensitive, all roots must know this -- it's - propagated in a pref. *) -(* FIX: this does more than check case sensitivity, it also detects - HFS (needed for resource forks) and Windows (needed for permissions)... - needs a new name *) -let checkCaseSensitivity () = - Globals.allRootsMap (fun r -> architecture r ()) >>= (fun archs -> - let someHostIsRunningWindows = - Safelist.exists (fun (isWin, _) -> isWin) archs in - let allHostsAreRunningWindows = - Safelist.for_all (fun (isWin, _) -> isWin) archs in - let someHostRunningOsX = - Safelist.exists (fun (_, isOSX) -> isOSX) archs in - let someHostIsCaseInsensitive = - someHostIsRunningWindows || someHostRunningOsX in - Case.init someHostIsCaseInsensitive; - Props.init someHostIsRunningWindows; - Osx.init someHostRunningOsX; - Prefs.set Globals.someHostIsRunningWindows someHostIsRunningWindows; - Prefs.set Globals.allHostsAreRunningWindows allHostsAreRunningWindows; - return ()) - -(* ---- *) - -let promptForRoots getFirstRoot getSecondRoot = - (* Ask the user for the roots *) - let r1 = match getFirstRoot() with None -> exit 0 | Some r -> r in - let r2 = match getSecondRoot() with None -> exit 0 | Some r -> r in - (* Remember them for this run, ordering them so that the first - will come out on the left in the UI *) - Globals.setRawRoots [r2;r1]; - (* Save them in the current profile *) - ignore (Prefs.add "root" r1); - ignore (Prefs.add "root" r2) - -(* ---- *) - -(* The first time we load preferences, we also read the command line - arguments; if we re-load prefs (because the user selected a new profile) - we ignore the command line *) -let firstTime = ref(true) - -(* BCP: WARNING: Some of the code from here is duplicated in uimacbridge...! *) -let initPrefs ~profileName ~displayWaitMessage ~getFirstRoot ~getSecondRoot - ~termInteract = - (* Restore prefs to their default values, if necessary *) - if not !firstTime then Prefs.resetToDefaults(); - - (* Tell the preferences module the name of the profile *) - Prefs.profileName := Some(profileName); - - (* Check whether the -selftest flag is present on the command line *) - let testFlagPresent = - Util.StringMap.mem runTestsPrefName (Prefs.scanCmdLine usageMsg) in - - (* If the -selftest flag is present, then we skip loading the preference file. - (This is prevents possible confusions where settings from a preference - file could cause unit tests to fail.) *) - if not testFlagPresent then begin - (* If the profile does not exist, create an empty one (this should only - happen if the profile is 'default', since otherwise we will already - have checked that the named one exists). *) - if not(Sys.file_exists (Prefs.profilePathname profileName)) then - Prefs.addComment "Unison preferences file"; - - (* Load the profile *) - (debug (fun() -> Util.msg "about to load prefs"); - Prefs.loadTheFile()); - - (* Now check again that the -selftest flag has not been set, and barf otherwise *) - if Prefs.read runtests then raise (Util.Fatal - "The 'test' flag should only be given on the command line") - end; - - (* Parse the command line. This will override settings from the profile. *) - if !firstTime then begin - debug (fun() -> Util.msg "about to parse command line"); - Prefs.parseCmdLine usageMsg; - end; - - (* Install dummy roots and backup directory if we are running self-tests *) - if Prefs.read runtests then begin - if Globals.rawRoots() = [] then - Prefs.loadStrings ["root = test-a.tmp"; "root = test-b.tmp"]; - if (Prefs.read Stasher.backupdir) = "" then - Prefs.loadStrings ["backupdir = test-backup.tmp"]; - end; - - (* Print the preference settings *) - debug (fun() -> Prefs.dumpPrefsToStderr() ); - - (* If no roots are given either on the command line or in the profile, - ask the user *) - if Globals.rawRoots() = [] then begin - promptForRoots getFirstRoot getSecondRoot; - end; - - (* The following step contacts the server, so warn the user it could take - some time *) - if !firstTime && (not (Prefs.read contactquietly || Prefs.read Trace.terse)) then - displayWaitMessage(); - - (* Canonize the names of the roots, sort them (with local roots first), - and install them in Globals. *) - Lwt_unix.run (Globals.installRoots termInteract); - - (* If both roots are local, disable the xferhint table to save time *) - begin match Globals.roots() with - ((Local,_),(Local,_)) -> Prefs.set Xferhint.xferbycopying false - | _ -> () - end; - - (* FIX: This should be before Globals.installRoots *) - (* Check to be sure that there is at most one remote root *) - let numRemote = - Safelist.fold_left - (fun n (w,_) -> match w with Local -> n | Remote _ -> n+1) - 0 - (Globals.rootsList()) in - if numRemote > 1 then - raise(Util.Fatal "cannot synchronize more than one remote root"); - - (* If no paths were specified, then synchronize the whole replicas *) - if Prefs.read Globals.paths = [] then Prefs.set Globals.paths [Path.empty]; - - (* Expand any "wildcard" paths [with final component *] *) - Globals.expandWildcardPaths(); - - Update.storeRootsName (); - - if not (Prefs.read contactquietly || Prefs.read Trace.terse) then - Util.msg "Connected [%s]\n" - (Util.replacesubstring (Update.getRootsName()) ", " " -> "); - - debug (fun() -> - Printf.eprintf "Roots: \n"; - Safelist.iter (fun clr -> Printf.eprintf " %s\n" clr) - (Globals.rawRoots ()); - Printf.eprintf " i.e. \n"; - Safelist.iter (fun clr -> Printf.eprintf " %s\n" - (Clroot.clroot2string (Clroot.parseRoot clr))) - (Globals.rawRoots ()); - Printf.eprintf " i.e. (in canonical order)\n"; - Safelist.iter (fun r -> - Printf.eprintf " %s\n" (root2string r)) - (Globals.rootsInCanonicalOrder()); - Printf.eprintf "\n"); - - Recon.checkThatPreferredRootIsValid(); - - Lwt_unix.run - (checkCaseSensitivity () >>= - Globals.propagatePrefs); - - (* Initializes some backups stuff according to the preferences just loaded from the profile. - Important to do it here, after prefs are propagated, because the function will also be - run on the server, if any. Also, this should be done each time a profile is reloaded - on this side, that's why it's here. *) - Stasher.initBackups (); - - firstTime := false - -(********************************************************************** - Common startup sequence - **********************************************************************) - -let anonymousArgs = - Prefs.createStringList "rest" - "*roots or profile name" "" - -let testServer = - Prefs.createBool "testserver" false - "exit immediately after the connection to the server" - ("Setting this flag on the command line causes Unison to attempt to " - ^ "connect to the remote server and, if successful, print a message " - ^ "and immediately exit. Useful for debugging installation problems. " - ^ "Should not be set in preference files.") - -(* For backward compatibility *) -let _ = Prefs.alias testServer "testServer" - -(* ---- *) - -let uiInit - ~(reportError : string -> unit) - ~(tryAgainOrQuit : string -> bool) - ~(displayWaitMessage : unit -> unit) - ~(getProfile : unit -> string option) - ~(getFirstRoot : unit -> string option) - ~(getSecondRoot : unit -> string option) - ~(termInteract : (string -> string -> string) option) = - - (* Make sure we have a directory for archives and profiles *) - Os.createUnisonDir(); - - (* Extract any command line profile or roots *) - let clprofile = ref None in - begin - try - let args = Prefs.scanCmdLine usageMsg in - match Util.StringMap.find "rest" args with - [] -> () - | [profile] -> clprofile := Some profile - | [root1;root2] -> Globals.setRawRoots [root1;root2] - | [root1;root2;profile] -> - Globals.setRawRoots [root1;root2]; - clprofile := Some profile - | _ -> - (reportError(Printf.sprintf - "%s was invoked incorrectly (too many roots)" Uutil.myName); - exit 1) - with Not_found -> () - end; - - (* Print header for debugging output *) - debug (fun() -> - Printf.eprintf "%s, version %s\n\n" Uutil.myName Uutil.myVersion); - debug (fun() -> Util.msg "initializing UI"); - - debug (fun () -> - (match !clprofile with - None -> Util.msg "No profile given on command line" - | Some s -> Printf.eprintf "Profile '%s' given on command line" s); - (match Globals.rawRoots() with - [] -> Util.msg "No roots given on command line" - | [root1;root2] -> - Printf.eprintf "Roots '%s' and '%s' given on command line" - root1 root2 - | _ -> assert false)); - - let profileName = - begin match !clprofile with - None -> - let dirString = Fspath.toString Os.unisonDir in - let profiles_exist = (Files.ls dirString "*.prf")<>[] in - let clroots_given = (Globals.rawRoots() <> []) in - let n = - if profiles_exist && not(clroots_given) then begin - (* Unison has been used before: at least one profile exists. - Ask the user to choose a profile or create a new one. *) - clprofile := getProfile(); - match !clprofile with - None -> exit 0 (* None means the user wants to quit *) - | Some x -> x - end else begin - (* First time use, OR roots given on command line. - In either case, the profile should be the default. *) - clprofile := Some "default"; - "default" - end in - n - | Some n -> - let f = Prefs.profilePathname n in - if not(Sys.file_exists f) - then (reportError (Printf.sprintf "Profile %s does not exist" f); - exit 1); - n - end in - - (* Load the profile and command-line arguments *) - initPrefs - profileName displayWaitMessage getFirstRoot getSecondRoot termInteract; - - (* Turn on GC messages, if the '-debug gc' flag was provided *) - if Trace.enabled "gc" then Gc.set {(Gc.get ()) with Gc.verbose = 0x3F}; - - if Prefs.read testServer then exit 0; - - (* BCPFIX: Should/can this be done earlier?? *) - Files.processCommitLogs(); - - (* Run unit tests if requested *) - if Prefs.read runtests then begin - (!testFunction)(); - exit 0 - end - -(* Exit codes *) -let perfectExit = 0 (* when everything's okay *) -let skippyExit = 1 (* when some items were skipped, but no failure occurred *) -let failedExit = 2 (* when there's some non-fatal failure *) -let fatalExit = 3 (* when fatal failure occurred *) -let exitCode = function - (false, false) -> 0 - | (true, false) -> 1 - | _ -> 2 -(* (anySkipped?, anyFailure?) -> exit code *) Copied: branches/2.32/src/uicommon.ml (from rev 320, trunk/src/uicommon.ml) =================================================================== --- branches/2.32/src/uicommon.ml (rev 0) +++ branches/2.32/src/uicommon.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,719 @@ +(* Unison file synchronizer: src/uicommon.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +open Common +open Lwt + +(********************************************************************** + UI selection + **********************************************************************) + +type interface = + Text + | Graphic + +module type UI = +sig + val start : interface -> unit + val defaultUi : interface +end + + +(********************************************************************** + Preferences + **********************************************************************) + +let auto = + Prefs.createBool "auto" false "automatically accept default (nonconflicting) actions" + ("When set to {\\tt true}, this flag causes the user " + ^ "interface to skip asking for confirmations on " + ^ "non-conflicting changes. (More precisely, when the user interface " + ^ "is done setting the propagation direction for one entry and is about " + ^ "to move to the next, it will skip over all non-conflicting entries " + ^ "and go directly to the next conflict.)" ) + +(* This has to be here rather than in uigtk.ml, because it is part of what + gets sent to the server at startup *) +let mainWindowHeight = + Prefs.createInt "height" 20 + "!height (in lines) of main window in graphical interface" + ("Used to set the height (in lines) of the main window in the graphical " + ^ "user interface.") + +let reuseToplevelWindows = + Prefs.createBool "reusewindows" false + "*reuse top-level windows instead of making new ones" "" +(* Not sure if this should actually be made available to users... + ("When true, causes the graphical interface to re-use top-level windows " + ^ "(e.g., the small window that says ``Connecting...'') rather than " + ^ "destroying them and creating fresh ones. ") +*) +(* For convenience: *) +let _ = Prefs.alias reuseToplevelWindows "rw" + + +let expert = + Prefs.createBool "expert" false + "*Enable some developers-only functionality in the UI" "" + +let profileLabel = + Prefs.createString "label" "" + "!provide a descriptive string label for this profile" + ("Used in a profile to provide a descriptive string documenting its " + ^ "settings. (This is useful for users that switch between several " + ^ "profiles, especially using the `fast switch' feature of the " + ^ "graphical user interface.)") + +let profileKey = + Prefs.createString "key" "" + "!define a keyboard shortcut for this profile (in some UIs)" + ("Used in a profile to define a numeric key (0-9) that can be used in " + ^ "the graphical user interface to switch immediately to this profile.") +(* This preference is not actually referred to in the code anywhere, since + the keyboard shortcuts are constructed by a separate scan of the preference + file in uigtk.ml, but it must be present to prevent the preferences module + from complaining about 'key = n' lines in profiles. *) + +let contactquietly = + Prefs.createBool "contactquietly" false + "!suppress the 'contacting server' message during startup" + ("If this flag is set, Unison will skip displaying the " + ^ "`Contacting server' message (which some users find annoying) " + ^ "during startup.") + +let contactingServerMsg () = + Printf.sprintf "Contacting server..." + +let repeat = + Prefs.createString "repeat" "" + "!synchronize repeatedly (text interface only)" + ("Setting this preference causes the text-mode interface to synchronize " + ^ "repeatedly, rather than doing it just once and stopping. If the " + ^ "argument is a number, Unison will pause for that many seconds before " + ^ "beginning again.") + +(* ^ "If the argument is a path, Unison will wait for the " + ^ "file at this path---called a {\\em changelog}---to " + ^ "be modified (on either the client or the server " + ^ "machine), read the contents of the changelog (which should be a newline-" + ^ "separated list of paths) on both client and server, " + ^ "combine the results, " + ^ "and start again, using the list of paths read from the changelogs as the " + ^ " '-path' preference for the new run. The idea is that an external " + ^ "process will watch the filesystem and, when it thinks something may have " + ^ "changed, write the changed pathname to its local changelog where Unison " + ^ "will find it the next time it looks. If the changelogs have not been " + ^ "modified, Unison will wait, checking them again every few seconds." +*) + +let retry = + Prefs.createInt "retry" 0 + "!re-try failed synchronizations N times (text ui only)" + ("Setting this preference causes the text-mode interface to try again " + ^ "to synchronize " + ^ "updated paths where synchronization fails. Each such path will be " + ^ "tried N times." + ) + +let confirmmerge = + Prefs.createBool "confirmmerge" false + "!ask for confirmation before commiting results of a merge" + ("Setting this preference causes both the text and graphical interfaces" + ^ " to ask the user if the results of a merge command may be commited " + ^ " to the replica or not. Since the merge command works on temporary files," + ^ " the user can then cancel all the effects of applying the merge if it" + ^ " turns out that the result is not satisfactory. In " + ^ " batch-mode, this preference has no effect. Default is false.") + +let runTestsPrefName = "selftest" +let runtests = + Prefs.createBool runTestsPrefName false + "!run internal tests and exit" + ("Run internal tests and exit. This option is mostly for developers and must be used " + ^ "carefully: in particular, " + ^ "it will delete the contents of both roots, so that it can install its own files " + ^ "for testing. This flag only makes sense on the command line. When it is " + ^ "provided, no preference file is read: all preferences must be specified on the" + ^ "command line. Also, since the self-test procedure involves overwriting the roots " + ^ "and backup directory, the names of the roots and of the backupdir preference " + ^ "must include the string " + ^ "\"test\" or else the tests will be aborted. (If these are not given " + ^ "on the command line, dummy " + ^ "subdirectories in the current directory will be created automatically.)") + +(* This ref is set to Test.test during initialization, avoiding a circular + dependency *) +let testFunction = ref (fun () -> assert false) + +(********************************************************************** + Formatting functions + **********************************************************************) + +(* When no archives were found, we omit 'new' in status descriptions, since + *all* files would be marked new and this won't make sense to the user. *) +let choose s1 s2 = if !Update.foundArchives then s1 else s2 + +let showprev = + Prefs.createBool "showprev" false + "*Show previous properties, if they differ from current" + "" + +(* The next function produces nothing unless the "showprev" + preference is set. This is because it tends to make the + output trace too long and annoying. *) +let prevProps newprops ui = + if not (Prefs.read showprev) then "" + else match ui with + NoUpdates | Error _ + -> "" + | Updates (_, New) -> + " (new)" + | Updates (_, Previous(_,oldprops,_,_)) -> + (* || Props.similar newprops oldprops *) + " (was: "^(Props.toString oldprops)^")" + +let replicaContent2string rc sep = + let (typ, status, desc, ui) = rc in + let d s = s ^ sep ^ Props.toString desc ^ prevProps desc ui in + match typ, status with + `ABSENT, `Unchanged -> + "absent" + | _, `Unchanged -> + "unchanged " + ^(Util.truncateString (Fileinfo.type2string typ) 7) + ^ sep + ^(Props.toString desc) + | `ABSENT, `Deleted -> "deleted" + | `FILE, `Created -> + d (choose "new file " "file ") + | `FILE, `Modified -> + d "changed file " + | `FILE, `PropsChanged -> + d "changed props " + | `SYMLINK, `Created -> + d (choose "new symlink " "symlink ") + | `SYMLINK, `Modified -> + d "changed symlink " + | `DIRECTORY, `Created -> + d (choose "new dir " "dir ") + | `DIRECTORY, `Modified -> + d "changed dir " + | `DIRECTORY, `PropsChanged -> + d "dir props changed" + + (* Some cases that can't happen... *) + | `ABSENT, (`Created | `Modified | `PropsChanged) + | `SYMLINK, `PropsChanged + | (`FILE|`SYMLINK|`DIRECTORY), `Deleted -> + assert false + +let replicaContent2shortString rc = + let (typ, status, _, _) = rc in + match typ, status with + _, `Unchanged -> " " + | `ABSENT, `Deleted -> "deleted " + | `FILE, `Created -> choose "new file" "file " + | `FILE, `Modified -> "changed " + | `FILE, `PropsChanged -> "props " + | `SYMLINK, `Created -> choose "new link" "link " + | `SYMLINK, `Modified -> "chgd lnk" + | `DIRECTORY, `Created -> choose "new dir " "dir " + | `DIRECTORY, `Modified -> "chgd dir" + | `DIRECTORY, `PropsChanged -> "props " + (* Cases that can't happen... *) + | `ABSENT, (`Created | `Modified | `PropsChanged) + | `SYMLINK, `PropsChanged + | (`FILE|`SYMLINK|`DIRECTORY), `Deleted + -> assert false + +let roots2niceStrings length = function + (Local,fspath1), (Local,fspath2) -> + let name1, name2 = Fspath.differentSuffix fspath1 fspath2 in + (Util.truncateString name1 length, Util.truncateString name2 length) + | (Local,fspath1), (Remote host, fspath2) -> + (Util.truncateString "local" length, Util.truncateString host length) + | (Remote host, fspath1), (Local,fspath2) -> + (Util.truncateString host length, Util.truncateString "local" length) + | _ -> assert false (* BOGUS? *) + +let details2string theRi sep = + match theRi.replicas with + Problem s -> + Printf.sprintf "Error: %s\n" s + | Different(rc1, rc2, _, _) -> + let root1str, root2str = + roots2niceStrings 12 (Globals.roots()) in + Printf.sprintf "%s : %s\n%s : %s" + root1str (replicaContent2string rc1 sep) + root2str (replicaContent2string rc2 sep) + +let displayPath previousPath path = + let previousNames = Path.toNames previousPath in + let names = Path.toNames path in + if names = [] then "/" else + (* Strip the greatest common prefix of previousNames and names + from names. level is the number of names in the greatest + common prefix. *) + let rec loop level names1 names2 = + match (names1,names2) with + (hd1::tl1,hd2::tl2) -> + if Name.compare hd1 hd2 = 0 + then loop (level+1) tl1 tl2 + else (level,names2) + | _ -> (level,names2) in + let (level,suffixNames) = loop 0 previousNames names in + let suffixPath = + Safelist.fold_left Path.child Path.empty suffixNames in + let spaces = String.make (level*3) ' ' in + spaces ^ (Path.toString suffixPath) + +let roots2string () = + let replica1, replica2 = roots2niceStrings 12 (Globals.roots()) in + (Printf.sprintf "%s %s " replica1 replica2) + +let direction2niceString = function + Conflict -> "<-?->" + | Replica1ToReplica2 -> "---->" + | Replica2ToReplica1 -> "<----" + | Merge -> "<-M->" + +let reconItem2string oldPath theRI status = + let theLine = + match theRI.replicas with + Problem s -> + " error " ^ status + | Different(rc1, rc2, dir, _) -> + let signs = + Printf.sprintf "%s %s %s" + (replicaContent2shortString rc1) + (direction2niceString (!dir)) + (replicaContent2shortString rc2) in + Printf.sprintf "%s %s" signs status in + Printf.sprintf "%s %s" theLine (displayPath oldPath theRI.path) + +let exn2string = function + Sys.Break -> "Terminated!" + | Util.Fatal(s) -> Printf.sprintf "Fatal error: %s" s + | Util.Transient(s) -> Printf.sprintf "Error: %s" s + | other -> Printf.sprintf "Uncaught exception %s" (Printexc.to_string other) + +(* precondition: uc = File (Updates(_, ..) on both sides *) +let showDiffs ri printer errprinter id = + let p = ri.path in + match ri.replicas with + Problem _ -> + errprinter + "Can't diff files: there was a problem during update detection" + | Different((`FILE, _, _, ui1), (`FILE, _, _, ui2), _, _) -> + let (root1,root2) = Globals.roots() in + begin + try Files.diff root1 p ui1 root2 p ui2 printer id + with Util.Transient e -> errprinter e + end + | Different _ -> + errprinter "Can't diff: path doesn't refer to a file in both replicas" + + +exception Synch_props of Common.reconItem + +(********************************************************************** + Common error messages + **********************************************************************) + +let dangerousPathMsg dangerousPaths = + if dangerousPaths = [Path.empty] then + "The root of one of the replicas has been completely emptied.\n\ + Unison may delete everything in the other replica. (Set the \n\ + 'confirmbigdel' preference to false to disable this check.)" + else + Printf.sprintf + "The following paths have been completely emptied in one replica:\n \ + %s\n\ + Unison may delete everything below these paths in the other replica.\n + (Set the 'confirmbigdel' preference to false to disable this check.)" + (String.concat "\n " + (Safelist.map (fun p -> "'" ^ (Path.toString p) ^ "'") + dangerousPaths)) + +(********************************************************************** + Useful patterns for ignoring paths + **********************************************************************) + +let quote s = + let len = String.length s in + let buf = String.create (2 * len) in + let pos = ref 0 in + for i = 0 to len - 1 do + match s.[i] with + '*' | '?' | '[' | '{' as c -> + buf.[!pos] <- '\\'; buf.[!pos + 1] <- c; pos := !pos + 2 + | c -> + buf.[!pos] <- c; pos := !pos + 1 + done; + "{" ^ String.sub buf 0 !pos ^ "}" + +let ignorePath path = "Path " ^ quote (Path.toString path) + +let ignoreName path = + match Path.finalName path with + Some name -> "Name " ^ quote (Name.toString name) + | None -> assert false + +let ignoreExt path = + match Path.finalName path with + Some name -> + let str = Name.toString name in + begin try + let pos = String.rindex str '.' in + let ext = String.sub str pos (String.length str - pos) in + "Name {,.}*" ^ quote ext + with Not_found -> (* str does not contain '.' *) + "Name " ^ quote str + end + | None -> + assert false + +let addIgnorePattern theRegExp = + if theRegExp = "Path " then + raise (Util.Transient "Can't ignore the root path!"); + Globals.addRegexpToIgnore theRegExp; + let r = Prefs.add "ignore" theRegExp in + Trace.status r; + (* Make sure the server has the same ignored paths (in case, for + example, we do a "rescan") *) + Lwt_unix.run (Globals.propagatePrefs ()) + +(********************************************************************** + Profile and command-line parsing + **********************************************************************) + +let coreUsageMsg = + "Usage: " ^ Uutil.myName + ^ " [options]\n" + ^ " or " ^ Uutil.myName + ^ " root1 root2 [options]\n" + ^ " or " ^ Uutil.myName + ^ " profilename [options]\n" + +let shortUsageMsg = + coreUsageMsg ^ "\n" + ^ "For a list of options, type \"" ^ Uutil.myName ^ " -help\".\n" + ^ "For a tutorial on basic usage, type \"" ^ Uutil.myName + ^ " -doc tutorial\".\n" + ^ "For other documentation, type \"" ^ Uutil.myName ^ " -doc topics\".\n" + +let usageMsg = coreUsageMsg + +let debug = Trace.debug "startup" + +(* ---- *) + +(* Determine the case sensitivity of a root (does filename FOO==foo?) *) +let architecture = + Remote.registerRootCmd + "architecture" + (fun (_,()) -> return (Util.osType = `Win32, Osx.isMacOSX)) + +(* During startup the client determines the case sensitivity of each root. + If any root is case insensitive, all roots must know this -- it's + propagated in a pref. *) +(* FIX: this does more than check case sensitivity, it also detects + HFS (needed for resource forks) and Windows (needed for permissions)... + needs a new name *) +let checkCaseSensitivity () = + Globals.allRootsMap (fun r -> architecture r ()) >>= (fun archs -> + let someHostIsRunningWindows = + Safelist.exists (fun (isWin, _) -> isWin) archs in + let allHostsAreRunningWindows = + Safelist.for_all (fun (isWin, _) -> isWin) archs in + let someHostRunningOsX = + Safelist.exists (fun (_, isOSX) -> isOSX) archs in + let someHostIsCaseInsensitive = + someHostIsRunningWindows || someHostRunningOsX in + Case.init someHostIsCaseInsensitive; + Props.init someHostIsRunningWindows; + Osx.init someHostRunningOsX; + Prefs.set Globals.someHostIsRunningWindows someHostIsRunningWindows; + Prefs.set Globals.allHostsAreRunningWindows allHostsAreRunningWindows; + return ()) + +(* ---- *) + +let promptForRoots getFirstRoot getSecondRoot = + (* Ask the user for the roots *) + let r1 = match getFirstRoot() with None -> exit 0 | Some r -> r in + let r2 = match getSecondRoot() with None -> exit 0 | Some r -> r in + (* Remember them for this run, ordering them so that the first + will come out on the left in the UI *) + Globals.setRawRoots [r2;r1]; + (* Save them in the current profile *) + ignore (Prefs.add "root" r1); + ignore (Prefs.add "root" r2) + +(* ---- *) + +(* The first time we load preferences, we also read the command line + arguments; if we re-load prefs (because the user selected a new profile) + we ignore the command line *) +let firstTime = ref(true) + +(* BCP: WARNING: Some of the code from here is duplicated in uimacbridge...! *) +let initPrefs ~profileName ~displayWaitMessage ~getFirstRoot ~getSecondRoot + ~termInteract = + (* Restore prefs to their default values, if necessary *) + if not !firstTime then Prefs.resetToDefaults(); + + (* Tell the preferences module the name of the profile *) + Prefs.profileName := Some(profileName); + + (* Check whether the -selftest flag is present on the command line *) + let testFlagPresent = + Util.StringMap.mem runTestsPrefName (Prefs.scanCmdLine usageMsg) in + + (* If the -selftest flag is present, then we skip loading the preference file. + (This is prevents possible confusions where settings from a preference + file could cause unit tests to fail.) *) + if not testFlagPresent then begin + (* If the profile does not exist, create an empty one (this should only + happen if the profile is 'default', since otherwise we will already + have checked that the named one exists). *) + if not(Sys.file_exists (Prefs.profilePathname profileName)) then + Prefs.addComment "Unison preferences file"; + + (* Load the profile *) + (debug (fun() -> Util.msg "about to load prefs"); + Prefs.loadTheFile()); + + (* Now check again that the -selftest flag has not been set, and barf otherwise *) + if Prefs.read runtests then raise (Util.Fatal + "The 'test' flag should only be given on the command line") + end; + + (* Parse the command line. This will override settings from the profile. *) + if !firstTime then begin + debug (fun() -> Util.msg "about to parse command line"); + Prefs.parseCmdLine usageMsg; + end; + + (* Install dummy roots and backup directory if we are running self-tests *) + if Prefs.read runtests then begin + if Globals.rawRoots() = [] then + Prefs.loadStrings ["root = test-a.tmp"; "root = test-b.tmp"]; + if (Prefs.read Stasher.backupdir) = "" then + Prefs.loadStrings ["backupdir = test-backup.tmp"]; + end; + + (* Print the preference settings *) + debug (fun() -> Prefs.dumpPrefsToStderr() ); + + (* If no roots are given either on the command line or in the profile, + ask the user *) + if Globals.rawRoots() = [] then begin + promptForRoots getFirstRoot getSecondRoot; + end; + + (* The following step contacts the server, so warn the user it could take + some time *) + if !firstTime && (not (Prefs.read contactquietly || Prefs.read Trace.terse)) then + displayWaitMessage(); + + (* Canonize the names of the roots, sort them (with local roots first), + and install them in Globals. *) + Lwt_unix.run (Globals.installRoots termInteract); + + (* If both roots are local, disable the xferhint table to save time *) + begin match Globals.roots() with + ((Local,_),(Local,_)) -> Prefs.set Xferhint.xferbycopying false + | _ -> () + end; + + (* FIX: This should be before Globals.installRoots *) + (* Check to be sure that there is at most one remote root *) + let numRemote = + Safelist.fold_left + (fun n (w,_) -> match w with Local -> n | Remote _ -> n+1) + 0 + (Globals.rootsList()) in + if numRemote > 1 then + raise(Util.Fatal "cannot synchronize more than one remote root"); + + (* If no paths were specified, then synchronize the whole replicas *) + if Prefs.read Globals.paths = [] then Prefs.set Globals.paths [Path.empty]; + + (* Expand any "wildcard" paths [with final component *] *) + Globals.expandWildcardPaths(); + + Update.storeRootsName (); + + if not (Prefs.read contactquietly || Prefs.read Trace.terse) then + Util.msg "Connected [%s]\n" + (Util.replacesubstring (Update.getRootsName()) ", " " -> "); + + debug (fun() -> + Printf.eprintf "Roots: \n"; + Safelist.iter (fun clr -> Printf.eprintf " %s\n" clr) + (Globals.rawRoots ()); + Printf.eprintf " i.e. \n"; + Safelist.iter (fun clr -> Printf.eprintf " %s\n" + (Clroot.clroot2string (Clroot.parseRoot clr))) + (Globals.rawRoots ()); + Printf.eprintf " i.e. (in canonical order)\n"; + Safelist.iter (fun r -> + Printf.eprintf " %s\n" (root2string r)) + (Globals.rootsInCanonicalOrder()); + Printf.eprintf "\n"); + + Recon.checkThatPreferredRootIsValid(); + + Lwt_unix.run + (checkCaseSensitivity () >>= + Globals.propagatePrefs); + + (* Initializes some backups stuff according to the preferences just loaded from the profile. + Important to do it here, after prefs are propagated, because the function will also be + run on the server, if any. Also, this should be done each time a profile is reloaded + on this side, that's why it's here. *) + Stasher.initBackups (); + + firstTime := false + +(********************************************************************** + Common startup sequence + **********************************************************************) + +let anonymousArgs = + Prefs.createStringList "rest" + "*roots or profile name" "" + +let testServer = + Prefs.createBool "testserver" false + "exit immediately after the connection to the server" + ("Setting this flag on the command line causes Unison to attempt to " + ^ "connect to the remote server and, if successful, print a message " + ^ "and immediately exit. Useful for debugging installation problems. " + ^ "Should not be set in preference files.") + +(* For backward compatibility *) +let _ = Prefs.alias testServer "testServer" + +(* ---- *) + +let uiInit + ~(reportError : string -> unit) + ~(tryAgainOrQuit : string -> bool) + ~(displayWaitMessage : unit -> unit) + ~(getProfile : unit -> string option) + ~(getFirstRoot : unit -> string option) + ~(getSecondRoot : unit -> string option) + ~(termInteract : (string -> string -> string) option) = + + (* Make sure we have a directory for archives and profiles *) + Os.createUnisonDir(); + + (* Extract any command line profile or roots *) + let clprofile = ref None in + begin + try + let args = Prefs.scanCmdLine usageMsg in + match Util.StringMap.find "rest" args with + [] -> () + | [profile] -> clprofile := Some profile + | [root1;root2] -> Globals.setRawRoots [root1;root2] + | [root1;root2;profile] -> + Globals.setRawRoots [root1;root2]; + clprofile := Some profile + | _ -> + (reportError(Printf.sprintf + "%s was invoked incorrectly (too many roots)" Uutil.myName); + exit 1) + with Not_found -> () + end; + + (* Print header for debugging output *) + debug (fun() -> + Printf.eprintf "%s, version %s\n\n" Uutil.myName Uutil.myVersion); + debug (fun() -> Util.msg "initializing UI"); + + debug (fun () -> + (match !clprofile with + None -> Util.msg "No profile given on command line" + | Some s -> Printf.eprintf "Profile '%s' given on command line" s); + (match Globals.rawRoots() with + [] -> Util.msg "No roots given on command line" + | [root1;root2] -> + Printf.eprintf "Roots '%s' and '%s' given on command line" + root1 root2 + | _ -> assert false)); + + let profileName = + begin match !clprofile with + None -> + let dirString = Fspath.toString Os.unisonDir in + let profiles_exist = (Files.ls dirString "*.prf")<>[] in + let clroots_given = (Globals.rawRoots() <> []) in + let n = + if profiles_exist && not(clroots_given) then begin + (* Unison has been used before: at least one profile exists. + Ask the user to choose a profile or create a new one. *) + clprofile := getProfile(); + match !clprofile with + None -> exit 0 (* None means the user wants to quit *) + | Some x -> x + end else begin + (* First time use, OR roots given on command line. + In either case, the profile should be the default. *) + clprofile := Some "default"; + "default" + end in + n + | Some n -> + let f = Prefs.profilePathname n in + if not(Sys.file_exists f) + then (reportError (Printf.sprintf "Profile %s does not exist" f); + exit 1); + n + end in + + (* Load the profile and command-line arguments *) + initPrefs + profileName displayWaitMessage getFirstRoot getSecondRoot termInteract; + + (* Turn on GC messages, if the '-debug gc' flag was provided *) + if Trace.enabled "gc" then Gc.set {(Gc.get ()) with Gc.verbose = 0x3F}; + + if Prefs.read testServer then exit 0; + + (* BCPFIX: Should/can this be done earlier?? *) + Files.processCommitLogs(); + + (* Run unit tests if requested *) + if Prefs.read runtests then begin + (!testFunction)(); + exit 0 + end + +(* Exit codes *) +let perfectExit = 0 (* when everything's okay *) +let skippyExit = 1 (* when some items were skipped, but no failure occurred *) +let failedExit = 2 (* when there's some non-fatal failure *) +let fatalExit = 3 (* when fatal failure occurred *) +let exitCode = function + (false, false) -> 0 + | (true, false) -> 1 + | _ -> 2 +(* (anySkipped?, anyFailure?) -> exit code *) Deleted: branches/2.32/src/uicommon.mli =================================================================== --- trunk/src/uicommon.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/uicommon.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,114 +0,0 @@ -(* Unison file synchronizer: src/uicommon.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* Kinds of UI *) -type interface = - Text - | Graphic - -(* The interface of a concrete UI implementation *) -module type UI = -sig - val start : interface -> unit - val defaultUi : interface -end - -(* User preference: when true, ask fewer questions *) -val auto : bool Prefs.t - -(* User preference: How tall to make the main window in the GTK ui *) -val mainWindowHeight : int Prefs.t - -(* User preference: Should we reuse top-level windows as much as possible? *) -val reuseToplevelWindows : bool Prefs.t - -(* User preference: Expert mode *) -val expert : bool Prefs.t - -(* User preference: Whether to display 'contacting server' message *) -val contactquietly : bool Prefs.t - -(* User preference: The 'contacting server' message itself *) -val contactingServerMsg : unit -> string - -(* User preference: Descriptive label for this profile *) -val profileLabel : string Prefs.t - -(* User preference: Synchronize repeatedly *) -val repeat : string Prefs.t - -(* User preference: Try failing paths N times *) -val retry : int Prefs.t - -(* User preference: confirmation before commiting merge results *) -val confirmmerge : bool Prefs.t - -(* Format the information about current contents of a path in one replica (the second argument - is used as a separator) *) -val details2string : Common.reconItem -> string -> string - -(* Format a path, eliding initial components that are the same as the - previous path *) -val displayPath : Path.t -> Path.t -> string - -(* Format the names of the roots for display at the head of the - corresponding columns in the UI *) -val roots2string : unit -> string - -(* Format a reconItem (and its status string) for display, eliding - initial components that are the same as the previous path *) -val reconItem2string : Path.t -> Common.reconItem -> string -> string - -(* Format an exception for display *) -val exn2string : exn -> string - -(* Calculate and display differences for a file *) -val showDiffs : - Common.reconItem (* what path *) - -> (string->string->unit) (* how to display the (title and) result *) - -> (string->unit) (* how to display errors *) - -> Uutil.File.t (* id for transfer progress reports *) - -> unit - -val dangerousPathMsg : Path.t list -> string - -(* Utilities for adding ignore patterns *) -val ignorePath : Path.t -> string -val ignoreName : Path.t -> string -val ignoreExt : Path.t -> string -val addIgnorePattern : string -> unit - -val usageMsg : string - -val shortUsageMsg : string - -val uiInit : - reportError:(string -> unit) -> - tryAgainOrQuit:(string -> bool) -> - displayWaitMessage:(unit -> unit) -> - getProfile:(unit -> string option) -> - getFirstRoot:(unit -> string option) -> - getSecondRoot:(unit -> string option) -> - termInteract:(string -> string -> string) option -> - unit - -val initPrefs : - profileName:string -> - displayWaitMessage:(unit->unit) -> - getFirstRoot:(unit->string option) -> - getSecondRoot:(unit->string option) -> - termInteract:(string -> string -> string) option -> - unit - -val checkCaseSensitivity : unit -> unit Lwt.t - -(* Exit codes *) -val perfectExit: int (* when everything's okay *) -val skippyExit: int (* when some items were skipped, but no failure occurred *) -val failedExit: int (* when there's some non-fatal failure *) -val fatalExit: int (* when fatal failure occurred *) -val exitCode: bool * bool -> int -(* (anySkipped?, anyFailure?) -> exit code *) - -(* Initialization *) -val testFunction : (unit->unit) ref Copied: branches/2.32/src/uicommon.mli (from rev 320, trunk/src/uicommon.mli) =================================================================== --- branches/2.32/src/uicommon.mli (rev 0) +++ branches/2.32/src/uicommon.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,114 @@ +(* Unison file synchronizer: src/uicommon.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +(* Kinds of UI *) +type interface = + Text + | Graphic + +(* The interface of a concrete UI implementation *) +module type UI = +sig + val start : interface -> unit + val defaultUi : interface +end + +(* User preference: when true, ask fewer questions *) +val auto : bool Prefs.t + +(* User preference: How tall to make the main window in the GTK ui *) +val mainWindowHeight : int Prefs.t + +(* User preference: Should we reuse top-level windows as much as possible? *) +val reuseToplevelWindows : bool Prefs.t + +(* User preference: Expert mode *) +val expert : bool Prefs.t + +(* User preference: Whether to display 'contacting server' message *) +val contactquietly : bool Prefs.t + +(* User preference: The 'contacting server' message itself *) +val contactingServerMsg : unit -> string + +(* User preference: Descriptive label for this profile *) +val profileLabel : string Prefs.t + +(* User preference: Synchronize repeatedly *) +val repeat : string Prefs.t + +(* User preference: Try failing paths N times *) +val retry : int Prefs.t + +(* User preference: confirmation before commiting merge results *) +val confirmmerge : bool Prefs.t + +(* Format the information about current contents of a path in one replica (the second argument + is used as a separator) *) +val details2string : Common.reconItem -> string -> string + +(* Format a path, eliding initial components that are the same as the + previous path *) +val displayPath : Path.t -> Path.t -> string + +(* Format the names of the roots for display at the head of the + corresponding columns in the UI *) +val roots2string : unit -> string + +(* Format a reconItem (and its status string) for display, eliding + initial components that are the same as the previous path *) +val reconItem2string : Path.t -> Common.reconItem -> string -> string + +(* Format an exception for display *) +val exn2string : exn -> string + +(* Calculate and display differences for a file *) +val showDiffs : + Common.reconItem (* what path *) + -> (string->string->unit) (* how to display the (title and) result *) + -> (string->unit) (* how to display errors *) + -> Uutil.File.t (* id for transfer progress reports *) + -> unit + +val dangerousPathMsg : Path.t list -> string + +(* Utilities for adding ignore patterns *) +val ignorePath : Path.t -> string +val ignoreName : Path.t -> string +val ignoreExt : Path.t -> string +val addIgnorePattern : string -> unit + +val usageMsg : string + +val shortUsageMsg : string + +val uiInit : + reportError:(string -> unit) -> + tryAgainOrQuit:(string -> bool) -> + displayWaitMessage:(unit -> unit) -> + getProfile:(unit -> string option) -> + getFirstRoot:(unit -> string option) -> + getSecondRoot:(unit -> string option) -> + termInteract:(string -> string -> string) option -> + unit + +val initPrefs : + profileName:string -> + displayWaitMessage:(unit->unit) -> + getFirstRoot:(unit->string option) -> + getSecondRoot:(unit->string option) -> + termInteract:(string -> string -> string) option -> + unit + +val checkCaseSensitivity : unit -> unit Lwt.t + +(* Exit codes *) +val perfectExit: int (* when everything's okay *) +val skippyExit: int (* when some items were skipped, but no failure occurred *) +val failedExit: int (* when there's some non-fatal failure *) +val fatalExit: int (* when fatal failure occurred *) +val exitCode: bool * bool -> int +(* (anySkipped?, anyFailure?) -> exit code *) + +(* Initialization *) +val testFunction : (unit->unit) ref Deleted: branches/2.32/src/uigtk2.ml =================================================================== --- trunk/src/uigtk2.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/uigtk2.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,2478 +0,0 @@ -(* Unison file synchronizer: src/uigtk2.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -open Common -open Lwt - -module Private = struct - -let debug = Trace.debug "ui" - -let myNameCapitalized = String.capitalize Uutil.myName - -(********************************************************************** - LOW-LEVEL STUFF - **********************************************************************) - -(********************************************************************** - Some message strings (build them here because they look ugly in the - middle of other code. - **********************************************************************) - -let tryAgainMessage = - Printf.sprintf -"You can use %s to synchronize a local directory with another local directory, -or with a remote directory. - -Please enter the first (local) directory that you want to synchronize." -myNameCapitalized - -(* ---- *) - -let helpmessage = Printf.sprintf -"%s can synchronize a local directory with another local directory, or with -a directory on a remote machine. - -To synchronize with a local directory, just enter the file name. - -To synchronize with a remote directory, you must first choose a protocol -that %s will use to connect to the remote machine. Each protocol has -different requirements: - -1) To synchronize using SSH, there must be an SSH client installed on -this machine and an SSH server installed on the remote machine. You -must enter the host to connect to, a user name (if different from -your user name on this machine), and the directory on the remote machine -(relative to your home directory on that machine). - -2) To synchronize using RSH, there must be an RSH client installed on -this machine and an RSH server installed on the remote machine. You -must enter the host to connect to, a user name (if different from -your user name on this machine), and the directory on the remote machine -(relative to your home directory on that machine). - -3) To synchronize using %s's socket protocol, there must be a %s -server running on the remote machine, listening to the port that you -specify here. (Use \"%s -socket xxx\" on the remote machine to -start the %s server.) You must enter the host, port, and the directory -on the remote machine (relative to the working directory of the -%s server running on that machine)." -myNameCapitalized myNameCapitalized myNameCapitalized myNameCapitalized myNameCapitalized myNameCapitalized myNameCapitalized - -(********************************************************************** - Font preferences - **********************************************************************) - -let fontMonospaceMedium = - if Util.osType = `Win32 then - lazy (Gdk.Font.load "-*-Courier New-Medium-R-Normal--*-110-*-*-*-*-*-*") - else - lazy (Gdk.Font.load "-*-Clean-Medium-R-Normal--*-130-*-*-*-*-*-*") - -let fontMonospaceMediumPango = lazy (Pango.Font.from_string "monospace") - -(********************************************************************** - Unison icon - **********************************************************************) - -(* This does not work with the current version of Lablgtk, due to a bug -let icon = - GdkPixbuf.from_data ~width:48 ~height:48 ~has_alpha:true - (Gpointer.region_of_string Pixmaps.icon_data) -*) -let icon = - let p = GdkPixbuf.create ~width:48 ~height:48 ~has_alpha:true () in - Gpointer.blit - (Gpointer.region_of_string Pixmaps.icon_data) (GdkPixbuf.get_pixels p); - p - -(********************************************************************* - UI state variables - *********************************************************************) - -type stateItem = { mutable ri : reconItem; - mutable bytesTransferred : Uutil.Filesize.t; - mutable whatHappened : (Util.confirmation * string option) option} -let theState = ref [||] - -let current = ref None - -(* ---- *) - -let currentWindow = ref None - -let grabFocus t = - match !currentWindow with - Some w -> t#set_transient_for (w#as_window); - w#misc#set_sensitive false - | None -> () - -let releaseFocus () = - begin match !currentWindow with - Some w -> w#misc#set_sensitive true - | None -> () - end - -(********************************************************************* - Lock management - *********************************************************************) - -let busy = ref false - -let getLock f = - if !busy then - Trace.status "Synchronizer is busy, please wait.." - else begin - busy := true; f (); busy := false - end - -(********************************************************************** - Miscellaneous - **********************************************************************) - -let sync_action = ref None - -let gtk_sync () = - begin match !sync_action with - Some f -> f () - | None -> () - end; - while Glib.Main.iteration false do () done - -(********************************************************************** - CHARACTER SET TRANSCODING -***********************************************************************) - -(* Transcodage from Microsoft Windows Codepage 1252 to Unicode *) - -(* Unison currently uses the "ASCII" Windows filesystem API. With - this API, filenames are encoded using a proprietary character - encoding. This encoding depends on the Windows setup, but in - Western Europe, the Windows Codepage 1252 is usually used. - GTK, on the other hand, uses the UTF-8 encoding. This code perform - the translation from Codepage 1252 to UTF-8. A call to [transcode] - should be wrapped around every string below that might contain - non-ASCII characters. *) - -let code = - [| 0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15; 16; 17; 18; - 19; 20; 21; 22; 23; 24; 25; 26; 27; 28; 29; 30; 31; 32; 33; 34; - 35; 36; 37; 38; 39; 40; 41; 42; 43; 44; 45; 46; 47; 48; 49; 50; - 51; 52; 53; 54; 55; 56; 57; 58; 59; 60; 61; 62; 63; 64; 65; 66; - 67; 68; 69; 70; 71; 72; 73; 74; 75; 76; 77; 78; 79; 80; 81; 82; - 83; 84; 85; 86; 87; 88; 89; 90; 91; 92; 93; 94; 95; 96; 97; 98; - 99; 100; 101; 102; 103; 104; 105; 106; 107; 108; 109; 110; 111; - 112; 113; 114; 115; 116; 117; 118; 119; 120; 121; 122; 123; 124; - 125; 126; 127; 8364; 129; 8218; 131; 8222; 8230; 8224; 8225; 136; - 8240; 352; 8249; 346; 356; 381; 377; 144; 8216; 8217; 8220; 8221; - 8226; 8211; 8212; 152; 8482; 353; 8250; 347; 357; 382; 378; 160; - 711; 728; 321; 164; 260; 166; 167; 168; 169; 350; 171; 172; 173; - 174; 379; 176; 177; 731; 322; 180; 181; 182; 183; 184; 261; 351; - 187; 376; 733; 317; 380; 340; 193; 194; 258; 196; 313; 262; 199; - 268; 201; 280; 203; 282; 205; 206; 270; 272; 323; 327; 211; 212; - 336; 214; 215; 344; 366; 218; 368; 220; 221; 354; 223; 341; 225; - 226; 259; 228; 314; 263; 231; 269; 233; 281; 235; 283; 237; 238; - 271; 273; 324; 328; 243; 244; 337; 246; 247; 345; 367; 250; 369; - 252; 253; 355; 729 |] - -let rec transcodeRec buf s i l = - if i < l then begin - let c = code.(Char.code s.[i]) in - if c < 0x80 then - Buffer.add_char buf (Char.chr c) - else if c < 0x800 then begin - Buffer.add_char buf (Char.chr (c lsr 6 + 0xC0)); - Buffer.add_char buf (Char.chr (c land 0x3f + 0x80)) - end else if c < 0x10000 then begin - Buffer.add_char buf (Char.chr (c lsr 12 + 0xE0)); - Buffer.add_char buf (Char.chr ((c lsr 6) land 0x3f + 0x80)); - Buffer.add_char buf (Char.chr (c land 0x3f + 0x80)) - end; - transcodeRec buf s (i + 1) l - end - -let transcodeDoc s = - let buf = Buffer.create 1024 in - transcodeRec buf s 0 (String.length s); - Buffer.contents buf - -(****) - -let wf_utf8 = - [[('\x00', '\x7F')]; - [('\xC2', '\xDF'); ('\x80', '\xBF')]; - [('\xE0', '\xE0'); ('\xA0', '\xBF'); ('\x80', '\xBF')]; - [('\xE1', '\xEC'); ('\x80', '\xBF'); ('\x80', '\xBF')]; - [('\xED', '\xED'); ('\x80', '\x9F'); ('\x80', '\xBF')]; - [('\xEE', '\xEF'); ('\x80', '\xBF'); ('\x80', '\xBF')]; - [('\xF0', '\xF0'); ('\x90', '\xBF'); ('\x80', '\xBF'); ('\x80', '\xBF')]; - [('\xF1', '\xF3'); ('\x80', '\xBF'); ('\x80', '\xBF'); ('\x80', '\xBF')]; - [('\xF4', '\xF4'); ('\x80', '\x8F'); ('\x80', '\xBF'); ('\x80', '\xBF')]] - -let rec accept_seq l s i len = - match l with - [] -> - Some i - | (a, b) :: r -> - if i = len || s.[i] < a || s.[i] > b then - None - else - accept_seq r s (i + 1) len - -let rec accept_rec l s i len = - match l with - [] -> - None - | seq :: r -> - match accept_seq seq s i len with - None -> accept_rec r s i len - | res -> res - -let accept = accept_rec wf_utf8 - -(***) - -let rec validate_rec s i len = - i = len || - match accept s i len with - Some i -> validate_rec s i len - | None -> false - -let expl f s = f s 0 (String.length s) - -let validate = expl validate_rec - -(****) - -let protect_char buf c = - if c < '\x80' then - Buffer.add_char buf c - else - let c = Char.code c in - Buffer.add_char buf (Char.chr (c lsr 6 + 0xC0)); - Buffer.add_char buf (Char.chr (c land 0x3f + 0x80)) - -let rec protect_rec buf s i len = - if i = len then - Buffer.contents buf - else - match accept s i len with - Some i' -> - Buffer.add_substring buf s i (i' - i); - protect_rec buf s i' len - | None -> - protect_char buf s.[i]; - protect_rec buf s (i + 1) len - -(* Convert a string to UTF8 by keeping all UTF8 characters unchanged - and considering all other characters as ISO 8859-1 characters *) -let protect s = - let buf = Buffer.create (String.length s * 2) in - expl (protect_rec buf) s - -(****) - -let escapeMarkup s = Glib.Markup.escape_text s - -let transcode s = - try - Glib.Convert.locale_to_utf8 s - with Glib.Convert.Error _ -> - protect s - -let transcodeFilename s = - if Util.osType = `Win32 then transcode s else - try - Glib.Convert.filename_to_utf8 s - with Glib.Convert.Error _ -> - protect s - -(********************************************************************** - USEFUL LOW-LEVEL WIDGETS - **********************************************************************) - -class scrolled_text - ?(font=fontMonospaceMediumPango) ?editable ?word_wrap - ~width ~height ?packing ?show - () = - let sw = - GBin.scrolled_window ?packing ~show:false - ~hpolicy:`NEVER ~vpolicy:`AUTOMATIC () - in - let text = GText.view ?editable ?wrap_mode:(Some `WORD) ~packing:sw#add () in - object - inherit GObj.widget_full sw#as_widget - method text = text - method insert ?(font=fontMonospaceMediumPango) s = - text#buffer#set_text s; - method show () = sw#misc#show () - initializer - text#misc#modify_font (Lazy.force font); - text#misc#set_size_chars ~height ~width (); - if show <> Some false then sw#misc#show () - end - -(* ------ *) - -(* Display a message in a window and wait for the user - to hit the button. *) -let okBox ~title ~typ ~message = - let t = - GWindow.message_dialog - ~title ~message_type:typ ~message ~modal:true - ~buttons:GWindow.Buttons.ok () in - grabFocus t; - ignore (t#run ()); t#destroy (); - releaseFocus () - -(* ------ *) - -let primaryText msg = - Printf.sprintf "%s" - (escapeMarkup msg) - -(* twoBox: Display a message in a window and wait for the user - to hit one of two buttons. Return true if the first button is - chosen, false if the second button is chosen. *) -let twoBox ~title ~message ~astock ~bstock = - let t = - GWindow.dialog ~border_width:6 ~modal:true ~no_separator:true - ~allow_grow:false () in - t#vbox#set_spacing 12; - let h1 = GPack.hbox ~border_width:6 ~spacing:12 ~packing:t#vbox#pack () in - ignore (GMisc.image ~stock:`DIALOG_WARNING ~icon_size:`DIALOG - ~yalign:0. ~packing:h1#pack ()); - let v1 = GPack.vbox ~spacing:12 ~packing:h1#pack () in - ignore (GMisc.label - ~markup:(primaryText title ^ "\n\n" ^ escapeMarkup message) - ~selectable:true ~yalign:0. ~packing:v1#add ()); - t#add_button_stock bstock `NO; - t#add_button_stock astock `YES; - t#set_default_response `NO; - grabFocus t; t#show(); - let res = t#run () in - t#destroy (); releaseFocus (); - res = `YES - -(* ------ *) - -(* Avoid recursive invocations of the function below (a window receives - delete events even when it is not sensitive) *) -let inExit = ref false - -let doExit () = Lwt_unix.run (Update.unlockArchives ()); exit 0 - -let safeExit () = - if not !inExit then begin - inExit := true; - if not !busy then exit 0 else - if twoBox ~title:"Premature exit" - ~message:"Unison is working, exit anyway ?" - ~astock:`YES ~bstock:`NO - then exit 0; - inExit := false - end - -(* ------ *) - -(* warnBox: Display a warning message in a window and wait (unless - we're in batch mode) for the user to hit "OK" or "Exit". *) -let warnBox title message = - let message = transcode message in - if Prefs.read Globals.batch then begin - (* In batch mode, just pop up a window and go ahead *) - let t = - GWindow.dialog ~border_width:6 ~modal:true ~no_separator:true - ~allow_grow:false () in - t#vbox#set_spacing 12; - let h1 = GPack.hbox ~border_width:6 ~spacing:12 ~packing:t#vbox#pack () in - ignore (GMisc.image ~stock:`DIALOG_INFO ~icon_size:`DIALOG - ~yalign:0. ~packing:h1#pack ()); - let v1 = GPack.vbox ~spacing:12 ~packing:h1#pack () in - ignore (GMisc.label ~markup:(primaryText title ^ "\n\n" ^ - escapeMarkup message) - ~selectable:true ~yalign:0. ~packing:v1#add ()); - t#add_button_stock `CLOSE `CLOSE; - t#set_default_response `CLOSE; - ignore (t#connect#response ~callback:(fun _ -> t#destroy ())); - t#show () - end else begin - inExit := true; - let ok = twoBox ~title ~message ~astock:`OK ~bstock:`QUIT in - if not(ok) then doExit (); - inExit := false - end - -(********************************************************************** - HIGHER-LEVEL WIDGETS -***********************************************************************) - -(* -XXX -* Accurate write accounting: - - Local copies on the remote side are ignored - - What about failures? -*) -class stats width height = - let pixmap = GDraw.pixmap ~width ~height () in - let area = - pixmap#set_foreground `WHITE; - pixmap#rectangle ~filled:true ~x:0 ~y:0 ~width ~height (); - GMisc.pixmap pixmap ~width ~height ~xpad:4 ~ypad:8 () - in - object (self) - inherit GObj.widget_full area#as_widget - val mutable maxim = ref 0. - val mutable scale = ref 1. - val mutable min_scale = 1. - val values = Array.make width 0. - val mutable active = false - - method activate a = active <- a - - method scale h = truncate ((float height) *. h /. !scale) - - method private rect i v' v = - let h = self#scale v in - let h' = self#scale v' in - let h1 = min h' h in - let h2 = max h' h in - pixmap#set_foreground `BLACK; - pixmap#rectangle - ~filled:true ~x:i ~y:(height - h1) ~width:1 ~height:h1 (); - for h = h1 + 1 to h2 do - let v = truncate (65535. *. (float (h - h1) /. float (h2 - h1))) in - let v = (v / 4096) * 4096 in (* Only use 16 gray levels *) - pixmap#set_foreground (`RGB (v, v, v)); - pixmap#rectangle - ~filled:true ~x:i ~y:(height - h) ~width:1 ~height:1 (); - done - - method push v = - let need_max = values.(0) = !maxim in - for i = 0 to width - 2 do - values.(i) <- values.(i + 1) - done; - values.(width - 1) <- v; - if need_max then begin - maxim := 0.; - for i = 0 to width - 1 do maxim := max !maxim values.(i) done - end else - maxim := max !maxim v; - if active then begin - let need_resize = - !maxim > !scale || (!maxim > min_scale && !maxim < !scale /. 1.5) in - if need_resize then begin - scale := min_scale; - while !maxim > !scale do - scale := !scale *. 1.5 - done; - pixmap#set_foreground `WHITE; - pixmap#rectangle ~filled:true ~x:0 ~y:0 ~width ~height (); - pixmap#set_foreground `BLACK; - for i = 0 to width - 1 do - self#rect i values.(max 0 (i - 1)) values.(i) - done - end else begin - pixmap#put_pixmap ~x:0 ~y:0 ~xsrc:1 (pixmap#pixmap); - pixmap#set_foreground `WHITE; - pixmap#rectangle - ~filled:true ~x:(width - 1) ~y:0 ~width:1 ~height (); - self#rect (width - 1) values.(width - 2) values.(width - 1) - end; - area#misc#draw None - end - end - -let clientWritten = ref 0. -let serverWritten = ref 0. - -let statistics () = - let title = "Statistics" in - let t = GWindow.dialog ~title () in - let t_dismiss = GButton.button ~stock:`CLOSE ~packing:t#action_area#add () in - t_dismiss#grab_default (); - let dismiss () = t#misc#hide () in - ignore (t_dismiss#connect#clicked ~callback:dismiss); - ignore (t#event#connect#delete ~callback:(fun _ -> dismiss (); true)); - - let emission = new stats 320 50 in - t#vbox#pack ~expand:false ~padding:4 (emission :> GObj.widget); - let reception = new stats 320 50 in - t#vbox#pack ~expand:false ~padding:4 (reception :> GObj.widget); - - let lst = - GList.clist - ~packing:(t#vbox#add) - ~titles_active:false - ~titles:[""; "Client"; "Server"; "Total"] () - in - lst#set_column ~auto_resize:true 0; - lst#set_column ~auto_resize:true ~justification:`RIGHT 1; - lst#set_column ~auto_resize:true ~justification:`RIGHT 2; - lst#set_column ~auto_resize:true ~justification:`RIGHT 3; - ignore (lst#append ["Reception rate"]); - ignore (lst#append ["Data received"]); - ignore (lst#append ["File data written"]); - let style = lst#misc#style#copy in - (* BCP: Removed this on 6/13/2006 as a workaround for a bug reported - by Norman Ramsey. Apparently, lablgtl2 uses Gdk.Font, which is - deprecated; its associated operations don't work in recent versions - of gtk2. *) - (* style#set_font (Lazy.force fontMonospaceMedium); *) - for r = 0 to 2 do - lst#set_row ~selectable:false r; - for c = 1 to 3 do - lst#set_cell ~style r c - done - done; - - ignore (t#event#connect#map (fun _ -> - emission#activate true; - reception#activate true; - false)); - ignore (t#event#connect#unmap (fun _ -> - emission#activate false; - reception#activate false; - false)); - - let delay = 0.5 in - let a = 0.5 in - let b = 0.8 in - - let emittedBytes = ref 0. in - let emitRate = ref 0. in - let emitRate2 = ref 0. in - let receivedBytes = ref 0. in - let receiveRate = ref 0. in - let receiveRate2 = ref 0. in - let timeout _ = - emitRate := - a *. !emitRate +. - (1. -. a) *. (!Remote.emittedBytes -. !emittedBytes) /. delay; - emitRate2 := - b *. !emitRate2 +. - (1. -. b) *. (!Remote.emittedBytes -. !emittedBytes) /. delay; - emission#push !emitRate; - receiveRate := - a *. !receiveRate +. - (1. -. a) *. (!Remote.receivedBytes -. !receivedBytes) /. delay; - receiveRate2 := - b *. !receiveRate2 +. - (1. -. b) *. (!Remote.receivedBytes -. !receivedBytes) /. delay; - reception#push !receiveRate; - emittedBytes := !Remote.emittedBytes; - receivedBytes := !Remote.receivedBytes; - let kib2str v = Format.sprintf "%.0f B" v in - let rate2str v = - if v > 9.9e3 then begin - if v > 9.9e6 then - Format.sprintf "%4.0f MiB/s" (v /. 1e6) - else if v > 999e3 then - Format.sprintf "%4.1f MiB/s" (v /. 1e6) - else - Format.sprintf "%4.0f KiB/s" (v /. 1e3) - end else begin - if v > 990. then - Format.sprintf "%4.1f KiB/s" (v /. 1e3) - else if v > 99. then - Format.sprintf "%4.2f KiB/s" (v /. 1e3) - else - " " - end - in - lst#set_cell ~text:(rate2str !receiveRate2) 0 1; - lst#set_cell ~text:(rate2str !emitRate2) 0 2; - lst#set_cell ~text: - (rate2str (!receiveRate2 +. !emitRate2)) 0 3; - lst#set_cell ~text:(kib2str !receivedBytes) 1 1; - lst#set_cell ~text:(kib2str !emittedBytes) 1 2; - lst#set_cell ~text: - (kib2str (!receivedBytes +. !emittedBytes)) 1 3; - lst#set_cell ~text:(kib2str !clientWritten) 2 1; - lst#set_cell ~text:(kib2str !serverWritten) 2 2; - lst#set_cell ~text: - (kib2str (!clientWritten +. !serverWritten)) 2 3; - true - in - ignore (GMain.Timeout.add ~ms:(truncate (delay *. 1000.)) ~callback:timeout); - - t - -(****) - -(* Standard file dialog *) -let file_dialog ~title ~callback ?filename () = - let sel = GWindow.file_selection ~title ~modal:true ?filename () in - grabFocus sel; - ignore (sel#cancel_button#connect#clicked ~callback:sel#destroy); - ignore (sel#ok_button#connect#clicked ~callback: - (fun () -> - let name = sel#filename in - sel#destroy (); - callback name)); - sel#show (); - ignore (sel#connect#destroy ~callback:GMain.Main.quit); - GMain.Main.main (); - releaseFocus () - -(* ------ *) - -let fatalError message = - Trace.log (message ^ "\n"); - let title = "Fatal error" in - let t = - GWindow.dialog ~border_width:6 ~modal:true ~no_separator:true - ~allow_grow:false () in - t#vbox#set_spacing 12; - let h1 = GPack.hbox ~border_width:6 ~spacing:12 ~packing:t#vbox#pack () in - ignore (GMisc.image ~stock:`DIALOG_ERROR ~icon_size:`DIALOG - ~yalign:0. ~packing:h1#pack ()); - let v1 = GPack.vbox ~spacing:12 ~packing:h1#pack () in - ignore (GMisc.label - ~markup:(primaryText title ^ "\n\n" ^ - escapeMarkup (transcode message)) - ~selectable:true ~yalign:0. ~packing:v1#add ()); - t#add_button_stock `QUIT `QUIT; - t#set_default_response `QUIT; - grabFocus t; t#show(); ignore (t#run ()); t#destroy (); releaseFocus (); - exit 1 - -(* ------ *) - -let tryAgainOrQuit = fatalError - -(* ------ *) - -let getFirstRoot() = - let t = GWindow.dialog ~title:"Root selection" - ~modal:true ~allow_grow:true () in - t#misc#grab_focus (); - - let hb = GPack.hbox - ~packing:(t#vbox#pack ~expand:false ~padding:15) () in - ignore(GMisc.label ~text:tryAgainMessage - ~justify:`LEFT - ~packing:(hb#pack ~expand:false ~padding:15) ()); - - let f1 = GPack.hbox ~spacing:4 - ~packing:(t#vbox#pack ~expand:true ~padding:4) () in - ignore (GMisc.label ~text:"Dir:" ~packing:(f1#pack ~expand:false) ()); - let fileE = GEdit.entry ~packing:f1#add () in - fileE#misc#grab_focus (); - let browseCommand() = - file_dialog ~title:"Select a local directory" - ~callback:fileE#set_text ~filename:fileE#text () in - let b = GButton.button ~label:"Browse" - ~packing:(f1#pack ~expand:false) () in - ignore (b#connect#clicked ~callback:browseCommand); - - let f3 = t#action_area in - let result = ref None in - let contCommand() = - result := Some(fileE#text); - t#destroy () in - let contButton = GButton.button ~stock:`OK ~packing:f3#add () in - ignore (contButton#connect#clicked ~callback:contCommand); - ignore (fileE#connect#activate ~callback:contCommand); - contButton#grab_default (); - let quitButton = GButton.button ~stock:`QUIT ~packing:f3#add () in - ignore (quitButton#connect#clicked - ~callback:(fun () -> result := None; t#destroy())); - t#show (); - ignore (t#connect#destroy ~callback:GMain.Main.quit); - GMain.Main.main (); - match !result with None -> None - | Some file -> - Some(Clroot.clroot2string(Clroot.ConnectLocal(Some file))) - -(* ------ *) - -let getSecondRoot () = - let t = GWindow.dialog ~title:"Root selection" - ~modal:true ~allow_grow:true () in - t#misc#grab_focus (); - - let message = "Please enter the second directory you want to synchronize." in - - let vb = t#vbox in - let hb = GPack.hbox ~packing:(vb#pack ~expand:false ~padding:15) () in - ignore(GMisc.label ~text:message - ~justify:`LEFT - ~packing:(hb#pack ~expand:false ~padding:15) ()); - let helpB = GButton.button ~stock:`HELP ~packing:hb#add () in - ignore (helpB#connect#clicked - ~callback:(fun () -> okBox ~title:"Picking roots" ~typ:`INFO - ~message:helpmessage)); - - let result = ref None in - - let f = GPack.vbox ~packing:(vb#pack ~expand:false) () in - - let f1 = GPack.hbox ~spacing:4 ~packing:f#add () in - ignore (GMisc.label ~text:"Directory:" ~packing:(f1#pack ~expand:false) ()); - let fileE = GEdit.entry ~packing:f1#add () in - fileE#misc#grab_focus (); - let browseCommand() = - file_dialog ~title:"Select a local directory" - ~callback:fileE#set_text ~filename:fileE#text () in - let b = GButton.button ~label:"Browse" - ~packing:(f1#pack ~expand:false) () in - ignore (b#connect#clicked ~callback:browseCommand); - - let f0 = GPack.hbox ~spacing:4 ~packing:f#add () in - let localB = GButton.radio_button ~packing:(f0#pack ~expand:false) - ~label:"Local" () in - let sshB = GButton.radio_button ~group:localB#group - ~packing:(f0#pack ~expand:false) - ~label:"SSH" () in - let rshB = GButton.radio_button ~group:localB#group - ~packing:(f0#pack ~expand:false) ~label:"RSH" () in - let socketB = GButton.radio_button ~group:sshB#group - ~packing:(f0#pack ~expand:false) ~label:"Socket" () in - - let f2 = GPack.hbox ~spacing:4 ~packing:f#add () in - ignore (GMisc.label ~text:"Host:" ~packing:(f2#pack ~expand:false) ()); - let hostE = GEdit.entry ~packing:f2#add () in - - ignore (GMisc.label ~text:"(Optional) User:" - ~packing:(f2#pack ~expand:false) ()); - let userE = GEdit.entry ~packing:f2#add () in - - ignore (GMisc.label ~text:"Port:" - ~packing:(f2#pack ~expand:false) ()); - let portE = GEdit.entry ~packing:f2#add () in - - let varLocalRemote = ref (`Local : [`Local|`SSH|`RSH|`SOCKET]) in - let localState() = - varLocalRemote := `Local; - hostE#misc#set_sensitive false; - userE#misc#set_sensitive false; - portE#misc#set_sensitive false; - b#misc#set_sensitive true in - let remoteState() = - hostE#misc#set_sensitive true; - b#misc#set_sensitive false; - match !varLocalRemote with - `SOCKET -> - (portE#misc#set_sensitive true; userE#misc#set_sensitive false) - | _ -> - (portE#misc#set_sensitive false; userE#misc#set_sensitive true) in - let protoState x = - varLocalRemote := x; - remoteState() in - ignore (localB#connect#clicked ~callback:localState); - ignore (sshB#connect#clicked ~callback:(fun () -> protoState(`SSH))); - ignore (rshB#connect#clicked ~callback:(fun () -> protoState(`RSH))); - ignore (socketB#connect#clicked ~callback:(fun () -> protoState(`SOCKET))); - localState(); - let getRoot() = - let file = fileE#text in - let user = userE#text in - let host = hostE#text in - let port = portE#text in - match !varLocalRemote with - `Local -> - Clroot.clroot2string(Clroot.ConnectLocal(Some file)) - | `SSH | `RSH -> - Clroot.clroot2string( - Clroot.ConnectByShell((if !varLocalRemote=`SSH then "ssh" else "rsh"), - host, - (if user="" then None else Some user), - (if port="" then None else Some port), - Some file)) - | `SOCKET -> - Clroot.clroot2string( - (* FIX: report an error if the port entry is not well formed *) - Clroot.ConnectBySocket(host, - portE#text, - Some file)) in - let contCommand() = - try - let root = getRoot() in - result := Some root; - t#destroy () - with Failure "int_of_string" -> - if portE#text="" then - okBox ~title:"Error" ~typ:`ERROR ~message:"Please enter a port" - else okBox ~title:"Error" ~typ:`ERROR - ~message:"The port you specify must be an integer" - | _ -> - okBox ~title:"Error" ~typ:`ERROR - ~message:"Something's wrong with the values you entered, try again" in - let f3 = t#action_area in - let contButton = - GButton.button ~stock:`OK ~packing:f3#add () in - ignore (contButton#connect#clicked ~callback:contCommand); - contButton#grab_default (); - ignore (fileE#connect#activate ~callback:contCommand); - let quitButton = - GButton.button ~stock:`QUIT ~packing:f3#add () in - ignore (quitButton#connect#clicked ~callback:safeExit); - - t#show (); - ignore (t#connect#destroy ~callback:GMain.Main.quit); - GMain.Main.main (); - !result - -(* ------ *) - -let getPassword rootName msg = - let t = - GWindow.dialog ~title:"Unison: SSH connection" ~position:`CENTER - ~no_separator:true ~modal:true ~allow_grow:false ~border_width:6 () in - t#misc#grab_focus (); - - t#vbox#set_spacing 12; - - let header = - primaryText (Format.sprintf "Connecting to '%s'..." (protect rootName)) in - - let h1 = GPack.hbox ~border_width:6 ~spacing:12 ~packing:t#vbox#pack () in - (* FIX: DIALOG_AUTHENTICATION is way better but is not available - in the current release of LablGTK2... *) - ignore (GMisc.image ~stock:(*`DIALOG_AUTHENTICATION*)`DIALOG_QUESTION ~icon_size:`DIALOG - ~yalign:0. ~packing:h1#pack ()); - let v1 = GPack.vbox ~spacing:12 ~packing:h1#pack () in - ignore(GMisc.label ~markup:(header ^ "\n\n" ^ escapeMarkup (protect msg)) - ~selectable:true ~yalign:0. ~packing:v1#pack ()); - - let passwordE = GEdit.entry ~packing:v1#pack ~visibility:false () in - passwordE#misc#grab_focus (); - - t#add_button_stock `QUIT `QUIT; - t#add_button_stock `OK `OK; - t#set_default_response `OK; - ignore (passwordE#connect#activate ~callback:(fun _ -> t#response `OK)); - - grabFocus t; t#show(); - let res = t#run () in - let pwd = passwordE#text in - t#destroy (); releaseFocus (); - gtk_sync (); - begin match res with - `DELETE_EVENT | `QUIT -> safeExit (); "" - | `OK -> pwd - end - -let termInteract = Some getPassword - -(* ------ *) - -type profileInfo = {roots:string list; label:string option} - -(* ------ *) - -let profileKeymap = Array.create 10 None - -let provideProfileKey filename k profile info = - try - let i = int_of_string k in - if 0<=i && i<=9 then - match profileKeymap.(i) with - None -> profileKeymap.(i) <- Some(profile,info) - | Some(otherProfile,_) -> - raise (Util.Fatal - ("Error scanning profile "^filename^":\n" - ^ "shortcut key "^k^" is already bound to profile " - ^ otherProfile)) - else - raise (Util.Fatal - ("Error scanning profile "^filename^":\n" - ^ "Value of 'key' preference must be a single digit (0-9), " - ^ "not " ^ k)) - with int_of_string -> raise (Util.Fatal - ("Error scanning profile "^filename^":\n" - ^ "Value of 'key' preference must be a single digit (0-9), " - ^ "not " ^ k)) - -(* ------ *) - -let profilesAndRoots = ref [] - -let scanProfiles () = - Array.iteri (fun i _ -> profileKeymap.(i) <- None) profileKeymap; - profilesAndRoots := - (Safelist.map - (fun f -> - let f = Filename.chop_suffix f ".prf" in - let filename = Prefs.profilePathname f in - let fileContents = Safelist.map (fun (_, _, n, v) -> (n, v)) (Prefs.readAFile f) in - let roots = - Safelist.map snd - (Safelist.filter (fun (n, _) -> n = "root") fileContents) in - let label = - try Some(Safelist.assoc "label" fileContents) - with Not_found -> None in - let info = {roots=roots; label=label} in - (* If this profile has a 'key' binding, put it in the keymap *) - (try - let k = Safelist.assoc "key" fileContents in - provideProfileKey filename k f info - with Not_found -> ()); - (f, info)) - (Safelist.filter (fun name -> not ( Util.startswith name ".#" - || Util.startswith name Os.tempFilePrefix)) - (Files.ls (Fspath.toString Os.unisonDir) - "*.prf"))) - -let getProfile () = - (* The selected profile *) - let result = ref None in - - (* Build the dialog *) - let t = GWindow.dialog ~title:"Profiles" ~width:400 () in - - let cancelCommand _ = t#destroy (); exit 0 in - let cancelButton = GButton.button ~stock:`CANCEL - ~packing:t#action_area#add () in - ignore (cancelButton#connect#clicked ~callback:cancelCommand); - ignore (t#event#connect#delete ~callback:cancelCommand); - cancelButton#misc#set_can_default true; - - let okCommand() = - currentWindow := None; - t#destroy () in - let okButton = - GButton.button ~stock:`OK ~packing:t#action_area#add () in - ignore (okButton#connect#clicked ~callback:okCommand); - okButton#misc#set_sensitive false; - okButton#grab_default (); - - let vb = t#vbox in - - ignore (GMisc.label - ~text:"Select an existing profile or create a new one" - ~xpad:2 ~ypad:5 ~packing:(vb#pack ~expand:false) ()); - - let sw = - GBin.scrolled_window ~packing:(vb#pack ~expand:true) ~height:200 - ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in - let lst = GList.clist_poly ~selection_mode:`BROWSE ~packing:(sw#add) () in - let selRow = ref 0 in - let fillLst default = - scanProfiles(); - lst#freeze (); - lst#clear (); - let i = ref 0 in (* FIX: Work around a lablgtk bug *) - Safelist.iter - (fun (profile, info) -> - let labeltext = - match info.label with None -> "" | Some(l) -> " ("^l^")" in - let s = profile ^ labeltext in - ignore (lst#append [s]); - if profile = default then selRow := !i; - lst#set_row_data !i (profile, info); - incr i) - (Safelist.sort (fun (p, _) (p', _) -> compare p p') !profilesAndRoots); - let r = lst#rows in - let p = if r < 2 then 0. else float !selRow /. float (r - 1) in - lst#scroll_vertical `JUMP p; - lst#thaw () in - let tbl = - GPack.table ~rows:2 ~columns:2 ~packing:(vb#pack ~expand:true) () in - tbl#misc#set_sensitive false; - ignore (GMisc.label ~text:"Root 1:" ~xpad:2 - ~packing:(tbl#attach ~left:0 ~top:0 ~expand:`NONE) ()); - ignore (GMisc.label ~text:"Root 2:" ~xpad:2 - ~packing:(tbl#attach ~left:0 ~top:1 ~expand:`NONE) ()); - let root1 = - GEdit.entry ~packing:(tbl#attach ~left:1 ~top:0 ~expand:`X) - ~editable:false () in - let root2 = - GEdit.entry ~packing:(tbl#attach ~left:1 ~top:1 ~expand:`X) - ~editable:false () in - root1#misc#set_can_focus false; - root2#misc#set_can_focus false; - let hb = - GPack.hbox ~border_width:2 ~spacing:2 ~packing:(vb#pack ~expand:false) () - in - let nw = - GButton.button ~label:"Create new profile" - ~packing:(hb#pack ~expand:false) () in - ignore (nw#connect#clicked ~callback:(fun () -> - let t = - GWindow.dialog ~title:"New profile" ~modal:true () - in - let vb = GPack.vbox ~border_width:4 ~packing:t#vbox#add () in - let f = GPack.vbox ~packing:(vb#pack ~expand:true ~padding:4) () in - let f0 = GPack.hbox ~spacing:4 ~packing:f#add () in - ignore (GMisc.label ~text:"Profile name:" - ~packing:(f0#pack ~expand:false) ()); - let prof = GEdit.entry ~packing:f0#add () in - prof#misc#grab_focus (); - - let exit () = t#destroy (); GMain.Main.quit () in - ignore (t#event#connect#delete ~callback:(fun _ -> exit (); true)); - - let f3 = t#action_area in - let okCommand () = - let profile = prof#text in - if profile <> "" then - let filename = Prefs.profilePathname profile in - if Sys.file_exists filename then - okBox - ~title:"Error" ~typ:`ERROR - ~message:("Profile \"" - ^ (transcodeFilename profile) - ^ "\" already exists!\nPlease select another name.") - else - (* Make an empty file *) - let ch = - open_out_gen - [Open_wronly; Open_creat; Open_trunc] 0o600 filename in - close_out ch; - fillLst profile; - exit () in - let okButton = GButton.button ~stock:`OK ~packing:f3#add () in - ignore (okButton#connect#clicked ~callback:okCommand); - okButton#grab_default (); - let cancelButton = - GButton.button ~stock:`CANCEL ~packing:f3#add () in - ignore (cancelButton#connect#clicked ~callback:exit); - - t#show (); - grabFocus t; - GMain.Main.main (); - releaseFocus ())); - - ignore (lst#connect#unselect_row ~callback:(fun ~row:_ ~column:_ ~event:_ -> - root1#set_text ""; root2#set_text ""; - result := None; - tbl#misc#set_sensitive false; - okButton#misc#set_sensitive false)); - - let select_row i = - (* Inserting the first row triggers the signal, even before the row - data is set. So, we need to catch the corresponding exception *) - (try - let (profile, info) = lst#get_row_data i in - result := Some profile; - begin match info.roots with - [r1; r2] -> root1#set_text (protect r1); root2#set_text (protect r2); - tbl#misc#set_sensitive true - | _ -> root1#set_text ""; root2#set_text ""; - tbl#misc#set_sensitive false - end; - okButton#misc#set_sensitive true - with Gpointer.Null -> ()) in - - ignore (lst#connect#select_row - ~callback:(fun ~row:i ~column:_ ~event:_ -> select_row i)); - - ignore (lst#event#connect#button_press ~callback:(fun ev -> - match GdkEvent.get_type ev with - `TWO_BUTTON_PRESS -> - okCommand (); - true - | _ -> - false)); - fillLst "default"; - select_row !selRow; - lst#misc#grab_focus (); - currentWindow := Some (t :> GWindow.window_skel); - ignore (t#connect#destroy ~callback:GMain.Main.quit); - t#show (); - GMain.Main.main (); - !result - -(* ------ *) - -let documentation sect = - let title = "Documentation" in - let t = GWindow.dialog ~title () in - let t_dismiss = - GButton.button ~stock:`CLOSE ~packing:t#action_area#add () in - t_dismiss#grab_default (); - let dismiss () = t#destroy () in - ignore (t_dismiss#connect#clicked ~callback:dismiss); - ignore (t#event#connect#delete ~callback:(fun _ -> dismiss (); true)); - - let (name, docstr) = Safelist.assoc sect Strings.docs in - let docstr = transcodeDoc docstr in - let hb = GPack.hbox ~packing:(t#vbox#pack ~expand:false ~padding:2) () in - let optionmenu = - GMenu.option_menu ~packing:(hb#pack ~expand:true ~fill:false) () in - - let t_text = - new scrolled_text ~editable:false - ~width:80 ~height:20 ~packing:t#vbox#add () - in - t_text#insert docstr; - - let sect_idx = ref 0 in - let idx = ref 0 in - let menu = GMenu.menu () in - let addDocSection (shortname, (name, docstr)) = - if shortname <> "" && name <> "" then begin - if shortname = sect then sect_idx := !idx; - incr idx; - let item = GMenu.menu_item ~label:name ~packing:menu#append () in - let docstr = transcodeDoc docstr in - ignore - (item#connect#activate ~callback:(fun () -> t_text#insert docstr)) - end - in - Safelist.iter addDocSection Strings.docs; - optionmenu#set_menu menu; - optionmenu#set_history !sect_idx; - - t#show () - -(* ------ *) - -let messageBox ~title ?(action = fun t -> t#destroy) ?(modal = false) message = - let utitle = transcode title in - let t = GWindow.dialog ~title:utitle ~modal ~position:`CENTER () in - let t_dismiss = GButton.button ~stock:`CLOSE ~packing:t#action_area#add () in - t_dismiss#grab_default (); - ignore (t_dismiss#connect#clicked ~callback:(action t)); - let t_text = - new scrolled_text ~editable:false - ~width:80 ~height:20 ~packing:t#vbox#add () - in - t_text#insert message; - ignore (t#event#connect#delete ~callback:(fun _ -> action t (); true)); - t#show (); - if modal then begin - grabFocus t; - GMain.Main.main (); - releaseFocus () - end - -(* twoBoxAdvanced: Display a message in a window and wait for the user - to hit one of two buttons. Return true if the first button is - chosen, false if the second button is chosen. Also has a button for - showing more details to the user in a messageBox dialog *) -let twoBoxAdvanced ~title ~message ~longtext ~advLabel ~astock ~bstock = - let t = - GWindow.dialog ~border_width:6 ~modal:false ~no_separator:true - ~allow_grow:false () in - t#vbox#set_spacing 12; - let h1 = GPack.hbox ~border_width:6 ~spacing:12 ~packing:t#vbox#pack () in - ignore (GMisc.image ~stock:`DIALOG_WARNING ~icon_size:`DIALOG - ~yalign:0. ~packing:h1#pack ()); - let v1 = GPack.vbox ~spacing:12 ~packing:h1#pack () in - ignore (GMisc.label - ~markup:(primaryText title ^ "\n\n" ^ escapeMarkup message) - ~selectable:true ~yalign:0. ~packing:v1#add ()); - t#add_button_stock `CANCEL `NO; - let cmd () = - messageBox ~title:"Details" ~modal:false longtext - in - t#add_button advLabel `HELP; - t#add_button_stock `APPLY `YES; - t#set_default_response `NO; - let res = ref false in - let setRes signal = - match signal with - `YES -> res := true; t#destroy () - | `NO -> res := false; t#destroy () - | `HELP -> cmd () - | _ -> () - in - ignore (t#connect#response ~callback:setRes); - ignore (t#connect#destroy ~callback:GMain.Main.quit); - grabFocus t; t#show(); - GMain.Main.main(); - releaseFocus (); - !res - - -(********************************************************************** - TOP-LEVEL WINDOW - **********************************************************************) - -let myWindow = ref None - -let getMyWindow () = - if not (Prefs.read Uicommon.reuseToplevelWindows) then begin - (match !myWindow with Some(w) -> w#destroy() | None -> ()); - myWindow := None; - end; - let w = match !myWindow with - Some(w) -> - Safelist.iter w#remove w#children; - w - | None -> - (* Used to be ~position:`CENTER -- maybe that was better... *) - GWindow.window ~kind:`TOPLEVEL ~position:`CENTER - ~title:myNameCapitalized () in - myWindow := Some(w); - w#set_allow_grow true; - w - -(* ------ *) - -let displayWaitMessage () = - if not (Prefs.read Uicommon.contactquietly) then begin - (* FIX: should use a dialog *) - let w = getMyWindow() in - w#set_allow_grow false; - currentWindow := Some (w :> GWindow.window_skel); - let v = GPack.vbox ~packing:(w#add) ~border_width:2 () in - let bb = - GPack.button_box `HORIZONTAL ~layout:`END ~spacing:10 ~border_width:5 - ~packing:(v#pack ~fill:true ~from:`END) () in - let h1 = GPack.hbox ~border_width:12 ~spacing:12 ~packing:v#pack () in - ignore (GMisc.image ~stock:`DIALOG_INFO ~icon_size:`DIALOG - ~yalign:0. ~packing:h1#pack ()); - let m = - GMisc.label ~markup:(primaryText (Uicommon.contactingServerMsg())) - ~yalign:0. ~selectable:true ~packing:h1#add () in - m#misc#set_can_focus false; - let quit = GButton.button ~stock:`QUIT ~packing:bb#pack () in - quit#grab_default (); - ignore (quit#connect#clicked ~callback:safeExit); - ignore (w#event#connect#delete ~callback:(fun _ -> safeExit (); true)); - w#show() - end - -(* ------ *) - -let rec createToplevelWindow () = - let toplevelWindow = getMyWindow() in - (* There is already a default icon under Windows, and transparent - icons are not supported by all version of Windows *) - if Util.osType <> `Win32 then toplevelWindow#set_icon (Some icon); - let toplevelVBox = GPack.vbox ~packing:toplevelWindow#add () in - - (******************************************************************* - Statistic window - *******************************************************************) - - let stat_win = statistics () in - - (******************************************************************* - Groups of things that are sensitive to interaction at the same time - *******************************************************************) - let grAction = ref [] in - let grDiff = ref [] in - let grGo = ref [] in - let grRestart = ref [] in - let grAdd gr w = gr := w#misc::!gr in - let grSet gr st = Safelist.iter (fun x -> x#set_sensitive st) !gr in - - (********************************************************************* - Create the menu bar - *********************************************************************) - let topHBox = GPack.hbox ~packing:(toplevelVBox#pack ~expand:false) () in - - let menuBar = - GMenu.menu_bar ~border_width:0 - ~packing:(topHBox#pack ~expand:true) () in - let menus = new GMenu.factory ~accel_modi:[] menuBar in - let accel_group = menus#accel_group in - toplevelWindow#add_accel_group accel_group; - let add_submenu ?(modi=[]) ~label () = - new GMenu.factory ~accel_group ~accel_modi:modi (menus#add_submenu label) - in - - let profileLabel = - GMisc.label ~text:"" ~packing:(topHBox#pack ~expand:false ~padding:2) () in - - let displayNewProfileLabel p = - let label = Prefs.read Uicommon.profileLabel in - let s = - if p="" then "" - else if p="default" then label - else if label="" then p - else p ^ " (" ^ label ^ ")" in - toplevelWindow#set_title - (if s = "" then myNameCapitalized else - Format.sprintf "%s [%s]" myNameCapitalized s); - let s = if s="" then "" else "Profile: " ^ s in - profileLabel#set_text (transcodeFilename s) - in - - begin match !Prefs.profileName with - None -> () - | Some(p) -> displayNewProfileLabel p - end; - - (********************************************************************* - Create the menus - *********************************************************************) - let fileMenu = add_submenu ~label:"Synchronization" () - and actionsMenu = add_submenu ~label:"Actions" () - and ignoreMenu = add_submenu ~modi:[`SHIFT] ~label:"Ignore" () - and sortMenu = add_submenu ~label:"Sort" () - and helpMenu = add_submenu ~label:"Help" () in - - (********************************************************************* - Action bar - *********************************************************************) - let actionBar = - let hb = GBin.handle_box ~packing:(toplevelVBox#pack ~expand:false) () in - GButton.toolbar ~style:`BOTH - (* 2003-0519 (stse): how to set space size in gtk 2.0? *) - (* Answer from Jacques Garrigue: this can only be done in - the user's.gtkrc, not programmatically *) - ~orientation:`HORIZONTAL ~tooltips:true (* ~space_size:10 *) - ~packing:(hb#add) () in - - (********************************************************************* - Create the main window - *********************************************************************) - let mainWindow = - let sw = - GBin.scrolled_window ~packing:(toplevelVBox#pack ~expand:true) - ~height:(Prefs.read Uicommon.mainWindowHeight * 12) - ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in - GList.clist ~columns:5 ~titles_show:true - ~selection_mode:`BROWSE ~packing:sw#add () in - mainWindow#misc#grab_focus (); -(* - let cols = new GTree.column_list in - let c_replica1 = cols#add Gobject.Data.string in - let c_action = cols#add Gobject.Data.gobject in - let c_replica2 = cols#add Gobject.Data.string in - let c_status = cols#add Gobject.Data.string in - let c_path = cols#add Gobject.Data.string in - let lst_store = GTree.list_store cols in - let lst = - GTree.view ~model:lst_store ~packing:(toplevelVBox#add) - ~headers_clickable:false () in - let s = Uicommon.roots2string () in - ignore (lst#append_column - (GTree.view_column ~title:(" " ^ protect (String.sub s 0 12) ^ " ") - ~renderer:(GTree.cell_renderer_text [], ["text", c_replica1]) ())); - ignore (lst#append_column - (GTree.view_column ~title:" Action " - ~renderer:(GTree.cell_renderer_pixbuf [], ["pixbuf", c_action]) ())); - ignore (lst#append_column - (GTree.view_column ~title:(" " ^ protect (String.sub s 15 12) ^ " ") - ~renderer:(GTree.cell_renderer_text [], ["text", c_replica2]) ())); - ignore (lst#append_column - (GTree.view_column ~title:" Status " ())); - ignore (lst#append_column - (GTree.view_column ~title:" Path " - ~renderer:(GTree.cell_renderer_text [], ["text", c_path]) ())); -*) - -(* - let status_width = - let font = mainWindow#misc#style#font in - 4 + max (max (Gdk.Font.string_width font "working") - (Gdk.Font.string_width font "skipped")) - (Gdk.Font.string_width font " Action ") - in -*) - mainWindow#set_column ~justification:`CENTER 1; - mainWindow#set_column - ~justification:`CENTER (*~auto_resize:false ~width:status_width*) 3; - - let setMainWindowColumnHeaders () = - (* FIX: roots2string should return a pair *) - let s = Uicommon.roots2string () in - Array.iteri - (fun i data -> - mainWindow#set_column - ~title_active:false ~auto_resize:true ~title:data i) - [| " " ^ protect (String.sub s 0 12) ^ " "; " Action "; - " " ^ protect (String.sub s 15 12) ^ " "; " Status "; " Path" |] - in - setMainWindowColumnHeaders(); - - (********************************************************************* - Create the details window - *********************************************************************) - - let (showDetailsButton, detailsWindow) = - let sw = - GBin.frame ~packing:(toplevelVBox#pack ~expand:false) - ~shadow_type:`IN (*~hpolicy:`AUTOMATIC ~vpolicy:`NEVER*) () in - let hb =GPack.hbox ~packing:sw#add () in - (GButton.button ~label:"View details..." - ~show:false ~packing:(hb#pack ~expand:false) (), - GText.view ~editable:false ~wrap_mode:`NONE ~packing:hb#add ()) - - in - detailsWindow#misc#modify_font (Lazy.force fontMonospaceMediumPango); - detailsWindow#misc#set_size_chars ~height:3 ~width:112 (); - detailsWindow#misc#set_can_focus false; - let showDetCommand () = - let details = - match !current with - None -> "[No details available]" - | Some row -> - (match !theState.(row).whatHappened with - Some (Util.Failed _, Some det) -> det - | _ -> "[No details available]") in - messageBox ~title:"Merge execution details" details - in - ignore (showDetailsButton#connect#clicked ~callback:showDetCommand); - - let updateButtons () = - match !current with - None -> - grSet grAction false; - grSet grDiff false; - showDetailsButton#misc#hide () - | Some row -> - let (details, activate1, activate2) = - match !theState.(row).whatHappened, !theState.(row).ri.replicas with - | None, Different((`FILE, _, _, _),(`FILE, _, _, _), _, _) -> - (false, true, true) - | Some res, Different((`FILE, _, _, _),(`FILE, _, _, _), _, _) -> - (match res with - Util.Succeeded, _ -> (false, false, true) - | Util.Failed s, None -> (false, false, true) - | Util.Failed s, Some dText -> (true, false, false) - ) - | Some res, _ -> - (match res with - Util.Succeeded, _ -> (false, false, false) - | Util.Failed s, None -> (false, false, false) - | Util.Failed s, Some dText -> (true, false, false) - ) - | None, _ -> - (false, true, false) in - grSet grAction activate1; - grSet grDiff activate2; - if details then - showDetailsButton#misc#show () - else - showDetailsButton#misc#hide () - in - - let makeRowVisible row = - if mainWindow#row_is_visible row <> `FULL then begin - let adj = mainWindow#vadjustment in - let upper = adj#upper and lower = adj#lower in - let v = - float row /. float (mainWindow#rows + 1) *. (upper-.lower) +. lower - in - adj#set_value (min v (upper -. adj#page_size)) - end in - - let makeFirstUnfinishedVisible pRiInFocus = - let im = Array.length !theState in - let rec find i = - if i >= im then () else - match pRiInFocus (!theState.(i).ri), !theState.(i).whatHappened with - true, None -> makeRowVisible i - | _ -> find (i+1) in - find 0 - in - - let updateDetails () = - begin match !current with - None -> - detailsWindow#buffer#set_text "" - | Some row -> - makeRowVisible row; - let details = - match !theState.(row).whatHappened with - None -> Uicommon.details2string !theState.(row).ri " " - | Some(Util.Succeeded, _) -> Uicommon.details2string !theState.(row).ri " " - | Some(Util.Failed(s), None) -> s - | Some(Util.Failed(s), Some resultLog) -> s in - let path = Path.toString !theState.(row).ri.path in - detailsWindow#buffer#set_text - (transcodeFilename path ^ "\n" ^ transcode details); - end; - (* Display text *) - updateButtons () in - - (********************************************************************* - Status window - *********************************************************************) - - let statusHBox = GPack.hbox ~packing:(toplevelVBox#pack ~expand:false) () in - - let progressBar = - GRange.progress_bar ~packing:(statusHBox#pack ~expand:false) () in - progressBar#set_pulse_step 0.02; - let progressBarPulse = ref false in - - let statusWindow = - GMisc.statusbar ~packing:(statusHBox#pack ~expand:true) () in - let statusContext = statusWindow#new_context ~name:"status" in - ignore (statusContext#push ""); - - let displayStatus m = - statusContext#pop (); - if !progressBarPulse then progressBar#pulse (); - ignore (statusContext#push (transcode m)); - (* Force message to be displayed immediately *) - gtk_sync () - in - - let formatStatus major minor = (Util.padto 30 (major ^ " ")) ^ minor in - - (* Tell the Trace module about the status printer *) - Trace.messageDisplayer := displayStatus; - Trace.statusFormatter := formatStatus; - Trace.sendLogMsgsToStderr := false; - - (********************************************************************* - Functions used to print in the main window - *********************************************************************) - - let select i = - let r = mainWindow#rows in - let p = if r < 2 then 0. else (float i +. 0.5) /. float (r - 1) in - mainWindow#scroll_vertical `JUMP (min p 1.) - in - - ignore (mainWindow#connect#select_row ~callback: - (fun ~row ~column ~event -> current := Some row; updateDetails ())); - - let nextInteresting () = - let l = Array.length !theState in - let start = match !current with Some i -> i + 1 | None -> 0 in - let rec loop i = - if i < l then - match !theState.(i).ri.replicas with - Different (_, _, dir, _) - when not (Prefs.read Uicommon.auto) || !dir = Conflict -> - select i - | _ -> - loop (i + 1) in - loop start in - let selectSomethingIfPossible () = - if !current=None then nextInteresting () in - - let columnsOf i = - let oldPath = if i = 0 then Path.empty else !theState.(i-1).ri.path in - let status = - match !theState.(i).whatHappened with - None -> " " - | Some conf -> - match !theState.(i).ri.replicas with - Different(_,_,{contents=Conflict},_) | Problem _ -> - " " - | _ -> - match conf with - Util.Succeeded, _ -> "done " - | Util.Failed _, _ -> "failed" in - let s = Uicommon.reconItem2string oldPath !theState.(i).ri status in - (* FIX: This is ugly *) - (String.sub s 0 8, - String.sub s 9 5, - String.sub s 15 8, - String.sub s 25 6, - String.sub s 32 (String.length s - 32)) in - - let greenPixel = "00dd00" in - let redPixel = "ff2040" in - let yellowPixel = "999900" in - let lightbluePixel = "8888FF" in - let blackPixel = "000000" in - let buildPixmap p = - GDraw.pixmap_from_xpm_d ~window:toplevelWindow ~data:p () in - let buildPixmaps f c1 = - (buildPixmap (f c1), buildPixmap (f lightbluePixel)) in - - let rightArrow = buildPixmaps Pixmaps.copyAB greenPixel in - let leftArrow = buildPixmaps Pixmaps.copyBA greenPixel in - let ignoreAct = buildPixmaps Pixmaps.ignore redPixel in - let doneIcon = buildPixmap Pixmaps.success in - let failedIcon = buildPixmap Pixmaps.failure in - let rightArrowBlack = buildPixmap (Pixmaps.copyAB blackPixel) in - let leftArrowBlack = buildPixmap (Pixmaps.copyBA blackPixel) in - let mergeLogo = buildPixmaps Pixmaps.mergeLogo greenPixel in - let mergeLogoBlack = buildPixmap (Pixmaps.mergeLogo blackPixel) in - - let displayArrow i j action = - let changedFromDefault = match !theState.(j).ri.replicas with - Different(_,_,{contents=curr},default) -> curr<>default - | _ -> false in - let sel pixmaps = - if changedFromDefault then snd pixmaps else fst pixmaps in - match action with - "<-?->" -> mainWindow#set_cell ~pixmap:(sel ignoreAct) i 1 - | "<-M->" -> mainWindow#set_cell ~pixmap:(sel mergeLogo) i 1 - | "---->" -> mainWindow#set_cell ~pixmap:(sel rightArrow) i 1 - | "<----" -> mainWindow#set_cell ~pixmap:(sel leftArrow) i 1 - | "error" -> mainWindow#set_cell ~pixmap:failedIcon i 1 - | _ -> assert false in - - let displayStatusIcon i status = - match status with - | "failed" -> mainWindow#set_cell ~pixmap:failedIcon i 3 - | "done " -> mainWindow#set_cell ~pixmap:doneIcon i 3 - | _ -> mainWindow#set_cell ~text:status i 3 in - - let displayMain() = - (* The call to mainWindow#clear below side-effect current, - so we save the current value before we clear out the main window and - rebuild it. *) - let savedCurrent = !current in - mainWindow#freeze (); - mainWindow#clear (); - for i = Array.length !theState - 1 downto 0 do - let (r1, action, r2, status, path) = columnsOf i in -(* -let row = lst_store#prepend () in -lst_store#set ~row ~column:c_replica1 r1; -lst_store#set ~row ~column:c_replica2 r2; -lst_store#set ~row ~column:c_status status; -lst_store#set ~row ~column:c_path path; -*) - ignore (mainWindow#prepend - [ r1; ""; r2; status; transcodeFilename path ]); - displayArrow 0 i action - done; - debug (fun()-> Util.msg "reset current to %s\n" - (match savedCurrent with None->"None" | Some(i) -> string_of_int i)); - if savedCurrent <> None then current := savedCurrent; - selectSomethingIfPossible (); - begin match !current with Some idx -> select idx | None -> () end; - mainWindow#thaw (); - updateDetails (); - in - - let redisplay i = - let (r1, action, r2, status, path) = columnsOf i in - mainWindow#freeze (); - mainWindow#set_cell ~text:r1 i 0; - displayArrow i i action; - mainWindow#set_cell ~text:r2 i 2; - displayStatusIcon i status; - mainWindow#set_cell ~text:(transcodeFilename path) i 4; - if status = "failed" then begin - mainWindow#set_cell - ~text:(transcodeFilename path ^ - " [failed: click on this line for details]") i 4 - end; - mainWindow#thaw (); - if !current = Some i then updateDetails (); - updateButtons () in - - let totalBytesToTransfer = ref Uutil.Filesize.zero in - let totalBytesTransferred = ref Uutil.Filesize.zero in - - let displayGlobalProgress v = - progressBar#set_fraction (max 0. (min 1. (v /. 100.))); -(* - if v > 0.5 then - progressBar#set_text (Util.percent2string v) - else - progressBar#set_text ""; -*) - (* Force message to be displayed immediately *) - gtk_sync () in - - let showGlobalProgress b = - (* Concatenate the new message *) - totalBytesTransferred := Uutil.Filesize.add !totalBytesTransferred b; - let v = - (Uutil.Filesize.percentageOfTotalSize - !totalBytesTransferred !totalBytesToTransfer) - in - displayGlobalProgress v - in - - let initGlobalProgress b = - totalBytesToTransfer := b; - totalBytesTransferred := Uutil.Filesize.zero; - showGlobalProgress Uutil.Filesize.zero - in - - let (root1,root2) = Globals.roots () in - let root1IsLocal = fst root1 = Local in - let root2IsLocal = fst root2 = Local in - - let showProgress i bytes dbg = -(* XXX There should be a way to reset the amount of bytes transferred... *) - let i = Uutil.File.toLine i in - let item = !theState.(i) in - item.bytesTransferred <- Uutil.Filesize.add item.bytesTransferred bytes; - let b = item.bytesTransferred in - let len = Common.riLength item.ri in - let newstatus = - if b = Uutil.Filesize.zero || len = Uutil.Filesize.zero then "start " - else if len = Uutil.Filesize.zero then - Printf.sprintf "%5s " (Uutil.Filesize.toString b) - else Util.percent2string (Uutil.Filesize.percentageOfTotalSize b len) in - let dbg = if Trace.enabled "progress" then dbg ^ "/" else "" in - let newstatus = dbg ^ newstatus in - mainWindow#set_cell ~text:newstatus i 3; - showGlobalProgress bytes; - gtk_sync (); - begin match item.ri.replicas with - Different (_, _, dir, _) -> - begin match !dir with - Replica1ToReplica2 -> - if root2IsLocal then - clientWritten := !clientWritten +. Uutil.Filesize.toFloat bytes - else - serverWritten := !serverWritten +. Uutil.Filesize.toFloat bytes - | Replica2ToReplica1 -> - if root1IsLocal then - clientWritten := !clientWritten +. Uutil.Filesize.toFloat bytes - else - serverWritten := !serverWritten +. Uutil.Filesize.toFloat bytes - | Conflict | Merge -> - (* Diff / merge *) - clientWritten := !clientWritten +. Uutil.Filesize.toFloat bytes - end - | _ -> - assert false - end - in - - (* Install showProgress so that we get called back by low-level - file transfer stuff *) - Uutil.setProgressPrinter showProgress; - - (* Apply new ignore patterns to the current state, expecting that the - number of reconitems will grow smaller. Adjust the display, being - careful to keep the cursor as near as possible to its position - before the new ignore patterns take effect. *) - let ignoreAndRedisplay () = - let lst = Array.to_list !theState in - (* FIX: we should actually test whether any prefix is now ignored *) - let keep sI = not (Globals.shouldIgnore sI.ri.path) in - begin match !current with - None -> - theState := Array.of_list (Safelist.filter keep lst) - | Some index -> - let i = ref index in - let l = ref [] in - Array.iteri - (fun j sI -> if keep sI then l := sI::!l - else if j < !i then decr i) - !theState; - theState := Array.of_list (Safelist.rev !l); - current := if !l = [] then None - else Some (min (!i) ((Array.length !theState) - 1)); - end; - displayMain() in - - let sortAndRedisplay () = - current := None; - let compareRIs = Sortri.compareReconItems() in - Array.stable_sort (fun si1 si2 -> compareRIs si1.ri si2.ri) !theState; - displayMain() in - - (****************************************************************** - Main detect-updates-and-reconcile logic - ******************************************************************) - - let detectUpdatesAndReconcile () = - grSet grAction false; - grSet grDiff false; - grSet grGo false; - grSet grRestart false; - - mainWindow#clear(); - detailsWindow#buffer#set_text ""; - - progressBarPulse := true; - sync_action := Some (fun () -> progressBar#pulse ()); - let findUpdates () = - let t = Trace.startTimer "Checking for updates" in - Trace.status "Looking for changes"; - let updates = Update.findUpdates () in - Trace.showTimer t; - updates in - let reconcile updates = - let t = Trace.startTimer "Reconciling" in - let reconRes = Recon.reconcileAll updates in - Trace.showTimer t; - reconRes in - let (reconItemList, thereAreEqualUpdates, dangerousPaths) = - reconcile (findUpdates ()) in - if reconItemList = [] then - if thereAreEqualUpdates then - Trace.status "Replicas have been changed only in identical ways since last sync" - else - Trace.status "Everything is up to date" - else - Trace.status "Check and/or adjust selected actions; then press Go"; - theState := - Array.of_list - (Safelist.map - (fun ri -> { ri = ri; bytesTransferred = Uutil.Filesize.zero; - whatHappened = None }) - reconItemList); - current := None; - displayMain(); - progressBarPulse := false; sync_action := None; displayGlobalProgress 0.; - grSet grGo (Array.length !theState > 0); - grSet grRestart true; - if Prefs.read Globals.confirmBigDeletes then begin - if dangerousPaths <> [] then begin - Prefs.set Globals.batch false; - Util.warn (Uicommon.dangerousPathMsg dangerousPaths) - end; - end; - in - - (********************************************************************* - Help menu - *********************************************************************) - let addDocSection (shortname, (name, docstr)) = - if shortname <> "" && name <> "" then - ignore (helpMenu#add_item - ~callback:(fun () -> documentation shortname) - name) in - Safelist.iter addDocSection Strings.docs; - - (********************************************************************* - Ignore menu - *********************************************************************) - let addRegExpByPath pathfunc = - match !current with - Some i -> - Uicommon.addIgnorePattern (pathfunc !theState.(i).ri.path); - ignoreAndRedisplay () - | None -> - () in - grAdd grAction - (ignoreMenu#add_item ~key:GdkKeysyms._i - ~callback:(fun () -> getLock (fun () -> - addRegExpByPath Uicommon.ignorePath)) - "Permanently ignore this path"); - grAdd grAction - (ignoreMenu#add_item ~key:GdkKeysyms._E - ~callback:(fun () -> getLock (fun () -> - addRegExpByPath Uicommon.ignoreExt)) - "Permanently ignore files with this extension"); - grAdd grAction - (ignoreMenu#add_item ~key:GdkKeysyms._N - ~callback:(fun () -> getLock (fun () -> - addRegExpByPath Uicommon.ignoreName)) - "Permanently ignore files with this name (in any dir)"); - - (* - grAdd grRestart - (ignoreMenu#add_item ~callback: - (fun () -> getLock ignoreDialog) "Edit ignore patterns"); - *) - - (********************************************************************* - Sort menu - *********************************************************************) - grAdd grAction - (sortMenu#add_item - ~callback:(fun () -> getLock (fun () -> - Sortri.sortByName(); - sortAndRedisplay())) - "Sort entries by name"); - grAdd grAction - (sortMenu#add_item - ~callback:(fun () -> getLock (fun () -> - Sortri.sortBySize(); - sortAndRedisplay())) - "Sort entries by size"); - grAdd grAction - (sortMenu#add_item - ~callback:(fun () -> getLock (fun () -> - Sortri.sortNewFirst(); - sortAndRedisplay())) - "Sort new entries first"); - grAdd grAction - (sortMenu#add_item - ~callback:(fun () -> getLock (fun () -> - Sortri.restoreDefaultSettings(); - sortAndRedisplay())) - "Go back to default ordering"); - - (********************************************************************* - Main function : synchronize - *********************************************************************) - let synchronize () = - if Array.length !theState = 0 then - Trace.status "Nothing to synchronize" - else begin - grSet grAction false; - grSet grDiff false; - grSet grGo false; - grSet grRestart false; - - Trace.status "Propagating changes"; - Transport.logStart (); - let totalLength = - Array.fold_left - (fun l si -> Uutil.Filesize.add l (Common.riLength si.ri)) - Uutil.Filesize.zero !theState in - displayGlobalProgress 0.; - initGlobalProgress totalLength; - let t = Trace.startTimer "Propagating changes" in - let im = Array.length !theState in - let rec loop i actions pRiThisRound = - if i < im then begin - let theSI = !theState.(i) in - let textDetailed = ref None in - let action = - match theSI.whatHappened with - None -> - if not (pRiThisRound theSI.ri) then - return () - else - catch (fun () -> - Transport.transportItem - theSI.ri (Uutil.File.ofLine i) - (fun title text -> - textDetailed := (Some text); - if Prefs.read Uicommon.confirmmerge then - twoBoxAdvanced - ~title:title - ~message:("Do you want to commit the changes to" - ^ " the replicas ?") - ~longtext:text - ~advLabel:"View details..." - ~astock:`YES - ~bstock:`NO - else - true) - >>= (fun () -> - return Util.Succeeded)) - (fun e -> - match e with - Util.Transient s -> - return (Util.Failed s) - | _ -> - fail e) - >>= (fun res -> - theSI.whatHappened <- Some (res, !textDetailed); - redisplay i; - makeFirstUnfinishedVisible pRiThisRound; - gtk_sync (); - return ()) - | Some _ -> - return () (* Already processed this one (e.g. merged it) *) - in - loop (i + 1) (action :: actions) pRiThisRound - end else - return actions - in - Lwt_unix.run - (loop 0 [] (fun ri -> not (Common.isDeletion ri)) >>= (fun actions -> - Lwt_util.join actions)); - Lwt_unix.run - (loop 0 [] Common.isDeletion >>= (fun actions -> - Lwt_util.join actions)); - Transport.logFinish (); - Trace.showTimer t; - Trace.status "Updating synchronizer state"; - let t = Trace.startTimer "Updating synchronizer state" in - Update.commitUpdates(); - Trace.showTimer t; - - let failures = - let count = - Array.fold_left - (fun l si -> - l + (match si.whatHappened with Some(Util.Failed(_), _) -> 1 | _ -> 0)) - 0 !theState in - if count = 0 then "" else - Printf.sprintf "%d failure%s" count (if count=1 then "" else "s") in - let skipped = - let count = - Array.fold_left - (fun l si -> - l + (if problematic si.ri then 1 else 0)) - 0 !theState in - if count = 0 then "" else - Printf.sprintf "%d skipped" count in - Trace.status - (Printf.sprintf "Synchronization complete %s%s%s" - failures (if failures=""||skipped="" then "" else ", ") skipped); - displayGlobalProgress 0.; - - grSet grRestart true - end in - - (********************************************************************* - Quit button - *********************************************************************) -(* actionBar#insert_space ();*) - ignore (actionBar#insert_button ~text:"Quit" - ~icon:((GMisc.image ~stock:`QUIT ())#coerce) - ~tooltip:"Exit Unison" - ~callback:safeExit ()); - - (********************************************************************* - go button - *********************************************************************) -(* actionBar#insert_space ();*) - grAdd grGo - (actionBar#insert_button ~text:"Go" - (* tooltip:"Go with displayed actions" *) - ~icon:((GMisc.image ~stock:`EXECUTE ())#coerce) - ~tooltip:"Perform the synchronization" - ~callback:(fun () -> - getLock synchronize) ()); - - (********************************************************************* - Restart button - *********************************************************************) - let detectCmdName = "Restart" in - let detectCmd () = - getLock detectUpdatesAndReconcile; - if Prefs.read Globals.batch then begin - Prefs.set Globals.batch false; synchronize() - end - in -(* actionBar#insert_space ();*) - grAdd grRestart - (actionBar#insert_button ~text:detectCmdName - ~icon:((GMisc.image ~stock:`REFRESH ())#coerce) - ~tooltip:"Check for updates" - ~callback: detectCmd ()); - - (********************************************************************* - Buttons for <--, M, -->, Skip - *********************************************************************) - let doAction f = - match !current with - Some i -> - let theSI = !theState.(i) in - begin match theSI.whatHappened, theSI.ri.replicas with - None, Different(_, _, dir, _) -> - f dir; - redisplay i; - nextInteresting () - | _ -> - () - end - | None -> - () in - let leftAction _ = doAction (fun dir -> dir := Replica2ToReplica1) in - let rightAction _ = doAction (fun dir -> dir := Replica1ToReplica2) in - let questionAction _ = doAction (fun dir -> dir := Conflict) in - let mergeAction _ = doAction (fun dir -> dir := Merge) in - - actionBar#insert_space (); - grAdd grAction - (actionBar#insert_button -(* ~icon:((GMisc.pixmap leftArrowBlack ())#coerce)*) - ~icon:((GMisc.image ~stock:`GO_BACK ())#coerce) - ~text:"Right to Left" - ~tooltip:"Propagate this item from the right replica to the left one" - ~callback:leftAction ()); -(* actionBar#insert_space ();*) - grAdd grAction - (actionBar#insert_button -(* ~icon:((GMisc.pixmap mergeLogoBlack())#coerce)*) - ~icon:((GMisc.image ~stock:`ADD ())#coerce) - ~text:"Merge" - ~callback:mergeAction ()); -(* actionBar#insert_space ();*) - grAdd grAction - (actionBar#insert_button -(* ~icon:((GMisc.pixmap rightArrowBlack ())#coerce)*) - ~icon:((GMisc.image ~stock:`GO_FORWARD ())#coerce) - ~text:"Left to Right" - ~tooltip:"Propagate this item from the left replica to the right one" - ~callback:rightAction ()); -(* actionBar#insert_space ();*) - grAdd grAction - (actionBar#insert_button ~text:"Skip" - ~icon:((GMisc.image ~stock:`NO ())#coerce) - ~tooltip:"Skip this item" - ~callback:questionAction ()); - - (********************************************************************* - Diff / merge buttons - *********************************************************************) - let diffCmd () = - match !current with - Some i -> - getLock (fun () -> - Uicommon.showDiffs !theState.(i).ri - (fun title text -> messageBox ~title (transcode text)) - Trace.status (Uutil.File.ofLine i); - displayGlobalProgress 0.) - | None -> - () in - - actionBar#insert_space (); - grAdd grDiff (actionBar#insert_button ~text:"Diff" - ~icon:((GMisc.image ~stock:`DIALOG_INFO ())#coerce) - ~tooltip:"Compare the two items 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 ()); - *) - (********************************************************************* - Keyboard commands - *********************************************************************) - ignore - (mainWindow#event#connect#key_press ~callback: - begin fun ev -> - let key = GdkEvent.Key.keyval ev in - if key = GdkKeysyms._Left then begin - leftAction (); GtkSignal.stop_emit (); true - end else if key = GdkKeysyms._Right then begin - rightAction (); GtkSignal.stop_emit (); true - end else - false - end); - - (********************************************************************* - Action menu - *********************************************************************) - let (root1,root2) = Globals.roots () in - let loc1 = root2hostname root1 in - let loc2 = root2hostname root2 in - let descr = - if loc1 = loc2 then "left to right" else - Printf.sprintf "from %s to %s" loc1 loc2 in - let left = - actionsMenu#add_image_item ~key:GdkKeysyms._greater ~callback:rightAction - ~image:((GMisc.image ~stock:`GO_FORWARD ~icon_size:`MENU ())#coerce) - ~label:("Propagate this path " ^ descr) () in - grAdd grAction left; - left#add_accelerator ~group:accel_group ~modi:[`SHIFT] GdkKeysyms._greater; - left#add_accelerator ~group:accel_group GdkKeysyms._period; - - let merge = - actionsMenu#add_image_item ~key:GdkKeysyms._m ~callback:mergeAction - ~image:((GMisc.image ~stock:`ADD ~icon_size:`MENU ())#coerce) - ~label:"Merge the files" () in - grAdd grAction merge; -(* merge#add_accelerator ~group:accel_group ~modi:[`SHIFT] GdkKeysyms._m; *) - - let descl = - if loc1 = loc2 then "right to left" else - Printf.sprintf "from %s to %s" (protect loc2) (protect loc1) in - let right = - actionsMenu#add_image_item ~key:GdkKeysyms._less ~callback:leftAction - ~image:((GMisc.image ~stock:`GO_BACK ~icon_size:`MENU ())#coerce) - ~label:("Propagate this path " ^ descl) () in - grAdd grAction right; - right#add_accelerator ~group:accel_group ~modi:[`SHIFT] GdkKeysyms._less; - right#add_accelerator ~group:accel_group ~modi:[`SHIFT] GdkKeysyms._comma; - - grAdd grAction - (actionsMenu#add_image_item ~key:GdkKeysyms._slash ~callback:questionAction - ~image:((GMisc.image ~stock:`NO ~icon_size:`MENU ())#coerce) - ~label:"Do not propagate changes to this path" ()); - - (* Override actions *) - ignore (actionsMenu#add_separator ()); - grAdd grAction - (actionsMenu#add_item - ~callback:(fun () -> getLock (fun () -> - Array.iter - (fun si -> Recon.setDirection si.ri `Replica1ToReplica2 `Prefer) - !theState; - displayMain())) - "Resolve all conflicts in favor of first root"); - grAdd grAction - (actionsMenu#add_item - ~callback:(fun () -> getLock (fun () -> - Array.iter - (fun si -> Recon.setDirection si.ri `Replica2ToReplica1 `Prefer) - !theState; - displayMain())) - "Resolve all conflicts in favor of second root"); - grAdd grAction - (actionsMenu#add_item - ~callback:(fun () -> getLock (fun () -> - Array.iter - (fun si -> Recon.setDirection si.ri `Newer `Prefer) - !theState; - displayMain())) - "Resolve all conflicts in favor of most recently modified"); - grAdd grAction - (actionsMenu#add_item - ~callback:(fun () -> getLock (fun () -> - Array.iter - (fun si -> Recon.setDirection si.ri `Older `Prefer) - !theState; - displayMain())) - "Resolve all conflicts in favor of least recently modified"); - ignore (actionsMenu#add_separator ()); - grAdd grAction - (actionsMenu#add_item - ~callback:(fun () -> getLock (fun () -> - Array.iter - (fun si -> Recon.setDirection si.ri `Replica1ToReplica2 `Force) - !theState; - displayMain())) - "Force all changes from first root to second"); - grAdd grAction - (actionsMenu#add_item - ~callback:(fun () -> getLock (fun () -> - Array.iter - (fun si -> Recon.setDirection si.ri `Replica2ToReplica1 `Force) - !theState; - displayMain())) - "Force all changes from second root to first"); - grAdd grAction - (actionsMenu#add_item - ~callback:(fun () -> getLock (fun () -> - Array.iter - (fun si -> Recon.setDirection si.ri `Newer `Force) - !theState; - displayMain())) - "Force newer files to replace older ones"); - grAdd grAction - (actionsMenu#add_item - ~callback:(fun () -> getLock (fun () -> - Array.iter - (fun si -> Recon.setDirection si.ri `Merge `Force) - !theState; - displayMain())) - "Revert all paths to the merging default, if avaible"); - grAdd grAction - (actionsMenu#add_item - ~callback:(fun () -> getLock (fun () -> - Array.iter - (fun si -> Recon.setDirection si.ri `Older `Force) - !theState; - displayMain())) - "Force older files to replace newer ones"); - ignore (actionsMenu#add_separator ()); - grAdd grAction - (actionsMenu#add_item - ~callback:(fun () -> getLock (fun () -> - Array.iter - (fun si -> Recon.revertToDefaultDirection si.ri) - !theState; - displayMain())) - "Revert all paths to Unison's recommendations"); - grAdd grAction - (actionsMenu#add_item - ~callback:(fun () -> getLock (fun () -> - match !current with - Some i -> - let theSI = !theState.(i) in - Recon.revertToDefaultDirection theSI.ri; - redisplay i; - nextInteresting () - | None -> - ())) - "Revert selected path to Unison's recommendations"); - - (* Diff *) - ignore (actionsMenu#add_separator ()); - grAdd grDiff (actionsMenu#add_image_item ~key:GdkKeysyms._d ~callback:diffCmd - ~image:((GMisc.image ~stock:`DIALOG_INFO ~icon_size:`MENU ())#coerce) - ~label:"Show diffs for selected path" ()); - - (********************************************************************* - Synchronization menu - *********************************************************************) - - let loadProfile p = - debug (fun()-> Util.msg "Loading profile %s..." p); - Uicommon.initPrefs p displayWaitMessage getFirstRoot getSecondRoot - termInteract; - displayNewProfileLabel p; - setMainWindowColumnHeaders() - in - - let reloadProfile () = - match !Prefs.profileName with - None -> () - | Some(n) -> loadProfile n in - - grAdd grGo - (fileMenu#add_image_item ~key:GdkKeysyms._g - ~image:(GMisc.image ~stock:`EXECUTE ~icon_size:`MENU () :> GObj.widget) - ~callback:(fun () -> getLock synchronize) - ~label:"Go" ()); - grAdd grRestart - (fileMenu#add_image_item ~key:GdkKeysyms._r - ~image:(GMisc.image ~stock:`REFRESH ~icon_size:`MENU () :> GObj.widget) - ~callback:(fun () -> reloadProfile(); detectCmd()) - ~label:detectCmdName ()); - grAdd grRestart - (fileMenu#add_item ~key:GdkKeysyms._a - ~callback:(fun () -> - reloadProfile(); - Prefs.set Globals.batch true; - detectCmd()) - "Detect updates and proceed (without waiting)"); - grAdd grRestart - (fileMenu#add_item ~key:GdkKeysyms._f - ~callback:( - fun () -> - let rec loop i acc = - if i >= Array.length (!theState) then acc else - let notok = - (match !theState.(i).whatHappened with - None-> true - | Some(Util.Failed _, _) -> true - | Some(Util.Succeeded, _) -> false) - || match !theState.(i).ri.replicas with - Problem _ -> true - | Different(rc1,rc2,dir,_) -> - (match !dir with - Conflict -> true - | _ -> false) in - if notok then loop (i+1) (i::acc) - else loop (i+1) (acc) in - let failedindices = loop 0 [] in - let failedpaths = - Safelist.map (fun i -> !theState.(i).ri.path) failedindices in - debug (fun()-> Util.msg "Restarting with paths = %s\n" - (String.concat ", " (Safelist.map - (fun p -> "'"^(Path.toString p)^"'") - failedpaths))); - Prefs.set Globals.paths failedpaths; - Prefs.set Globals.confirmBigDeletes false; - detectCmd(); - reloadProfile()) - "Recheck unsynchronized items"); - - ignore (fileMenu#add_separator ()); - - grAdd grRestart - (fileMenu#add_image_item ~key:GdkKeysyms._p - ~callback:(fun _ -> - match getProfile() with - None -> () - | Some(p) -> loadProfile p; detectCmd ()) - ~image:(GMisc.image ~stock:`OPEN ~icon_size:`MENU () :> GObj.widget) - ~label:"Select a new profile from the profile dialog..." ()); - - let fastProf name key = - grAdd grRestart - (fileMenu#add_item ~key:key - ~callback:(fun _ -> - if Sys.file_exists (Prefs.profilePathname name) then begin - Trace.status ("Loading profile " ^ name); - loadProfile name; detectCmd () - end else - Trace.status ("Profile " ^ name ^ " not found")) - ("Select profile " ^ name)) in - - let fastKeysyms = - [| GdkKeysyms._0; GdkKeysyms._1; GdkKeysyms._2; GdkKeysyms._3; - GdkKeysyms._4; GdkKeysyms._5; GdkKeysyms._6; GdkKeysyms._7; - GdkKeysyms._8; GdkKeysyms._9 |] in - - Array.iteri - (fun i v -> match v with - None -> () - | Some(profile, info) -> - fastProf profile fastKeysyms.(i)) - profileKeymap; - - ignore (fileMenu#add_separator ()); - ignore (fileMenu#add_item - ~callback:(fun _ -> stat_win#show ()) "Statistics"); - - ignore (fileMenu#add_separator ()); - ignore (fileMenu#add_image_item - ~key:GdkKeysyms._q ~callback:safeExit - ~image:((GMisc.image ~stock:`QUIT ~icon_size:`MENU ())#coerce) - ~label:"Quit" ()); - - (********************************************************************* - Expert menu - *********************************************************************) - if Prefs.read Uicommon.expert then begin - let expertMenu = add_submenu ~label:"Expert" () in - - let addDebugToggle modname = - let cm = - expertMenu#add_check_item ~active:(Trace.enabled modname) - ~callback:(fun b -> Trace.enable modname b) - ("Debug '" ^ modname ^ "'") in - cm#set_show_toggle true in - - addDebugToggle "all"; - addDebugToggle "verbose"; - addDebugToggle "update"; - - ignore (expertMenu#add_separator ()); - ignore (expertMenu#add_item - ~callback:(fun () -> - Printf.fprintf stderr "\nGC stats now:\n"; - Gc.print_stat stderr; - Printf.fprintf stderr "\nAfter major collection:\n"; - Gc.full_major(); Gc.print_stat stderr; - flush stderr) - "Show memory/GC stats") - end; - - (********************************************************************* - Finish up - *********************************************************************) - grSet grAction false; - grSet grDiff false; - grSet grGo false; - grSet grRestart false; - - ignore (toplevelWindow#event#connect#delete ~callback: - (fun _ -> safeExit (); true)); - toplevelWindow#show (); - currentWindow := Some (toplevelWindow :> GWindow.window_skel); - detectCmd () - - -(********************************************************************* - STARTUP - *********************************************************************) - -let start _ = - begin try - (* Initialize the GTK library *) - ignore (GMain.Main.init ()); - - Util.warnPrinter := Some (warnBox "Warning"); - - GtkSignal.user_handler := - (fun exn -> - match exn with - Util.Transient(s) | Util.Fatal(s) -> fatalError s - | exn -> fatalError (Uicommon.exn2string exn)); - - (* Ask the Remote module to call us back at regular intervals during - long network operations. *) - let rec tick () = - gtk_sync (); - Lwt_unix.sleep 0.05 >>= tick - in - ignore_result (tick ()); - - Uicommon.uiInit - fatalError - tryAgainOrQuit - displayWaitMessage - getProfile - getFirstRoot - getSecondRoot - termInteract; - - scanProfiles(); - createToplevelWindow(); - - (* Display the ui *) - ignore (GMain.Timeout.add 500 (fun _ -> true)); - (* Hack: this allows signals such as SIGINT to be - handled even when Gtk is waiting for events *) - GMain.Main.main () - with - Util.Transient(s) | Util.Fatal(s) -> fatalError s - | exn -> fatalError (Uicommon.exn2string exn) - end - -end (* module Private *) - - -(********************************************************************* - UI SELECTION - *********************************************************************) - -module Body : Uicommon.UI = struct - -let start = function - Uicommon.Text -> Uitext.Body.start Uicommon.Text - | Uicommon.Graphic -> - let displayAvailable = - Util.osType = `Win32 - || - try Unix.getenv "DISPLAY" <> "" with Not_found -> false - in - if displayAvailable then Private.start Uicommon.Graphic - else Uitext.Body.start Uicommon.Text - -let defaultUi = Uicommon.Graphic - -end (* module Body *) Copied: branches/2.32/src/uigtk2.ml (from rev 320, trunk/src/uigtk2.ml) =================================================================== --- branches/2.32/src/uigtk2.ml (rev 0) +++ branches/2.32/src/uigtk2.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,2493 @@ +(* Unison file synchronizer: src/uigtk2.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +open Common +open Lwt + +module Private = struct + +let debug = Trace.debug "ui" + +let myNameCapitalized = String.capitalize Uutil.myName + +(********************************************************************** + LOW-LEVEL STUFF + **********************************************************************) + +(********************************************************************** + Some message strings (build them here because they look ugly in the + middle of other code. + **********************************************************************) + +let tryAgainMessage = + Printf.sprintf +"You can use %s to synchronize a local directory with another local directory, +or with a remote directory. + +Please enter the first (local) directory that you want to synchronize." +myNameCapitalized + +(* ---- *) + +let helpmessage = Printf.sprintf +"%s can synchronize a local directory with another local directory, or with +a directory on a remote machine. + +To synchronize with a local directory, just enter the file name. + +To synchronize with a remote directory, you must first choose a protocol +that %s will use to connect to the remote machine. Each protocol has +different requirements: + +1) To synchronize using SSH, there must be an SSH client installed on +this machine and an SSH server installed on the remote machine. You +must enter the host to connect to, a user name (if different from +your user name on this machine), and the directory on the remote machine +(relative to your home directory on that machine). + +2) To synchronize using RSH, there must be an RSH client installed on +this machine and an RSH server installed on the remote machine. You +must enter the host to connect to, a user name (if different from +your user name on this machine), and the directory on the remote machine +(relative to your home directory on that machine). + +3) To synchronize using %s's socket protocol, there must be a %s +server running on the remote machine, listening to the port that you +specify here. (Use \"%s -socket xxx\" on the remote machine to +start the %s server.) You must enter the host, port, and the directory +on the remote machine (relative to the working directory of the +%s server running on that machine)." +myNameCapitalized myNameCapitalized myNameCapitalized myNameCapitalized myNameCapitalized myNameCapitalized myNameCapitalized + +(********************************************************************** + Font preferences + **********************************************************************) + +let fontMonospaceMedium = + if Util.osType = `Win32 then + lazy (Gdk.Font.load "-*-Courier New-Medium-R-Normal--*-110-*-*-*-*-*-*") + else + lazy (Gdk.Font.load "-*-Clean-Medium-R-Normal--*-130-*-*-*-*-*-*") + +let fontMonospaceMediumPango = lazy (Pango.Font.from_string "monospace") + +(********************************************************************** + Unison icon + **********************************************************************) + +(* This does not work with the current version of Lablgtk, due to a bug +let icon = + GdkPixbuf.from_data ~width:48 ~height:48 ~has_alpha:true + (Gpointer.region_of_string Pixmaps.icon_data) +*) +let icon = + let p = GdkPixbuf.create ~width:48 ~height:48 ~has_alpha:true () in + Gpointer.blit + (Gpointer.region_of_string Pixmaps.icon_data) (GdkPixbuf.get_pixels p); + p + +(********************************************************************* + UI state variables + *********************************************************************) + +type stateItem = { mutable ri : reconItem; + mutable bytesTransferred : Uutil.Filesize.t; + mutable whatHappened : (Util.confirmation * string option) option} +let theState = ref [||] + +let current = ref None + +(* ---- *) + +let currentWindow = ref None + +let grabFocus t = + match !currentWindow with + Some w -> t#set_transient_for (w#as_window); + w#misc#set_sensitive false + | None -> () + +let releaseFocus () = + begin match !currentWindow with + Some w -> w#misc#set_sensitive true + | None -> () + end + +(********************************************************************* + Lock management + *********************************************************************) + +let busy = ref false + +let getLock f = + if !busy then + Trace.status "Synchronizer is busy, please wait.." + else begin + busy := true; f (); busy := false + end + +(********************************************************************** + Miscellaneous + **********************************************************************) + +let sync_action = ref None + +let gtk_sync () = + begin match !sync_action with + Some f -> f () + | None -> () + end; + while Glib.Main.iteration false do () done + +(********************************************************************** + CHARACTER SET TRANSCODING +***********************************************************************) + +(* Transcodage from Microsoft Windows Codepage 1252 to Unicode *) + +(* Unison currently uses the "ASCII" Windows filesystem API. With + this API, filenames are encoded using a proprietary character + encoding. This encoding depends on the Windows setup, but in + Western Europe, the Windows Codepage 1252 is usually used. + GTK, on the other hand, uses the UTF-8 encoding. This code perform + the translation from Codepage 1252 to UTF-8. A call to [transcode] + should be wrapped around every string below that might contain + non-ASCII characters. *) + +let code = + [| 0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15; 16; 17; 18; + 19; 20; 21; 22; 23; 24; 25; 26; 27; 28; 29; 30; 31; 32; 33; 34; + 35; 36; 37; 38; 39; 40; 41; 42; 43; 44; 45; 46; 47; 48; 49; 50; + 51; 52; 53; 54; 55; 56; 57; 58; 59; 60; 61; 62; 63; 64; 65; 66; + 67; 68; 69; 70; 71; 72; 73; 74; 75; 76; 77; 78; 79; 80; 81; 82; + 83; 84; 85; 86; 87; 88; 89; 90; 91; 92; 93; 94; 95; 96; 97; 98; + 99; 100; 101; 102; 103; 104; 105; 106; 107; 108; 109; 110; 111; + 112; 113; 114; 115; 116; 117; 118; 119; 120; 121; 122; 123; 124; + 125; 126; 127; 8364; 129; 8218; 131; 8222; 8230; 8224; 8225; 136; + 8240; 352; 8249; 346; 356; 381; 377; 144; 8216; 8217; 8220; 8221; + 8226; 8211; 8212; 152; 8482; 353; 8250; 347; 357; 382; 378; 160; + 711; 728; 321; 164; 260; 166; 167; 168; 169; 350; 171; 172; 173; + 174; 379; 176; 177; 731; 322; 180; 181; 182; 183; 184; 261; 351; + 187; 376; 733; 317; 380; 340; 193; 194; 258; 196; 313; 262; 199; + 268; 201; 280; 203; 282; 205; 206; 270; 272; 323; 327; 211; 212; + 336; 214; 215; 344; 366; 218; 368; 220; 221; 354; 223; 341; 225; + 226; 259; 228; 314; 263; 231; 269; 233; 281; 235; 283; 237; 238; + 271; 273; 324; 328; 243; 244; 337; 246; 247; 345; 367; 250; 369; + 252; 253; 355; 729 |] + +let rec transcodeRec buf s i l = + if i < l then begin + let c = code.(Char.code s.[i]) in + if c < 0x80 then + Buffer.add_char buf (Char.chr c) + else if c < 0x800 then begin + Buffer.add_char buf (Char.chr (c lsr 6 + 0xC0)); + Buffer.add_char buf (Char.chr (c land 0x3f + 0x80)) + end else if c < 0x10000 then begin + Buffer.add_char buf (Char.chr (c lsr 12 + 0xE0)); + Buffer.add_char buf (Char.chr ((c lsr 6) land 0x3f + 0x80)); + Buffer.add_char buf (Char.chr (c land 0x3f + 0x80)) + end; + transcodeRec buf s (i + 1) l + end + +let transcodeDoc s = + let buf = Buffer.create 1024 in + transcodeRec buf s 0 (String.length s); + Buffer.contents buf + +(****) + +let wf_utf8 = + [[('\x00', '\x7F')]; + [('\xC2', '\xDF'); ('\x80', '\xBF')]; + [('\xE0', '\xE0'); ('\xA0', '\xBF'); ('\x80', '\xBF')]; + [('\xE1', '\xEC'); ('\x80', '\xBF'); ('\x80', '\xBF')]; + [('\xED', '\xED'); ('\x80', '\x9F'); ('\x80', '\xBF')]; + [('\xEE', '\xEF'); ('\x80', '\xBF'); ('\x80', '\xBF')]; + [('\xF0', '\xF0'); ('\x90', '\xBF'); ('\x80', '\xBF'); ('\x80', '\xBF')]; + [('\xF1', '\xF3'); ('\x80', '\xBF'); ('\x80', '\xBF'); ('\x80', '\xBF')]; + [('\xF4', '\xF4'); ('\x80', '\x8F'); ('\x80', '\xBF'); ('\x80', '\xBF')]] + +let rec accept_seq l s i len = + match l with + [] -> + Some i + | (a, b) :: r -> + if i = len || s.[i] < a || s.[i] > b then + None + else + accept_seq r s (i + 1) len + +let rec accept_rec l s i len = + match l with + [] -> + None + | seq :: r -> + match accept_seq seq s i len with + None -> accept_rec r s i len + | res -> res + +let accept = accept_rec wf_utf8 + +(***) + +let rec validate_rec s i len = + i = len || + match accept s i len with + Some i -> validate_rec s i len + | None -> false + +let expl f s = f s 0 (String.length s) + +let validate = expl validate_rec + +(****) + +let protect_char buf c = + if c < '\x80' then + Buffer.add_char buf c + else + let c = Char.code c in + Buffer.add_char buf (Char.chr (c lsr 6 + 0xC0)); + Buffer.add_char buf (Char.chr (c land 0x3f + 0x80)) + +let rec protect_rec buf s i len = + if i = len then + Buffer.contents buf + else + match accept s i len with + Some i' -> + Buffer.add_substring buf s i (i' - i); + protect_rec buf s i' len + | None -> + protect_char buf s.[i]; + protect_rec buf s (i + 1) len + +(* Convert a string to UTF8 by keeping all UTF8 characters unchanged + and considering all other characters as ISO 8859-1 characters *) +let protect s = + let buf = Buffer.create (String.length s * 2) in + expl (protect_rec buf) s + +(****) + +let escapeMarkup s = Glib.Markup.escape_text s + +let transcode s = + try + Glib.Convert.locale_to_utf8 s + with Glib.Convert.Error _ -> + protect s + +let transcodeFilename s = + if Util.osType = `Win32 then transcode s else + try + Glib.Convert.filename_to_utf8 s + with Glib.Convert.Error _ -> + protect s + +(********************************************************************** + USEFUL LOW-LEVEL WIDGETS + **********************************************************************) + +class scrolled_text + ?(font=fontMonospaceMediumPango) ?editable ?word_wrap + ~width ~height ?packing ?show + () = + let sw = + GBin.scrolled_window ?packing ~show:false + ~hpolicy:`NEVER ~vpolicy:`AUTOMATIC () + in + let text = GText.view ?editable ?wrap_mode:(Some `WORD) ~packing:sw#add () in + object + inherit GObj.widget_full sw#as_widget + method text = text + method insert ?(font=fontMonospaceMediumPango) s = + text#buffer#set_text s; + method show () = sw#misc#show () + initializer + text#misc#modify_font (Lazy.force font); + text#misc#set_size_chars ~height ~width (); + if show <> Some false then sw#misc#show () + end + +(* ------ *) + +(* Display a message in a window and wait for the user + to hit the button. *) +let okBox ~title ~typ ~message = + let t = + GWindow.message_dialog + ~title ~message_type:typ ~message ~modal:true + ~buttons:GWindow.Buttons.ok () in + grabFocus t; + ignore (t#run ()); t#destroy (); + releaseFocus () + +(* ------ *) + +let primaryText msg = + Printf.sprintf "%s" + (escapeMarkup msg) + +(* twoBox: Display a message in a window and wait for the user + to hit one of two buttons. Return true if the first button is + chosen, false if the second button is chosen. *) +let twoBox ~title ~message ~astock ~bstock = + let t = + GWindow.dialog ~border_width:6 ~modal:true ~no_separator:true + ~allow_grow:false () in + t#vbox#set_spacing 12; + let h1 = GPack.hbox ~border_width:6 ~spacing:12 ~packing:t#vbox#pack () in + ignore (GMisc.image ~stock:`DIALOG_WARNING ~icon_size:`DIALOG + ~yalign:0. ~packing:h1#pack ()); + let v1 = GPack.vbox ~spacing:12 ~packing:h1#pack () in + ignore (GMisc.label + ~markup:(primaryText title ^ "\n\n" ^ escapeMarkup message) + ~selectable:true ~yalign:0. ~packing:v1#add ()); + t#add_button_stock bstock `NO; + t#add_button_stock astock `YES; + t#set_default_response `NO; + grabFocus t; t#show(); + let res = t#run () in + t#destroy (); releaseFocus (); + res = `YES + +(* ------ *) + +(* Avoid recursive invocations of the function below (a window receives + delete events even when it is not sensitive) *) +let inExit = ref false + +let doExit () = Lwt_unix.run (Update.unlockArchives ()); exit 0 + +let safeExit () = + if not !inExit then begin + inExit := true; + if not !busy then exit 0 else + if twoBox ~title:"Premature exit" + ~message:"Unison is working, exit anyway ?" + ~astock:`YES ~bstock:`NO + then exit 0; + inExit := false + end + +(* ------ *) + +(* warnBox: Display a warning message in a window and wait (unless + we're in batch mode) for the user to hit "OK" or "Exit". *) +let warnBox title message = + let message = transcode message in + if Prefs.read Globals.batch then begin + (* In batch mode, just pop up a window and go ahead *) + let t = + GWindow.dialog ~border_width:6 ~modal:true ~no_separator:true + ~allow_grow:false () in + t#vbox#set_spacing 12; + let h1 = GPack.hbox ~border_width:6 ~spacing:12 ~packing:t#vbox#pack () in + ignore (GMisc.image ~stock:`DIALOG_INFO ~icon_size:`DIALOG + ~yalign:0. ~packing:h1#pack ()); + let v1 = GPack.vbox ~spacing:12 ~packing:h1#pack () in + ignore (GMisc.label ~markup:(primaryText title ^ "\n\n" ^ + escapeMarkup message) + ~selectable:true ~yalign:0. ~packing:v1#add ()); + t#add_button_stock `CLOSE `CLOSE; + t#set_default_response `CLOSE; + ignore (t#connect#response ~callback:(fun _ -> t#destroy ())); + t#show () + end else begin + inExit := true; + let ok = twoBox ~title ~message ~astock:`OK ~bstock:`QUIT in + if not(ok) then doExit (); + inExit := false + end + +(********************************************************************** + HIGHER-LEVEL WIDGETS +***********************************************************************) + +(* +XXX +* Accurate write accounting: + - Local copies on the remote side are ignored + - What about failures? +*) +class stats width height = + let pixmap = GDraw.pixmap ~width ~height () in + let area = + pixmap#set_foreground `WHITE; + pixmap#rectangle ~filled:true ~x:0 ~y:0 ~width ~height (); + GMisc.pixmap pixmap ~width ~height ~xpad:4 ~ypad:8 () + in + object (self) + inherit GObj.widget_full area#as_widget + val mutable maxim = ref 0. + val mutable scale = ref 1. + val mutable min_scale = 1. + val values = Array.make width 0. + val mutable active = false + + method activate a = active <- a + + method scale h = truncate ((float height) *. h /. !scale) + + method private rect i v' v = + let h = self#scale v in + let h' = self#scale v' in + let h1 = min h' h in + let h2 = max h' h in + pixmap#set_foreground `BLACK; + pixmap#rectangle + ~filled:true ~x:i ~y:(height - h1) ~width:1 ~height:h1 (); + for h = h1 + 1 to h2 do + let v = truncate (65535. *. (float (h - h1) /. float (h2 - h1))) in + let v = (v / 4096) * 4096 in (* Only use 16 gray levels *) + pixmap#set_foreground (`RGB (v, v, v)); + pixmap#rectangle + ~filled:true ~x:i ~y:(height - h) ~width:1 ~height:1 (); + done + + method push v = + let need_max = values.(0) = !maxim in + for i = 0 to width - 2 do + values.(i) <- values.(i + 1) + done; + values.(width - 1) <- v; + if need_max then begin + maxim := 0.; + for i = 0 to width - 1 do maxim := max !maxim values.(i) done + end else + maxim := max !maxim v; + if active then begin + let need_resize = + !maxim > !scale || (!maxim > min_scale && !maxim < !scale /. 1.5) in + if need_resize then begin + scale := min_scale; + while !maxim > !scale do + scale := !scale *. 1.5 + done; + pixmap#set_foreground `WHITE; + pixmap#rectangle ~filled:true ~x:0 ~y:0 ~width ~height (); + pixmap#set_foreground `BLACK; + for i = 0 to width - 1 do + self#rect i values.(max 0 (i - 1)) values.(i) + done + end else begin + pixmap#put_pixmap ~x:0 ~y:0 ~xsrc:1 (pixmap#pixmap); + pixmap#set_foreground `WHITE; + pixmap#rectangle + ~filled:true ~x:(width - 1) ~y:0 ~width:1 ~height (); + self#rect (width - 1) values.(width - 2) values.(width - 1) + end; + area#misc#draw None + end + end + +let clientWritten = ref 0. +let serverWritten = ref 0. + +let statistics () = + let title = "Statistics" in + let t = GWindow.dialog ~title () in + let t_dismiss = GButton.button ~stock:`CLOSE ~packing:t#action_area#add () in + t_dismiss#grab_default (); + let dismiss () = t#misc#hide () in + ignore (t_dismiss#connect#clicked ~callback:dismiss); + ignore (t#event#connect#delete ~callback:(fun _ -> dismiss (); true)); + + let emission = new stats 320 50 in + t#vbox#pack ~expand:false ~padding:4 (emission :> GObj.widget); + let reception = new stats 320 50 in + t#vbox#pack ~expand:false ~padding:4 (reception :> GObj.widget); + + let lst = + GList.clist + ~packing:(t#vbox#add) + ~titles_active:false + ~titles:[""; "Client"; "Server"; "Total"] () + in + lst#set_column ~auto_resize:true 0; + lst#set_column ~auto_resize:true ~justification:`RIGHT 1; + lst#set_column ~auto_resize:true ~justification:`RIGHT 2; + lst#set_column ~auto_resize:true ~justification:`RIGHT 3; + ignore (lst#append ["Reception rate"]); + ignore (lst#append ["Data received"]); + ignore (lst#append ["File data written"]); + let style = lst#misc#style#copy in + (* BCP: Removed this on 6/13/2006 as a workaround for a bug reported + by Norman Ramsey. Apparently, lablgtl2 uses Gdk.Font, which is + deprecated; its associated operations don't work in recent versions + of gtk2. *) + (* style#set_font (Lazy.force fontMonospaceMedium); *) + for r = 0 to 2 do + lst#set_row ~selectable:false r; + for c = 1 to 3 do + lst#set_cell ~style r c + done + done; + + ignore (t#event#connect#map (fun _ -> + emission#activate true; + reception#activate true; + false)); + ignore (t#event#connect#unmap (fun _ -> + emission#activate false; + reception#activate false; + false)); + + let delay = 0.5 in + let a = 0.5 in + let b = 0.8 in + + let emittedBytes = ref 0. in + let emitRate = ref 0. in + let emitRate2 = ref 0. in + let receivedBytes = ref 0. in + let receiveRate = ref 0. in + let receiveRate2 = ref 0. in + let timeout _ = + emitRate := + a *. !emitRate +. + (1. -. a) *. (!Remote.emittedBytes -. !emittedBytes) /. delay; + emitRate2 := + b *. !emitRate2 +. + (1. -. b) *. (!Remote.emittedBytes -. !emittedBytes) /. delay; + emission#push !emitRate; + receiveRate := + a *. !receiveRate +. + (1. -. a) *. (!Remote.receivedBytes -. !receivedBytes) /. delay; + receiveRate2 := + b *. !receiveRate2 +. + (1. -. b) *. (!Remote.receivedBytes -. !receivedBytes) /. delay; + reception#push !receiveRate; + emittedBytes := !Remote.emittedBytes; + receivedBytes := !Remote.receivedBytes; + let kib2str v = Format.sprintf "%.0f B" v in + let rate2str v = + if v > 9.9e3 then begin + if v > 9.9e6 then + Format.sprintf "%4.0f MiB/s" (v /. 1e6) + else if v > 999e3 then + Format.sprintf "%4.1f MiB/s" (v /. 1e6) + else + Format.sprintf "%4.0f KiB/s" (v /. 1e3) + end else begin + if v > 990. then + Format.sprintf "%4.1f KiB/s" (v /. 1e3) + else if v > 99. then + Format.sprintf "%4.2f KiB/s" (v /. 1e3) + else + " " + end + in + lst#set_cell ~text:(rate2str !receiveRate2) 0 1; + lst#set_cell ~text:(rate2str !emitRate2) 0 2; + lst#set_cell ~text: + (rate2str (!receiveRate2 +. !emitRate2)) 0 3; + lst#set_cell ~text:(kib2str !receivedBytes) 1 1; + lst#set_cell ~text:(kib2str !emittedBytes) 1 2; + lst#set_cell ~text: + (kib2str (!receivedBytes +. !emittedBytes)) 1 3; + lst#set_cell ~text:(kib2str !clientWritten) 2 1; + lst#set_cell ~text:(kib2str !serverWritten) 2 2; + lst#set_cell ~text: + (kib2str (!clientWritten +. !serverWritten)) 2 3; + true + in + ignore (GMain.Timeout.add ~ms:(truncate (delay *. 1000.)) ~callback:timeout); + + t + +(****) + +(* Standard file dialog *) +let file_dialog ~title ~callback ?filename () = + let sel = GWindow.file_selection ~title ~modal:true ?filename () in + grabFocus sel; + ignore (sel#cancel_button#connect#clicked ~callback:sel#destroy); + ignore (sel#ok_button#connect#clicked ~callback: + (fun () -> + let name = sel#filename in + sel#destroy (); + callback name)); + sel#show (); + ignore (sel#connect#destroy ~callback:GMain.Main.quit); + GMain.Main.main (); + releaseFocus () + +(* ------ *) + +let fatalError message = + Trace.log (message ^ "\n"); + let title = "Fatal error" in + let t = + GWindow.dialog ~border_width:6 ~modal:true ~no_separator:true + ~allow_grow:false () in + t#vbox#set_spacing 12; + let h1 = GPack.hbox ~border_width:6 ~spacing:12 ~packing:t#vbox#pack () in + ignore (GMisc.image ~stock:`DIALOG_ERROR ~icon_size:`DIALOG + ~yalign:0. ~packing:h1#pack ()); + let v1 = GPack.vbox ~spacing:12 ~packing:h1#pack () in + ignore (GMisc.label + ~markup:(primaryText title ^ "\n\n" ^ + escapeMarkup (transcode message)) + ~selectable:true ~yalign:0. ~packing:v1#add ()); + t#add_button_stock `QUIT `QUIT; + t#set_default_response `QUIT; + grabFocus t; t#show(); ignore (t#run ()); t#destroy (); releaseFocus (); + exit 1 + +(* ------ *) + +let tryAgainOrQuit = fatalError + +(* ------ *) + +let getFirstRoot() = + let t = GWindow.dialog ~title:"Root selection" + ~modal:true ~allow_grow:true () in + t#misc#grab_focus (); + + let hb = GPack.hbox + ~packing:(t#vbox#pack ~expand:false ~padding:15) () in + ignore(GMisc.label ~text:tryAgainMessage + ~justify:`LEFT + ~packing:(hb#pack ~expand:false ~padding:15) ()); + + let f1 = GPack.hbox ~spacing:4 + ~packing:(t#vbox#pack ~expand:true ~padding:4) () in + ignore (GMisc.label ~text:"Dir:" ~packing:(f1#pack ~expand:false) ()); + let fileE = GEdit.entry ~packing:f1#add () in + fileE#misc#grab_focus (); + let browseCommand() = + file_dialog ~title:"Select a local directory" + ~callback:fileE#set_text ~filename:fileE#text () in + let b = GButton.button ~label:"Browse" + ~packing:(f1#pack ~expand:false) () in + ignore (b#connect#clicked ~callback:browseCommand); + + let f3 = t#action_area in + let result = ref None in + let contCommand() = + result := Some(fileE#text); + t#destroy () in + let contButton = GButton.button ~stock:`OK ~packing:f3#add () in + ignore (contButton#connect#clicked ~callback:contCommand); + ignore (fileE#connect#activate ~callback:contCommand); + contButton#grab_default (); + let quitButton = GButton.button ~stock:`QUIT ~packing:f3#add () in + ignore (quitButton#connect#clicked + ~callback:(fun () -> result := None; t#destroy())); + t#show (); + ignore (t#connect#destroy ~callback:GMain.Main.quit); + GMain.Main.main (); + match !result with None -> None + | Some file -> + Some(Clroot.clroot2string(Clroot.ConnectLocal(Some file))) + +(* ------ *) + +let getSecondRoot () = + let t = GWindow.dialog ~title:"Root selection" + ~modal:true ~allow_grow:true () in + t#misc#grab_focus (); + + let message = "Please enter the second directory you want to synchronize." in + + let vb = t#vbox in + let hb = GPack.hbox ~packing:(vb#pack ~expand:false ~padding:15) () in + ignore(GMisc.label ~text:message + ~justify:`LEFT + ~packing:(hb#pack ~expand:false ~padding:15) ()); + let helpB = GButton.button ~stock:`HELP ~packing:hb#add () in + ignore (helpB#connect#clicked + ~callback:(fun () -> okBox ~title:"Picking roots" ~typ:`INFO + ~message:helpmessage)); + + let result = ref None in + + let f = GPack.vbox ~packing:(vb#pack ~expand:false) () in + + let f1 = GPack.hbox ~spacing:4 ~packing:f#add () in + ignore (GMisc.label ~text:"Directory:" ~packing:(f1#pack ~expand:false) ()); + let fileE = GEdit.entry ~packing:f1#add () in + fileE#misc#grab_focus (); + let browseCommand() = + file_dialog ~title:"Select a local directory" + ~callback:fileE#set_text ~filename:fileE#text () in + let b = GButton.button ~label:"Browse" + ~packing:(f1#pack ~expand:false) () in + ignore (b#connect#clicked ~callback:browseCommand); + + let f0 = GPack.hbox ~spacing:4 ~packing:f#add () in + let localB = GButton.radio_button ~packing:(f0#pack ~expand:false) + ~label:"Local" () in + let sshB = GButton.radio_button ~group:localB#group + ~packing:(f0#pack ~expand:false) + ~label:"SSH" () in + let rshB = GButton.radio_button ~group:localB#group + ~packing:(f0#pack ~expand:false) ~label:"RSH" () in + let socketB = GButton.radio_button ~group:sshB#group + ~packing:(f0#pack ~expand:false) ~label:"Socket" () in + + let f2 = GPack.hbox ~spacing:4 ~packing:f#add () in + ignore (GMisc.label ~text:"Host:" ~packing:(f2#pack ~expand:false) ()); + let hostE = GEdit.entry ~packing:f2#add () in + + ignore (GMisc.label ~text:"(Optional) User:" + ~packing:(f2#pack ~expand:false) ()); + let userE = GEdit.entry ~packing:f2#add () in + + ignore (GMisc.label ~text:"Port:" + ~packing:(f2#pack ~expand:false) ()); + let portE = GEdit.entry ~packing:f2#add () in + + let varLocalRemote = ref (`Local : [`Local|`SSH|`RSH|`SOCKET]) in + let localState() = + varLocalRemote := `Local; + hostE#misc#set_sensitive false; + userE#misc#set_sensitive false; + portE#misc#set_sensitive false; + b#misc#set_sensitive true in + let remoteState() = + hostE#misc#set_sensitive true; + b#misc#set_sensitive false; + match !varLocalRemote with + `SOCKET -> + (portE#misc#set_sensitive true; userE#misc#set_sensitive false) + | _ -> + (portE#misc#set_sensitive false; userE#misc#set_sensitive true) in + let protoState x = + varLocalRemote := x; + remoteState() in + ignore (localB#connect#clicked ~callback:localState); + ignore (sshB#connect#clicked ~callback:(fun () -> protoState(`SSH))); + ignore (rshB#connect#clicked ~callback:(fun () -> protoState(`RSH))); + ignore (socketB#connect#clicked ~callback:(fun () -> protoState(`SOCKET))); + localState(); + let getRoot() = + let file = fileE#text in + let user = userE#text in + let host = hostE#text in + let port = portE#text in + match !varLocalRemote with + `Local -> + Clroot.clroot2string(Clroot.ConnectLocal(Some file)) + | `SSH | `RSH -> + Clroot.clroot2string( + Clroot.ConnectByShell((if !varLocalRemote=`SSH then "ssh" else "rsh"), + host, + (if user="" then None else Some user), + (if port="" then None else Some port), + Some file)) + | `SOCKET -> + Clroot.clroot2string( + (* FIX: report an error if the port entry is not well formed *) + Clroot.ConnectBySocket(host, + portE#text, + Some file)) in + let contCommand() = + try + let root = getRoot() in + result := Some root; + t#destroy () + with Failure "int_of_string" -> + if portE#text="" then + okBox ~title:"Error" ~typ:`ERROR ~message:"Please enter a port" + else okBox ~title:"Error" ~typ:`ERROR + ~message:"The port you specify must be an integer" + | _ -> + okBox ~title:"Error" ~typ:`ERROR + ~message:"Something's wrong with the values you entered, try again" in + let f3 = t#action_area in + let contButton = + GButton.button ~stock:`OK ~packing:f3#add () in + ignore (contButton#connect#clicked ~callback:contCommand); + contButton#grab_default (); + ignore (fileE#connect#activate ~callback:contCommand); + let quitButton = + GButton.button ~stock:`QUIT ~packing:f3#add () in + ignore (quitButton#connect#clicked ~callback:safeExit); + + t#show (); + ignore (t#connect#destroy ~callback:GMain.Main.quit); + GMain.Main.main (); + !result + +(* ------ *) + +let getPassword rootName msg = + let t = + GWindow.dialog ~title:"Unison: SSH connection" ~position:`CENTER + ~no_separator:true ~modal:true ~allow_grow:false ~border_width:6 () in + t#misc#grab_focus (); + + t#vbox#set_spacing 12; + + let header = + primaryText (Format.sprintf "Connecting to '%s'..." (protect rootName)) in + + let h1 = GPack.hbox ~border_width:6 ~spacing:12 ~packing:t#vbox#pack () in + (* FIX: DIALOG_AUTHENTICATION is way better but is not available + in the current release of LablGTK2... *) + ignore (GMisc.image ~stock:(*`DIALOG_AUTHENTICATION*)`DIALOG_QUESTION ~icon_size:`DIALOG + ~yalign:0. ~packing:h1#pack ()); + let v1 = GPack.vbox ~spacing:12 ~packing:h1#pack () in + ignore(GMisc.label ~markup:(header ^ "\n\n" ^ escapeMarkup (protect msg)) + ~selectable:true ~yalign:0. ~packing:v1#pack ()); + + let passwordE = GEdit.entry ~packing:v1#pack ~visibility:false () in + passwordE#misc#grab_focus (); + + t#add_button_stock `QUIT `QUIT; + t#add_button_stock `OK `OK; + t#set_default_response `OK; + ignore (passwordE#connect#activate ~callback:(fun _ -> t#response `OK)); + + grabFocus t; t#show(); + let res = t#run () in + let pwd = passwordE#text in + t#destroy (); releaseFocus (); + gtk_sync (); + begin match res with + `DELETE_EVENT | `QUIT -> safeExit (); "" + | `OK -> pwd + end + +let termInteract = Some getPassword + +(* ------ *) + +type profileInfo = {roots:string list; label:string option} + +(* ------ *) + +let profileKeymap = Array.create 10 None + +let provideProfileKey filename k profile info = + try + let i = int_of_string k in + if 0<=i && i<=9 then + match profileKeymap.(i) with + None -> profileKeymap.(i) <- Some(profile,info) + | Some(otherProfile,_) -> + raise (Util.Fatal + ("Error scanning profile "^filename^":\n" + ^ "shortcut key "^k^" is already bound to profile " + ^ otherProfile)) + else + raise (Util.Fatal + ("Error scanning profile "^filename^":\n" + ^ "Value of 'key' preference must be a single digit (0-9), " + ^ "not " ^ k)) + with int_of_string -> raise (Util.Fatal + ("Error scanning profile "^filename^":\n" + ^ "Value of 'key' preference must be a single digit (0-9), " + ^ "not " ^ k)) + +(* ------ *) + +let profilesAndRoots = ref [] + +let scanProfiles () = + Array.iteri (fun i _ -> profileKeymap.(i) <- None) profileKeymap; + profilesAndRoots := + (Safelist.map + (fun f -> + let f = Filename.chop_suffix f ".prf" in + let filename = Prefs.profilePathname f in + let fileContents = Safelist.map (fun (_, _, n, v) -> (n, v)) (Prefs.readAFile f) in + let roots = + Safelist.map snd + (Safelist.filter (fun (n, _) -> n = "root") fileContents) in + let label = + try Some(Safelist.assoc "label" fileContents) + with Not_found -> None in + let info = {roots=roots; label=label} in + (* If this profile has a 'key' binding, put it in the keymap *) + (try + let k = Safelist.assoc "key" fileContents in + provideProfileKey filename k f info + with Not_found -> ()); + (f, info)) + (Safelist.filter (fun name -> not ( Util.startswith name ".#" + || Util.startswith name Os.tempFilePrefix)) + (Files.ls (Fspath.toString Os.unisonDir) + "*.prf"))) + +let getProfile () = + (* The selected profile *) + let result = ref None in + + (* Build the dialog *) + let t = GWindow.dialog ~title:"Profiles" ~width:400 () in + + let cancelCommand _ = t#destroy (); exit 0 in + let cancelButton = GButton.button ~stock:`CANCEL + ~packing:t#action_area#add () in + ignore (cancelButton#connect#clicked ~callback:cancelCommand); + ignore (t#event#connect#delete ~callback:cancelCommand); + cancelButton#misc#set_can_default true; + + let okCommand() = + currentWindow := None; + t#destroy () in + let okButton = + GButton.button ~stock:`OK ~packing:t#action_area#add () in + ignore (okButton#connect#clicked ~callback:okCommand); + okButton#misc#set_sensitive false; + okButton#grab_default (); + + let vb = t#vbox in + + ignore (GMisc.label + ~text:"Select an existing profile or create a new one" + ~xpad:2 ~ypad:5 ~packing:(vb#pack ~expand:false) ()); + + let sw = + GBin.scrolled_window ~packing:(vb#pack ~expand:true) ~height:200 + ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in + let lst = GList.clist_poly ~selection_mode:`BROWSE ~packing:(sw#add) () in + let selRow = ref 0 in + let fillLst default = + scanProfiles(); + lst#freeze (); + lst#clear (); + let i = ref 0 in (* FIX: Work around a lablgtk bug *) + Safelist.iter + (fun (profile, info) -> + let labeltext = + match info.label with None -> "" | Some(l) -> " ("^l^")" in + let s = profile ^ labeltext in + ignore (lst#append [s]); + if profile = default then selRow := !i; + lst#set_row_data !i (profile, info); + incr i) + (Safelist.sort (fun (p, _) (p', _) -> compare p p') !profilesAndRoots); + let r = lst#rows in + let p = if r < 2 then 0. else float !selRow /. float (r - 1) in + lst#scroll_vertical `JUMP p; + lst#thaw () in + let tbl = + GPack.table ~rows:2 ~columns:2 ~packing:(vb#pack ~expand:true) () in + tbl#misc#set_sensitive false; + ignore (GMisc.label ~text:"Root 1:" ~xpad:2 + ~packing:(tbl#attach ~left:0 ~top:0 ~expand:`NONE) ()); + ignore (GMisc.label ~text:"Root 2:" ~xpad:2 + ~packing:(tbl#attach ~left:0 ~top:1 ~expand:`NONE) ()); + let root1 = + GEdit.entry ~packing:(tbl#attach ~left:1 ~top:0 ~expand:`X) + ~editable:false () in + let root2 = + GEdit.entry ~packing:(tbl#attach ~left:1 ~top:1 ~expand:`X) + ~editable:false () in + root1#misc#set_can_focus false; + root2#misc#set_can_focus false; + let hb = + GPack.hbox ~border_width:2 ~spacing:2 ~packing:(vb#pack ~expand:false) () + in + let nw = + GButton.button ~label:"Create new profile" + ~packing:(hb#pack ~expand:false) () in + ignore (nw#connect#clicked ~callback:(fun () -> + let t = + GWindow.dialog ~title:"New profile" ~modal:true () + in + let vb = GPack.vbox ~border_width:4 ~packing:t#vbox#add () in + let f = GPack.vbox ~packing:(vb#pack ~expand:true ~padding:4) () in + let f0 = GPack.hbox ~spacing:4 ~packing:f#add () in + ignore (GMisc.label ~text:"Profile name:" + ~packing:(f0#pack ~expand:false) ()); + let prof = GEdit.entry ~packing:f0#add () in + prof#misc#grab_focus (); + + let exit () = t#destroy (); GMain.Main.quit () in + ignore (t#event#connect#delete ~callback:(fun _ -> exit (); true)); + + let f3 = t#action_area in + let okCommand () = + let profile = prof#text in + if profile <> "" then + let filename = Prefs.profilePathname profile in + if Sys.file_exists filename then + okBox + ~title:"Error" ~typ:`ERROR + ~message:("Profile \"" + ^ (transcodeFilename profile) + ^ "\" already exists!\nPlease select another name.") + else + (* Make an empty file *) + let ch = + open_out_gen + [Open_wronly; Open_creat; Open_trunc] 0o600 filename in + close_out ch; + fillLst profile; + exit () in + let okButton = GButton.button ~stock:`OK ~packing:f3#add () in + ignore (okButton#connect#clicked ~callback:okCommand); + okButton#grab_default (); + let cancelButton = + GButton.button ~stock:`CANCEL ~packing:f3#add () in + ignore (cancelButton#connect#clicked ~callback:exit); + + t#show (); + grabFocus t; + GMain.Main.main (); + releaseFocus ())); + + ignore (lst#connect#unselect_row ~callback:(fun ~row:_ ~column:_ ~event:_ -> + root1#set_text ""; root2#set_text ""; + result := None; + tbl#misc#set_sensitive false; + okButton#misc#set_sensitive false)); + + let select_row i = + (* Inserting the first row triggers the signal, even before the row + data is set. So, we need to catch the corresponding exception *) + (try + let (profile, info) = lst#get_row_data i in + result := Some profile; + begin match info.roots with + [r1; r2] -> root1#set_text (protect r1); root2#set_text (protect r2); + tbl#misc#set_sensitive true + | _ -> root1#set_text ""; root2#set_text ""; + tbl#misc#set_sensitive false + end; + okButton#misc#set_sensitive true + with Gpointer.Null -> ()) in + + ignore (lst#connect#select_row + ~callback:(fun ~row:i ~column:_ ~event:_ -> select_row i)); + + ignore (lst#event#connect#button_press ~callback:(fun ev -> + match GdkEvent.get_type ev with + `TWO_BUTTON_PRESS -> + okCommand (); + true + | _ -> + false)); + fillLst "default"; + select_row !selRow; + lst#misc#grab_focus (); + currentWindow := Some (t :> GWindow.window_skel); + ignore (t#connect#destroy ~callback:GMain.Main.quit); + t#show (); + GMain.Main.main (); + !result + +(* ------ *) + +let documentation sect = + let title = "Documentation" in + let t = GWindow.dialog ~title () in + let t_dismiss = + GButton.button ~stock:`CLOSE ~packing:t#action_area#add () in + t_dismiss#grab_default (); + let dismiss () = t#destroy () in + ignore (t_dismiss#connect#clicked ~callback:dismiss); + ignore (t#event#connect#delete ~callback:(fun _ -> dismiss (); true)); + + let (name, docstr) = Safelist.assoc sect Strings.docs in + let docstr = transcodeDoc docstr in + let hb = GPack.hbox ~packing:(t#vbox#pack ~expand:false ~padding:2) () in + let optionmenu = + GMenu.option_menu ~packing:(hb#pack ~expand:true ~fill:false) () in + + let t_text = + new scrolled_text ~editable:false + ~width:80 ~height:20 ~packing:t#vbox#add () + in + t_text#insert docstr; + + let sect_idx = ref 0 in + let idx = ref 0 in + let menu = GMenu.menu () in + let addDocSection (shortname, (name, docstr)) = + if shortname <> "" && name <> "" then begin + if shortname = sect then sect_idx := !idx; + incr idx; + let item = GMenu.menu_item ~label:name ~packing:menu#append () in + let docstr = transcodeDoc docstr in + ignore + (item#connect#activate ~callback:(fun () -> t_text#insert docstr)) + end + in + Safelist.iter addDocSection Strings.docs; + optionmenu#set_menu menu; + optionmenu#set_history !sect_idx; + + t#show () + +(* ------ *) + +let messageBox ~title ?(action = fun t -> t#destroy) ?(modal = false) message = + let utitle = transcode title in + let t = GWindow.dialog ~title:utitle ~modal ~position:`CENTER () in + let t_dismiss = GButton.button ~stock:`CLOSE ~packing:t#action_area#add () in + t_dismiss#grab_default (); + ignore (t_dismiss#connect#clicked ~callback:(action t)); + let t_text = + new scrolled_text ~editable:false + ~width:80 ~height:20 ~packing:t#vbox#add () + in + t_text#insert message; + ignore (t#event#connect#delete ~callback:(fun _ -> action t (); true)); + t#show (); + if modal then begin + grabFocus t; + GMain.Main.main (); + releaseFocus () + end + +(* twoBoxAdvanced: Display a message in a window and wait for the user + to hit one of two buttons. Return true if the first button is + chosen, false if the second button is chosen. Also has a button for + showing more details to the user in a messageBox dialog *) +let twoBoxAdvanced ~title ~message ~longtext ~advLabel ~astock ~bstock = + let t = + GWindow.dialog ~border_width:6 ~modal:false ~no_separator:true + ~allow_grow:false () in + t#vbox#set_spacing 12; + let h1 = GPack.hbox ~border_width:6 ~spacing:12 ~packing:t#vbox#pack () in + ignore (GMisc.image ~stock:`DIALOG_WARNING ~icon_size:`DIALOG + ~yalign:0. ~packing:h1#pack ()); + let v1 = GPack.vbox ~spacing:12 ~packing:h1#pack () in + ignore (GMisc.label + ~markup:(primaryText title ^ "\n\n" ^ escapeMarkup message) + ~selectable:true ~yalign:0. ~packing:v1#add ()); + t#add_button_stock `CANCEL `NO; + let cmd () = + messageBox ~title:"Details" ~modal:false longtext + in + t#add_button advLabel `HELP; + t#add_button_stock `APPLY `YES; + t#set_default_response `NO; + let res = ref false in + let setRes signal = + match signal with + `YES -> res := true; t#destroy () + | `NO -> res := false; t#destroy () + | `HELP -> cmd () + | _ -> () + in + ignore (t#connect#response ~callback:setRes); + ignore (t#connect#destroy ~callback:GMain.Main.quit); + grabFocus t; t#show(); + GMain.Main.main(); + releaseFocus (); + !res + + +(********************************************************************** + TOP-LEVEL WINDOW + **********************************************************************) + +let myWindow = ref None + +let getMyWindow () = + if not (Prefs.read Uicommon.reuseToplevelWindows) then begin + (match !myWindow with Some(w) -> w#destroy() | None -> ()); + myWindow := None; + end; + let w = match !myWindow with + Some(w) -> + Safelist.iter w#remove w#children; + w + | None -> + (* Used to be ~position:`CENTER -- maybe that was better... *) + GWindow.window ~kind:`TOPLEVEL ~position:`CENTER + ~title:myNameCapitalized () in + myWindow := Some(w); + w#set_allow_grow true; + w + +(* ------ *) + +let displayWaitMessage () = + if not (Prefs.read Uicommon.contactquietly) then begin + (* FIX: should use a dialog *) + let w = getMyWindow() in + w#set_allow_grow false; + currentWindow := Some (w :> GWindow.window_skel); + let v = GPack.vbox ~packing:(w#add) ~border_width:2 () in + let bb = + GPack.button_box `HORIZONTAL ~layout:`END ~spacing:10 ~border_width:5 + ~packing:(v#pack ~fill:true ~from:`END) () in + let h1 = GPack.hbox ~border_width:12 ~spacing:12 ~packing:v#pack () in + ignore (GMisc.image ~stock:`DIALOG_INFO ~icon_size:`DIALOG + ~yalign:0. ~packing:h1#pack ()); + let m = + GMisc.label ~markup:(primaryText (Uicommon.contactingServerMsg())) + ~yalign:0. ~selectable:true ~packing:h1#add () in + m#misc#set_can_focus false; + let quit = GButton.button ~stock:`QUIT ~packing:bb#pack () in + quit#grab_default (); + ignore (quit#connect#clicked ~callback:safeExit); + ignore (w#event#connect#delete ~callback:(fun _ -> safeExit (); true)); + w#show() + end + +(* ------ *) + +let rec createToplevelWindow () = + let toplevelWindow = getMyWindow() in + (* There is already a default icon under Windows, and transparent + icons are not supported by all version of Windows *) + if Util.osType <> `Win32 then toplevelWindow#set_icon (Some icon); + let toplevelVBox = GPack.vbox ~packing:toplevelWindow#add () in + + (******************************************************************* + Statistic window + *******************************************************************) + + let stat_win = statistics () in + + (******************************************************************* + Groups of things that are sensitive to interaction at the same time + *******************************************************************) + let grAction = ref [] in + let grDiff = ref [] in + let grGo = ref [] in + let grRestart = ref [] in + let grAdd gr w = gr := w#misc::!gr in + let grSet gr st = Safelist.iter (fun x -> x#set_sensitive st) !gr in + + (********************************************************************* + Create the menu bar + *********************************************************************) + let topHBox = GPack.hbox ~packing:(toplevelVBox#pack ~expand:false) () in + + let menuBar = + GMenu.menu_bar ~border_width:0 + ~packing:(topHBox#pack ~expand:true) () in + let menus = new GMenu.factory ~accel_modi:[] menuBar in + let accel_group = menus#accel_group in + toplevelWindow#add_accel_group accel_group; + let add_submenu ?(modi=[]) ~label () = + new GMenu.factory ~accel_group ~accel_modi:modi (menus#add_submenu label) + in + + let profileLabel = + GMisc.label ~text:"" ~packing:(topHBox#pack ~expand:false ~padding:2) () in + + let displayNewProfileLabel p = + let label = Prefs.read Uicommon.profileLabel in + let s = + if p="" then "" + else if p="default" then label + else if label="" then p + else p ^ " (" ^ label ^ ")" in + toplevelWindow#set_title + (if s = "" then myNameCapitalized else + Format.sprintf "%s [%s]" myNameCapitalized s); + let s = if s="" then "" else "Profile: " ^ s in + profileLabel#set_text (transcodeFilename s) + in + + begin match !Prefs.profileName with + None -> () + | Some(p) -> displayNewProfileLabel p + end; + + (********************************************************************* + Create the menus + *********************************************************************) + let fileMenu = add_submenu ~label:"Synchronization" () + and actionsMenu = add_submenu ~label:"Actions" () + and ignoreMenu = add_submenu ~modi:[`SHIFT] ~label:"Ignore" () + and sortMenu = add_submenu ~label:"Sort" () + and helpMenu = add_submenu ~label:"Help" () in + + (********************************************************************* + Action bar + *********************************************************************) + let actionBar = + let hb = GBin.handle_box ~packing:(toplevelVBox#pack ~expand:false) () in + GButton.toolbar ~style:`BOTH + (* 2003-0519 (stse): how to set space size in gtk 2.0? *) + (* Answer from Jacques Garrigue: this can only be done in + the user's.gtkrc, not programmatically *) + ~orientation:`HORIZONTAL ~tooltips:true (* ~space_size:10 *) + ~packing:(hb#add) () in + + (********************************************************************* + Create the main window + *********************************************************************) + let mainWindow = + let sw = + GBin.scrolled_window ~packing:(toplevelVBox#pack ~expand:true) + ~height:(Prefs.read Uicommon.mainWindowHeight * 12) + ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in + GList.clist ~columns:5 ~titles_show:true + ~selection_mode:`BROWSE ~packing:sw#add () in + mainWindow#misc#grab_focus (); +(* + let cols = new GTree.column_list in + let c_replica1 = cols#add Gobject.Data.string in + let c_action = cols#add Gobject.Data.gobject in + let c_replica2 = cols#add Gobject.Data.string in + let c_status = cols#add Gobject.Data.string in + let c_path = cols#add Gobject.Data.string in + let lst_store = GTree.list_store cols in + let lst = + GTree.view ~model:lst_store ~packing:(toplevelVBox#add) + ~headers_clickable:false () in + let s = Uicommon.roots2string () in + ignore (lst#append_column + (GTree.view_column ~title:(" " ^ protect (String.sub s 0 12) ^ " ") + ~renderer:(GTree.cell_renderer_text [], ["text", c_replica1]) ())); + ignore (lst#append_column + (GTree.view_column ~title:" Action " + ~renderer:(GTree.cell_renderer_pixbuf [], ["pixbuf", c_action]) ())); + ignore (lst#append_column + (GTree.view_column ~title:(" " ^ protect (String.sub s 15 12) ^ " ") + ~renderer:(GTree.cell_renderer_text [], ["text", c_replica2]) ())); + ignore (lst#append_column + (GTree.view_column ~title:" Status " ())); + ignore (lst#append_column + (GTree.view_column ~title:" Path " + ~renderer:(GTree.cell_renderer_text [], ["text", c_path]) ())); +*) + +(* + let status_width = + let font = mainWindow#misc#style#font in + 4 + max (max (Gdk.Font.string_width font "working") + (Gdk.Font.string_width font "skipped")) + (Gdk.Font.string_width font " Action ") + in +*) + mainWindow#set_column ~justification:`CENTER 1; + mainWindow#set_column + ~justification:`CENTER (*~auto_resize:false ~width:status_width*) 3; + + let setMainWindowColumnHeaders () = + (* FIX: roots2string should return a pair *) + let s = Uicommon.roots2string () in + Array.iteri + (fun i data -> + mainWindow#set_column + ~title_active:false ~auto_resize:true ~title:data i) + [| " " ^ protect (String.sub s 0 12) ^ " "; " Action "; + " " ^ protect (String.sub s 15 12) ^ " "; " Status "; " Path" |] + in + setMainWindowColumnHeaders(); + + (********************************************************************* + Create the details window + *********************************************************************) + + let (showDetailsButton, detailsWindow) = + let sw = + GBin.frame ~packing:(toplevelVBox#pack ~expand:false) + ~shadow_type:`IN (*~hpolicy:`AUTOMATIC ~vpolicy:`NEVER*) () in + let hb =GPack.hbox ~packing:sw#add () in + (GButton.button ~label:"View details..." + ~show:false ~packing:(hb#pack ~expand:false) (), + GText.view ~editable:false ~wrap_mode:`NONE ~packing:hb#add ()) + + in + detailsWindow#misc#modify_font (Lazy.force fontMonospaceMediumPango); + detailsWindow#misc#set_size_chars ~height:3 ~width:112 (); + detailsWindow#misc#set_can_focus false; + let showDetCommand () = + let details = + match !current with + None -> "[No details available]" + | Some row -> + (match !theState.(row).whatHappened with + Some (Util.Failed _, Some det) -> det + | _ -> "[No details available]") in + messageBox ~title:"Merge execution details" details + in + ignore (showDetailsButton#connect#clicked ~callback:showDetCommand); + + let updateButtons () = + match !current with + None -> + grSet grAction false; + grSet grDiff false; + showDetailsButton#misc#hide () + | Some row -> + let (details, activate1, activate2) = + match !theState.(row).whatHappened, !theState.(row).ri.replicas with + | None, Different((`FILE, _, _, _),(`FILE, _, _, _), _, _) -> + (false, true, true) + | Some res, Different((`FILE, _, _, _),(`FILE, _, _, _), _, _) -> + (match res with + Util.Succeeded, _ -> (false, false, true) + | Util.Failed s, None -> (false, false, true) + | Util.Failed s, Some dText -> (true, false, false) + ) + | Some res, _ -> + (match res with + Util.Succeeded, _ -> (false, false, false) + | Util.Failed s, None -> (false, false, false) + | Util.Failed s, Some dText -> (true, false, false) + ) + | None, _ -> + (false, true, false) in + grSet grAction activate1; + grSet grDiff activate2; + if details then + showDetailsButton#misc#show () + else + showDetailsButton#misc#hide () + in + + let makeRowVisible row = + if mainWindow#row_is_visible row <> `FULL then begin + let adj = mainWindow#vadjustment in + let upper = adj#upper and lower = adj#lower in + let v = + float row /. float (mainWindow#rows + 1) *. (upper-.lower) +. lower + in + adj#set_value (min v (upper -. adj#page_size)) + end in + + let makeFirstUnfinishedVisible pRiInFocus = + let im = Array.length !theState in + let rec find i = + if i >= im then () else + match pRiInFocus (!theState.(i).ri), !theState.(i).whatHappened with + true, None -> makeRowVisible i + | _ -> find (i+1) in + find 0 + in + + let updateDetails () = + begin match !current with + None -> + detailsWindow#buffer#set_text "" + | Some row -> + makeRowVisible row; + let details = + match !theState.(row).whatHappened with + None -> Uicommon.details2string !theState.(row).ri " " + | Some(Util.Succeeded, _) -> Uicommon.details2string !theState.(row).ri " " + | Some(Util.Failed(s), None) -> s + | Some(Util.Failed(s), Some resultLog) -> s in + let path = Path.toString !theState.(row).ri.path in + detailsWindow#buffer#set_text + (transcodeFilename path ^ "\n" ^ transcode details); + end; + (* Display text *) + updateButtons () in + + (********************************************************************* + Status window + *********************************************************************) + + let statusHBox = GPack.hbox ~packing:(toplevelVBox#pack ~expand:false) () in + + let progressBar = + GRange.progress_bar ~packing:(statusHBox#pack ~expand:false) () in + progressBar#set_pulse_step 0.02; + let progressBarPulse = ref false in + + let statusWindow = + GMisc.statusbar ~packing:(statusHBox#pack ~expand:true) () in + let statusContext = statusWindow#new_context ~name:"status" in + ignore (statusContext#push ""); + + let displayStatus m = + statusContext#pop (); + if !progressBarPulse then progressBar#pulse (); + ignore (statusContext#push (transcode m)); + (* Force message to be displayed immediately *) + gtk_sync () + in + + let formatStatus major minor = (Util.padto 30 (major ^ " ")) ^ minor in + + (* Tell the Trace module about the status printer *) + Trace.messageDisplayer := displayStatus; + Trace.statusFormatter := formatStatus; + Trace.sendLogMsgsToStderr := false; + + (********************************************************************* + Functions used to print in the main window + *********************************************************************) + + let select i = + let r = mainWindow#rows in + let p = if r < 2 then 0. else (float i +. 0.5) /. float (r - 1) in + mainWindow#scroll_vertical `JUMP (min p 1.) + in + + ignore (mainWindow#connect#select_row ~callback: + (fun ~row ~column ~event -> current := Some row; updateDetails ())); + + let nextInteresting () = + let l = Array.length !theState in + let start = match !current with Some i -> i + 1 | None -> 0 in + let rec loop i = + if i < l then + match !theState.(i).ri.replicas with + Different (_, _, dir, _) + when not (Prefs.read Uicommon.auto) || !dir = Conflict -> + select i + | _ -> + loop (i + 1) in + loop start in + let selectSomethingIfPossible () = + if !current=None then nextInteresting () in + + let columnsOf i = + let oldPath = if i = 0 then Path.empty else !theState.(i-1).ri.path in + let status = + match !theState.(i).whatHappened with + None -> " " + | Some conf -> + match !theState.(i).ri.replicas with + Different(_,_,{contents=Conflict},_) | Problem _ -> + " " + | _ -> + match conf with + Util.Succeeded, _ -> "done " + | Util.Failed _, _ -> "failed" in + let s = Uicommon.reconItem2string oldPath !theState.(i).ri status in + (* FIX: This is ugly *) + (String.sub s 0 8, + String.sub s 9 5, + String.sub s 15 8, + String.sub s 25 6, + String.sub s 32 (String.length s - 32)) in + + let greenPixel = "00dd00" in + let redPixel = "ff2040" in + let yellowPixel = "999900" in + let lightbluePixel = "8888FF" in + let blackPixel = "000000" in + let buildPixmap p = + GDraw.pixmap_from_xpm_d ~window:toplevelWindow ~data:p () in + let buildPixmaps f c1 = + (buildPixmap (f c1), buildPixmap (f lightbluePixel)) in + + let rightArrow = buildPixmaps Pixmaps.copyAB greenPixel in + let leftArrow = buildPixmaps Pixmaps.copyBA greenPixel in + let ignoreAct = buildPixmaps Pixmaps.ignore redPixel in + let doneIcon = buildPixmap Pixmaps.success in + let failedIcon = buildPixmap Pixmaps.failure in + let rightArrowBlack = buildPixmap (Pixmaps.copyAB blackPixel) in + let leftArrowBlack = buildPixmap (Pixmaps.copyBA blackPixel) in + let mergeLogo = buildPixmaps Pixmaps.mergeLogo greenPixel in + let mergeLogoBlack = buildPixmap (Pixmaps.mergeLogo blackPixel) in + + let displayArrow i j action = + let changedFromDefault = match !theState.(j).ri.replicas with + Different(_,_,{contents=curr},default) -> curr<>default + | _ -> false in + let sel pixmaps = + if changedFromDefault then snd pixmaps else fst pixmaps in + match action with + "<-?->" -> mainWindow#set_cell ~pixmap:(sel ignoreAct) i 1 + | "<-M->" -> mainWindow#set_cell ~pixmap:(sel mergeLogo) i 1 + | "---->" -> mainWindow#set_cell ~pixmap:(sel rightArrow) i 1 + | "<----" -> mainWindow#set_cell ~pixmap:(sel leftArrow) i 1 + | "error" -> mainWindow#set_cell ~pixmap:failedIcon i 1 + | _ -> assert false in + + let displayStatusIcon i status = + match status with + | "failed" -> mainWindow#set_cell ~pixmap:failedIcon i 3 + | "done " -> mainWindow#set_cell ~pixmap:doneIcon i 3 + | _ -> mainWindow#set_cell ~text:status i 3 in + + let displayMain() = + (* The call to mainWindow#clear below side-effect current, + so we save the current value before we clear out the main window and + rebuild it. *) + let savedCurrent = !current in + mainWindow#freeze (); + mainWindow#clear (); + for i = Array.length !theState - 1 downto 0 do + let (r1, action, r2, status, path) = columnsOf i in +(* +let row = lst_store#prepend () in +lst_store#set ~row ~column:c_replica1 r1; +lst_store#set ~row ~column:c_replica2 r2; +lst_store#set ~row ~column:c_status status; +lst_store#set ~row ~column:c_path path; +*) + ignore (mainWindow#prepend + [ r1; ""; r2; status; transcodeFilename path ]); + displayArrow 0 i action + done; + debug (fun()-> Util.msg "reset current to %s\n" + (match savedCurrent with None->"None" | Some(i) -> string_of_int i)); + if savedCurrent <> None then current := savedCurrent; + selectSomethingIfPossible (); + begin match !current with Some idx -> select idx | None -> () end; + mainWindow#thaw (); + updateDetails (); + in + + let redisplay i = + let (r1, action, r2, status, path) = columnsOf i in + mainWindow#freeze (); + mainWindow#set_cell ~text:r1 i 0; + displayArrow i i action; + mainWindow#set_cell ~text:r2 i 2; + displayStatusIcon i status; + mainWindow#set_cell ~text:(transcodeFilename path) i 4; + if status = "failed" then begin + mainWindow#set_cell + ~text:(transcodeFilename path ^ + " [failed: click on this line for details]") i 4 + end; + mainWindow#thaw (); + if !current = Some i then updateDetails (); + updateButtons () in + + let totalBytesToTransfer = ref Uutil.Filesize.zero in + let totalBytesTransferred = ref Uutil.Filesize.zero in + + let displayGlobalProgress v = + progressBar#set_fraction (max 0. (min 1. (v /. 100.))); +(* + if v > 0.5 then + progressBar#set_text (Util.percent2string v) + else + progressBar#set_text ""; +*) + (* Force message to be displayed immediately *) + gtk_sync () in + + let showGlobalProgress b = + (* Concatenate the new message *) + totalBytesTransferred := Uutil.Filesize.add !totalBytesTransferred b; + let v = + (Uutil.Filesize.percentageOfTotalSize + !totalBytesTransferred !totalBytesToTransfer) + in + displayGlobalProgress v + in + + let initGlobalProgress b = + totalBytesToTransfer := b; + totalBytesTransferred := Uutil.Filesize.zero; + showGlobalProgress Uutil.Filesize.zero + in + + let (root1,root2) = Globals.roots () in + let root1IsLocal = fst root1 = Local in + let root2IsLocal = fst root2 = Local in + + let showProgress i bytes dbg = +(* XXX There should be a way to reset the amount of bytes transferred... *) + let i = Uutil.File.toLine i in + let item = !theState.(i) in + item.bytesTransferred <- Uutil.Filesize.add item.bytesTransferred bytes; + let b = item.bytesTransferred in + let len = Common.riLength item.ri in + let newstatus = + if b = Uutil.Filesize.zero || len = Uutil.Filesize.zero then "start " + else if len = Uutil.Filesize.zero then + Printf.sprintf "%5s " (Uutil.Filesize.toString b) + else Util.percent2string (Uutil.Filesize.percentageOfTotalSize b len) in + let dbg = if Trace.enabled "progress" then dbg ^ "/" else "" in + let newstatus = dbg ^ newstatus in + mainWindow#set_cell ~text:newstatus i 3; + showGlobalProgress bytes; + gtk_sync (); + begin match item.ri.replicas with + Different (_, _, dir, _) -> + begin match !dir with + Replica1ToReplica2 -> + if root2IsLocal then + clientWritten := !clientWritten +. Uutil.Filesize.toFloat bytes + else + serverWritten := !serverWritten +. Uutil.Filesize.toFloat bytes + | Replica2ToReplica1 -> + if root1IsLocal then + clientWritten := !clientWritten +. Uutil.Filesize.toFloat bytes + else + serverWritten := !serverWritten +. Uutil.Filesize.toFloat bytes + | Conflict | Merge -> + (* Diff / merge *) + clientWritten := !clientWritten +. Uutil.Filesize.toFloat bytes + end + | _ -> + assert false + end + in + + (* Install showProgress so that we get called back by low-level + file transfer stuff *) + Uutil.setProgressPrinter showProgress; + + (* Apply new ignore patterns to the current state, expecting that the + number of reconitems will grow smaller. Adjust the display, being + careful to keep the cursor as near as possible to its position + before the new ignore patterns take effect. *) + let ignoreAndRedisplay () = + let lst = Array.to_list !theState in + (* FIX: we should actually test whether any prefix is now ignored *) + let keep sI = not (Globals.shouldIgnore sI.ri.path) in + begin match !current with + None -> + theState := Array.of_list (Safelist.filter keep lst) + | Some index -> + let i = ref index in + let l = ref [] in + Array.iteri + (fun j sI -> if keep sI then l := sI::!l + else if j < !i then decr i) + !theState; + theState := Array.of_list (Safelist.rev !l); + current := if !l = [] then None + else Some (min (!i) ((Array.length !theState) - 1)); + end; + displayMain() in + + let sortAndRedisplay () = + current := None; + let compareRIs = Sortri.compareReconItems() in + Array.stable_sort (fun si1 si2 -> compareRIs si1.ri si2.ri) !theState; + displayMain() in + + (****************************************************************** + Main detect-updates-and-reconcile logic + ******************************************************************) + + let detectUpdatesAndReconcile () = + grSet grAction false; + grSet grDiff false; + grSet grGo false; + grSet grRestart false; + + mainWindow#clear(); + detailsWindow#buffer#set_text ""; + + progressBarPulse := true; + sync_action := Some (fun () -> progressBar#pulse ()); + let findUpdates () = + let t = Trace.startTimer "Checking for updates" in + Trace.status "Looking for changes"; + let updates = Update.findUpdates () in + Trace.showTimer t; + updates in + let reconcile updates = + let t = Trace.startTimer "Reconciling" in + let reconRes = Recon.reconcileAll updates in + Trace.showTimer t; + reconRes in + let (reconItemList, thereAreEqualUpdates, dangerousPaths) = + reconcile (findUpdates ()) in + if reconItemList = [] then + if thereAreEqualUpdates then + Trace.status "Replicas have been changed only in identical ways since last sync" + else + Trace.status "Everything is up to date" + else + Trace.status "Check and/or adjust selected actions; then press Go"; + theState := + Array.of_list + (Safelist.map + (fun ri -> { ri = ri; bytesTransferred = Uutil.Filesize.zero; + whatHappened = None }) + reconItemList); + current := None; + displayMain(); + progressBarPulse := false; sync_action := None; displayGlobalProgress 0.; + grSet grGo (Array.length !theState > 0); + grSet grRestart true; + if Prefs.read Globals.confirmBigDeletes then begin + if dangerousPaths <> [] then begin + Prefs.set Globals.batch false; + Util.warn (Uicommon.dangerousPathMsg dangerousPaths) + end; + end; + in + + (********************************************************************* + Help menu + *********************************************************************) + let addDocSection (shortname, (name, docstr)) = + if shortname <> "" && name <> "" then + ignore (helpMenu#add_item + ~callback:(fun () -> documentation shortname) + name) in + Safelist.iter addDocSection Strings.docs; + + (********************************************************************* + Ignore menu + *********************************************************************) + let addRegExpByPath pathfunc = + match !current with + Some i -> + Uicommon.addIgnorePattern (pathfunc !theState.(i).ri.path); + ignoreAndRedisplay () + | None -> + () in + grAdd grAction + (ignoreMenu#add_item ~key:GdkKeysyms._i + ~callback:(fun () -> getLock (fun () -> + addRegExpByPath Uicommon.ignorePath)) + "Permanently ignore this path"); + grAdd grAction + (ignoreMenu#add_item ~key:GdkKeysyms._E + ~callback:(fun () -> getLock (fun () -> + addRegExpByPath Uicommon.ignoreExt)) + "Permanently ignore files with this extension"); + grAdd grAction + (ignoreMenu#add_item ~key:GdkKeysyms._N + ~callback:(fun () -> getLock (fun () -> + addRegExpByPath Uicommon.ignoreName)) + "Permanently ignore files with this name (in any dir)"); + + (* + grAdd grRestart + (ignoreMenu#add_item ~callback: + (fun () -> getLock ignoreDialog) "Edit ignore patterns"); + *) + + (********************************************************************* + Sort menu + *********************************************************************) + grAdd grAction + (sortMenu#add_item + ~callback:(fun () -> getLock (fun () -> + Sortri.sortByName(); + sortAndRedisplay())) + "Sort entries by name"); + grAdd grAction + (sortMenu#add_item + ~callback:(fun () -> getLock (fun () -> + Sortri.sortBySize(); + sortAndRedisplay())) + "Sort entries by size"); + grAdd grAction + (sortMenu#add_item + ~callback:(fun () -> getLock (fun () -> + Sortri.sortNewFirst(); + sortAndRedisplay())) + "Sort new entries first"); + grAdd grAction + (sortMenu#add_item + ~callback:(fun () -> getLock (fun () -> + Sortri.restoreDefaultSettings(); + sortAndRedisplay())) + "Go back to default ordering"); + + (********************************************************************* + Main function : synchronize + *********************************************************************) + let synchronize () = + if Array.length !theState = 0 then + Trace.status "Nothing to synchronize" + else begin + grSet grAction false; + grSet grDiff false; + grSet grGo false; + grSet grRestart false; + + Trace.status "Propagating changes"; + Transport.logStart (); + let totalLength = + Array.fold_left + (fun l si -> Uutil.Filesize.add l (Common.riLength si.ri)) + Uutil.Filesize.zero !theState in + displayGlobalProgress 0.; + initGlobalProgress totalLength; + let t = Trace.startTimer "Propagating changes" in + let im = Array.length !theState in + let rec loop i actions pRiThisRound = + if i < im then begin + let theSI = !theState.(i) in + let textDetailed = ref None in + let action = + match theSI.whatHappened with + None -> + if not (pRiThisRound theSI.ri) then + return () + else + catch (fun () -> + Transport.transportItem + theSI.ri (Uutil.File.ofLine i) + (fun title text -> + textDetailed := (Some text); + if Prefs.read Uicommon.confirmmerge then + twoBoxAdvanced + ~title:title + ~message:("Do you want to commit the changes to" + ^ " the replicas ?") + ~longtext:text + ~advLabel:"View details..." + ~astock:`YES + ~bstock:`NO + else + true) + >>= (fun () -> + return Util.Succeeded)) + (fun e -> + match e with + Util.Transient s -> + return (Util.Failed s) + | _ -> + fail e) + >>= (fun res -> + theSI.whatHappened <- Some (res, !textDetailed); + redisplay i; + makeFirstUnfinishedVisible pRiThisRound; + gtk_sync (); + return ()) + | Some _ -> + return () (* Already processed this one (e.g. merged it) *) + in + loop (i + 1) (action :: actions) pRiThisRound + end else + return actions + in + Lwt_unix.run + (loop 0 [] (fun ri -> not (Common.isDeletion ri)) >>= (fun actions -> + Lwt_util.join actions)); + Lwt_unix.run + (loop 0 [] Common.isDeletion >>= (fun actions -> + Lwt_util.join actions)); + Transport.logFinish (); + Trace.showTimer t; + Trace.status "Updating synchronizer state"; + let t = Trace.startTimer "Updating synchronizer state" in + Update.commitUpdates(); + Trace.showTimer t; + + let failures = + let count = + Array.fold_left + (fun l si -> + l + (match si.whatHappened with Some(Util.Failed(_), _) -> 1 | _ -> 0)) + 0 !theState in + if count = 0 then "" else + Printf.sprintf "%d failure%s" count (if count=1 then "" else "s") in + let skipped = + let count = + Array.fold_left + (fun l si -> + l + (if problematic si.ri then 1 else 0)) + 0 !theState in + if count = 0 then "" else + Printf.sprintf "%d skipped" count in + Trace.status + (Printf.sprintf "Synchronization complete %s%s%s" + failures (if failures=""||skipped="" then "" else ", ") skipped); + displayGlobalProgress 0.; + + grSet grRestart true + end in + + (********************************************************************* + Quit button + *********************************************************************) +(* actionBar#insert_space ();*) + ignore (actionBar#insert_button ~text:"Quit" + ~icon:((GMisc.image ~stock:`QUIT ())#coerce) + ~tooltip:"Exit Unison" + ~callback:safeExit ()); + + (********************************************************************* + go button + *********************************************************************) +(* actionBar#insert_space ();*) + grAdd grGo + (actionBar#insert_button ~text:"Go" + (* tooltip:"Go with displayed actions" *) + ~icon:((GMisc.image ~stock:`EXECUTE ())#coerce) + ~tooltip:"Perform the synchronization" + ~callback:(fun () -> + getLock synchronize) ()); + + (********************************************************************* + Restart button + *********************************************************************) + let detectCmdName = "Restart" in + let detectCmd () = + getLock detectUpdatesAndReconcile; + if Prefs.read Globals.batch then begin + Prefs.set Globals.batch false; synchronize() + end + in +(* actionBar#insert_space ();*) + grAdd grRestart + (actionBar#insert_button ~text:detectCmdName + ~icon:((GMisc.image ~stock:`REFRESH ())#coerce) + ~tooltip:"Check for updates" + ~callback: detectCmd ()); + + (********************************************************************* + Buttons for <--, M, -->, Skip + *********************************************************************) + let doAction f = + match !current with + Some i -> + let theSI = !theState.(i) in + begin match theSI.whatHappened, theSI.ri.replicas with + None, Different(_, _, dir, _) -> + f dir; + redisplay i; + nextInteresting () + | _ -> + () + end + | None -> + () in + let leftAction _ = doAction (fun dir -> dir := Replica2ToReplica1) in + let rightAction _ = doAction (fun dir -> dir := Replica1ToReplica2) in + let questionAction _ = doAction (fun dir -> dir := Conflict) in + let mergeAction _ = doAction (fun dir -> dir := Merge) in + + actionBar#insert_space (); + grAdd grAction + (actionBar#insert_button +(* ~icon:((GMisc.pixmap leftArrowBlack ())#coerce)*) + ~icon:((GMisc.image ~stock:`GO_BACK ())#coerce) + ~text:"Right to Left" + ~tooltip:"Propagate this item from the right replica to the left one" + ~callback:leftAction ()); +(* actionBar#insert_space ();*) + grAdd grAction + (actionBar#insert_button +(* ~icon:((GMisc.pixmap mergeLogoBlack())#coerce)*) + ~icon:((GMisc.image ~stock:`ADD ())#coerce) + ~text:"Merge" + ~callback:mergeAction ()); +(* actionBar#insert_space ();*) + grAdd grAction + (actionBar#insert_button +(* ~icon:((GMisc.pixmap rightArrowBlack ())#coerce)*) + ~icon:((GMisc.image ~stock:`GO_FORWARD ())#coerce) + ~text:"Left to Right" + ~tooltip:"Propagate this item from the left replica to the right one" + ~callback:rightAction ()); +(* actionBar#insert_space ();*) + grAdd grAction + (actionBar#insert_button ~text:"Skip" + ~icon:((GMisc.image ~stock:`NO ())#coerce) + ~tooltip:"Skip this item" + ~callback:questionAction ()); + + (********************************************************************* + Diff / merge buttons + *********************************************************************) + let diffCmd () = + match !current with + Some i -> + getLock (fun () -> + Uicommon.showDiffs !theState.(i).ri + (fun title text -> messageBox ~title (transcode text)) + Trace.status (Uutil.File.ofLine i); + displayGlobalProgress 0.) + | None -> + () in + + actionBar#insert_space (); + grAdd grDiff (actionBar#insert_button ~text:"Diff" + ~icon:((GMisc.image ~stock:`DIALOG_INFO ())#coerce) + ~tooltip:"Compare the two items 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 ()); + *) + (********************************************************************* + Keyboard commands + *********************************************************************) + ignore + (mainWindow#event#connect#key_press ~callback: + begin fun ev -> + let key = GdkEvent.Key.keyval ev in + if key = GdkKeysyms._Left then begin + leftAction (); GtkSignal.stop_emit (); true + end else if key = GdkKeysyms._Right then begin + rightAction (); GtkSignal.stop_emit (); true + end else + false + end); + + (********************************************************************* + Action menu + *********************************************************************) + let (root1,root2) = Globals.roots () in + let loc1 = root2hostname root1 in + let loc2 = root2hostname root2 in + let descr = + if loc1 = loc2 then "left to right" else + Printf.sprintf "from %s to %s" loc1 loc2 in + let left = + actionsMenu#add_image_item ~key:GdkKeysyms._greater ~callback:rightAction + ~image:((GMisc.image ~stock:`GO_FORWARD ~icon_size:`MENU ())#coerce) + ~label:("Propagate this path " ^ descr) () in + grAdd grAction left; + left#add_accelerator ~group:accel_group ~modi:[`SHIFT] GdkKeysyms._greater; + left#add_accelerator ~group:accel_group GdkKeysyms._period; + + let merge = + actionsMenu#add_image_item ~key:GdkKeysyms._m ~callback:mergeAction + ~image:((GMisc.image ~stock:`ADD ~icon_size:`MENU ())#coerce) + ~label:"Merge the files" () in + grAdd grAction merge; +(* merge#add_accelerator ~group:accel_group ~modi:[`SHIFT] GdkKeysyms._m; *) + + let descl = + if loc1 = loc2 then "right to left" else + Printf.sprintf "from %s to %s" (protect loc2) (protect loc1) in + let right = + actionsMenu#add_image_item ~key:GdkKeysyms._less ~callback:leftAction + ~image:((GMisc.image ~stock:`GO_BACK ~icon_size:`MENU ())#coerce) + ~label:("Propagate this path " ^ descl) () in + grAdd grAction right; + right#add_accelerator ~group:accel_group ~modi:[`SHIFT] GdkKeysyms._less; + right#add_accelerator ~group:accel_group ~modi:[`SHIFT] GdkKeysyms._comma; + + grAdd grAction + (actionsMenu#add_image_item ~key:GdkKeysyms._slash ~callback:questionAction + ~image:((GMisc.image ~stock:`NO ~icon_size:`MENU ())#coerce) + ~label:"Do not propagate changes to this path" ()); + + (* Override actions *) + ignore (actionsMenu#add_separator ()); + grAdd grAction + (actionsMenu#add_item + ~callback:(fun () -> getLock (fun () -> + Array.iter + (fun si -> Recon.setDirection si.ri `Replica1ToReplica2 `Prefer) + !theState; + displayMain())) + "Resolve all conflicts in favor of first root"); + grAdd grAction + (actionsMenu#add_item + ~callback:(fun () -> getLock (fun () -> + Array.iter + (fun si -> Recon.setDirection si.ri `Replica2ToReplica1 `Prefer) + !theState; + displayMain())) + "Resolve all conflicts in favor of second root"); + grAdd grAction + (actionsMenu#add_item + ~callback:(fun () -> getLock (fun () -> + Array.iter + (fun si -> Recon.setDirection si.ri `Newer `Prefer) + !theState; + displayMain())) + "Resolve all conflicts in favor of most recently modified"); + grAdd grAction + (actionsMenu#add_item + ~callback:(fun () -> getLock (fun () -> + Array.iter + (fun si -> Recon.setDirection si.ri `Older `Prefer) + !theState; + displayMain())) + "Resolve all conflicts in favor of least recently modified"); + ignore (actionsMenu#add_separator ()); + grAdd grAction + (actionsMenu#add_item + ~callback:(fun () -> getLock (fun () -> + Array.iter + (fun si -> Recon.setDirection si.ri `Replica1ToReplica2 `Force) + !theState; + displayMain())) + "Force all changes from first root to second"); + grAdd grAction + (actionsMenu#add_item + ~callback:(fun () -> getLock (fun () -> + Array.iter + (fun si -> Recon.setDirection si.ri `Replica2ToReplica1 `Force) + !theState; + displayMain())) + "Force all changes from second root to first"); + grAdd grAction + (actionsMenu#add_item + ~callback:(fun () -> getLock (fun () -> + Array.iter + (fun si -> Recon.setDirection si.ri `Newer `Force) + !theState; + displayMain())) + "Force newer files to replace older ones"); + grAdd grAction + (actionsMenu#add_item + ~callback:(fun () -> getLock (fun () -> + Array.iter + (fun si -> Recon.setDirection si.ri `Merge `Force) + !theState; + displayMain())) + "Revert all paths to the merging default, if avaible"); + grAdd grAction + (actionsMenu#add_item + ~callback:(fun () -> getLock (fun () -> + Array.iter + (fun si -> Recon.setDirection si.ri `Older `Force) + !theState; + displayMain())) + "Force older files to replace newer ones"); + ignore (actionsMenu#add_separator ()); + grAdd grAction + (actionsMenu#add_item + ~callback:(fun () -> getLock (fun () -> + Array.iter + (fun si -> Recon.revertToDefaultDirection si.ri) + !theState; + displayMain())) + "Revert all paths to Unison's recommendations"); + grAdd grAction + (actionsMenu#add_item + ~callback:(fun () -> getLock (fun () -> + match !current with + Some i -> + let theSI = !theState.(i) in + Recon.revertToDefaultDirection theSI.ri; + redisplay i; + nextInteresting () + | None -> + ())) + "Revert selected path to Unison's recommendations"); + + (* Diff *) + ignore (actionsMenu#add_separator ()); + grAdd grDiff (actionsMenu#add_image_item ~key:GdkKeysyms._d ~callback:diffCmd + ~image:((GMisc.image ~stock:`DIALOG_INFO ~icon_size:`MENU ())#coerce) + ~label:"Show diffs for selected path" ()); + + (********************************************************************* + Synchronization menu + *********************************************************************) + + let loadProfile p = + debug (fun()-> Util.msg "Loading profile %s..." p); + Uicommon.initPrefs p displayWaitMessage getFirstRoot getSecondRoot + termInteract; + displayNewProfileLabel p; + setMainWindowColumnHeaders() + in + + let reloadProfile () = + match !Prefs.profileName with + None -> () + | Some(n) -> loadProfile n in + + grAdd grGo + (fileMenu#add_image_item ~key:GdkKeysyms._g + ~image:(GMisc.image ~stock:`EXECUTE ~icon_size:`MENU () :> GObj.widget) + ~callback:(fun () -> getLock synchronize) + ~label:"Go" ()); + grAdd grRestart + (fileMenu#add_image_item ~key:GdkKeysyms._r + ~image:(GMisc.image ~stock:`REFRESH ~icon_size:`MENU () :> GObj.widget) + ~callback:(fun () -> reloadProfile(); detectCmd()) + ~label:detectCmdName ()); + grAdd grRestart + (fileMenu#add_item ~key:GdkKeysyms._a + ~callback:(fun () -> + reloadProfile(); + Prefs.set Globals.batch true; + detectCmd()) + "Detect updates and proceed (without waiting)"); + grAdd grRestart + (fileMenu#add_item ~key:GdkKeysyms._f + ~callback:( + fun () -> + let rec loop i acc = + if i >= Array.length (!theState) then acc else + let notok = + (match !theState.(i).whatHappened with + None-> true + | Some(Util.Failed _, _) -> true + | Some(Util.Succeeded, _) -> false) + || match !theState.(i).ri.replicas with + Problem _ -> true + | Different(rc1,rc2,dir,_) -> + (match !dir with + Conflict -> true + | _ -> false) in + if notok then loop (i+1) (i::acc) + else loop (i+1) (acc) in + let failedindices = loop 0 [] in + let failedpaths = + Safelist.map (fun i -> !theState.(i).ri.path) failedindices in + debug (fun()-> Util.msg "Restarting with paths = %s\n" + (String.concat ", " (Safelist.map + (fun p -> "'"^(Path.toString p)^"'") + failedpaths))); + Prefs.set Globals.paths failedpaths; + Prefs.set Globals.confirmBigDeletes false; + detectCmd(); + reloadProfile()) + "Recheck unsynchronized items"); + + ignore (fileMenu#add_separator ()); + + grAdd grRestart + (fileMenu#add_image_item ~key:GdkKeysyms._p + ~callback:(fun _ -> + match getProfile() with + None -> () + | Some(p) -> loadProfile p; detectCmd ()) + ~image:(GMisc.image ~stock:`OPEN ~icon_size:`MENU () :> GObj.widget) + ~label:"Select a new profile from the profile dialog..." ()); + + let fastProf name key = + grAdd grRestart + (fileMenu#add_item ~key:key + ~callback:(fun _ -> + if Sys.file_exists (Prefs.profilePathname name) then begin + Trace.status ("Loading profile " ^ name); + loadProfile name; detectCmd () + end else + Trace.status ("Profile " ^ name ^ " not found")) + ("Select profile " ^ name)) in + + let fastKeysyms = + [| GdkKeysyms._0; GdkKeysyms._1; GdkKeysyms._2; GdkKeysyms._3; + GdkKeysyms._4; GdkKeysyms._5; GdkKeysyms._6; GdkKeysyms._7; + GdkKeysyms._8; GdkKeysyms._9 |] in + + Array.iteri + (fun i v -> match v with + None -> () + | Some(profile, info) -> + fastProf profile fastKeysyms.(i)) + profileKeymap; + + ignore (fileMenu#add_separator ()); + ignore (fileMenu#add_item + ~callback:(fun _ -> stat_win#show ()) "Statistics"); + + ignore (fileMenu#add_separator ()); + ignore (fileMenu#add_image_item + ~key:GdkKeysyms._q ~callback:safeExit + ~image:((GMisc.image ~stock:`QUIT ~icon_size:`MENU ())#coerce) + ~label:"Quit" ()); + + (********************************************************************* + Expert menu + *********************************************************************) + if Prefs.read Uicommon.expert then begin + let expertMenu = add_submenu ~label:"Expert" () in + + let addDebugToggle modname = + let cm = + expertMenu#add_check_item ~active:(Trace.enabled modname) + ~callback:(fun b -> Trace.enable modname b) + ("Debug '" ^ modname ^ "'") in + cm#set_show_toggle true in + + addDebugToggle "all"; + addDebugToggle "verbose"; + addDebugToggle "update"; + + ignore (expertMenu#add_separator ()); + ignore (expertMenu#add_item + ~callback:(fun () -> + Printf.fprintf stderr "\nGC stats now:\n"; + Gc.print_stat stderr; + Printf.fprintf stderr "\nAfter major collection:\n"; + Gc.full_major(); Gc.print_stat stderr; + flush stderr) + "Show memory/GC stats") + end; + + (********************************************************************* + Finish up + *********************************************************************) + grSet grAction false; + grSet grDiff false; + grSet grGo false; + grSet grRestart false; + + ignore (toplevelWindow#event#connect#delete ~callback: + (fun _ -> safeExit (); true)); + toplevelWindow#show (); + currentWindow := Some (toplevelWindow :> GWindow.window_skel); + detectCmd () + + +(********************************************************************* + STARTUP + *********************************************************************) + +let start _ = + begin try + (* Initialize the GTK library *) + ignore (GMain.Main.init ()); + + Util.warnPrinter := Some (warnBox "Warning"); + + GtkSignal.user_handler := + (fun exn -> + match exn with + Util.Transient(s) | Util.Fatal(s) -> fatalError s + | exn -> fatalError (Uicommon.exn2string exn)); + + (* Ask the Remote module to call us back at regular intervals during + long network operations. *) + let rec tick () = + gtk_sync (); + Lwt_unix.sleep 0.05 >>= tick + in + ignore_result (tick ()); + + Uicommon.uiInit + fatalError + tryAgainOrQuit + displayWaitMessage + getProfile + getFirstRoot + getSecondRoot + termInteract; + + scanProfiles(); + createToplevelWindow(); + + (* Display the ui *) + ignore (GMain.Timeout.add 500 (fun _ -> true)); + (* Hack: this allows signals such as SIGINT to be + handled even when Gtk is waiting for events *) + GMain.Main.main () + with + Util.Transient(s) | Util.Fatal(s) -> fatalError s + | exn -> fatalError (Uicommon.exn2string exn) + end + +end (* module Private *) + + +(********************************************************************* + UI SELECTION + *********************************************************************) + +module Body : Uicommon.UI = struct + +let start = function + Uicommon.Text -> Uitext.Body.start Uicommon.Text + | Uicommon.Graphic -> + let displayAvailable = + Util.osType = `Win32 + || + try Unix.getenv "DISPLAY" <> "" with Not_found -> false + in + if displayAvailable then Private.start Uicommon.Graphic + else Uitext.Body.start Uicommon.Text + +let defaultUi = Uicommon.Graphic + +end (* module Body *) Deleted: branches/2.32/src/uigtk2.mli =================================================================== --- trunk/src/uigtk2.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/uigtk2.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,4 +0,0 @@ -(* Unison file synchronizer: src/uigtk2.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -module Body : Uicommon.UI Copied: branches/2.32/src/uigtk2.mli (from rev 320, trunk/src/uigtk2.mli) =================================================================== --- branches/2.32/src/uigtk2.mli (rev 0) +++ branches/2.32/src/uigtk2.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,4 @@ +(* Unison file synchronizer: src/uigtk2.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +module Body : Uicommon.UI Deleted: branches/2.32/src/uimacnew/uimacnew.xcodeproj/project.pbxproj =================================================================== --- trunk/src/uimacnew/uimacnew.xcodeproj/project.pbxproj 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/uimacnew/uimacnew.xcodeproj/project.pbxproj 2009-05-02 02:31:27 UTC (rev 322) @@ -1,733 +0,0 @@ -// !$*UTF8*$! -{ - archiveVersion = 1; - classes = { - }; - objectVersion = 42; - objects = { - -/* Begin PBXAggregateTarget section */ - 2A124E780DE1C48400524237 /* Create ExternalSettings */ = { - isa = PBXAggregateTarget; - buildConfigurationList = 2A124E7C0DE1C4A200524237 /* Build configuration list for PBXAggregateTarget "Create ExternalSettings" */; - buildPhases = ( - 2A124E7E0DE1C4BE00524237 /* Run Script (version, ocaml lib dir) */, - ); - dependencies = ( - ); - name = "Create ExternalSettings"; - productName = "Create ExternalSettings"; - }; -/* End PBXAggregateTarget section */ - -/* Begin PBXBuildFile section */ - 2A3C3F3309922A8000E404E9 /* Growl.framework in CopyFiles */ = {isa = PBXBuildFile; fileRef = 2A3C3F3209922A8000E404E9 /* Growl.framework */; }; - 2A3C3F7D09922D4900E404E9 /* NotificationController.m in Sources */ = {isa = PBXBuildFile; fileRef = 2A3C3F7B09922D4900E404E9 /* NotificationController.m */; }; - 2A3C3FAE0992323F00E404E9 /* Growl.framework in Frameworks */ = {isa = PBXBuildFile; fileRef = 2A3C3F3209922A8000E404E9 /* Growl.framework */; }; - 2E282CC80D9AE2B000439D01 /* unison-blob.o in Frameworks */ = {isa = PBXBuildFile; fileRef = 2E282CC70D9AE2B000439D01 /* unison-blob.o */; }; - 44042CB60BE4FC9B00A6BBB2 /* ProgressCell.m in Sources */ = {isa = PBXBuildFile; fileRef = 44042CB40BE4FC9B00A6BBB2 /* ProgressCell.m */; }; - 44042D1B0BE52AED00A6BBB2 /* ProgressBarAdvanced.png in Resources */ = {isa = PBXBuildFile; fileRef = 44042D100BE52AED00A6BBB2 /* ProgressBarAdvanced.png */; }; - 44042D1C0BE52AEE00A6BBB2 /* ProgressBarBlue.png in Resources */ = {isa = PBXBuildFile; fileRef = 44042D110BE52AED00A6BBB2 /* ProgressBarBlue.png */; }; - 44042D1D0BE52AEE00A6BBB2 /* ProgressBarEndAdvanced.png in Resources */ = {isa = PBXBuildFile; fileRef = 44042D120BE52AED00A6BBB2 /* ProgressBarEndAdvanced.png */; }; - 44042D1E0BE52AEE00A6BBB2 /* ProgressBarEndBlue.png in Resources */ = {isa = PBXBuildFile; fileRef = 44042D130BE52AED00A6BBB2 /* ProgressBarEndBlue.png */; }; - 44042D1F0BE52AEE00A6BBB2 /* ProgressBarEndGray.png in Resources */ = {isa = PBXBuildFile; fileRef = 44042D140BE52AED00A6BBB2 /* ProgressBarEndGray.png */; }; - 44042D200BE52AEE00A6BBB2 /* ProgressBarEndGreen.png in Resources */ = {isa = PBXBuildFile; fileRef = 44042D150BE52AED00A6BBB2 /* ProgressBarEndGreen.png */; }; - 44042D210BE52AEE00A6BBB2 /* ProgressBarEndWhite.png in Resources */ = {isa = PBXBuildFile; fileRef = 44042D160BE52AED00A6BBB2 /* ProgressBarEndWhite.png */; }; - 44042D220BE52AEE00A6BBB2 /* ProgressBarGray.png in Resources */ = {isa = PBXBuildFile; fileRef = 44042D170BE52AED00A6BBB2 /* ProgressBarGray.png */; }; - 44042D230BE52AEE00A6BBB2 /* ProgressBarGreen.png in Resources */ = {isa = PBXBuildFile; fileRef = 44042D180BE52AED00A6BBB2 /* ProgressBarGreen.png */; }; - 44042D240BE52AEE00A6BBB2 /* ProgressBarLightGreen.png in Resources */ = {isa = PBXBuildFile; fileRef = 44042D190BE52AED00A6BBB2 /* ProgressBarLightGreen.png */; }; - 44042D250BE52AEE00A6BBB2 /* ProgressBarWhite.png in Resources */ = {isa = PBXBuildFile; fileRef = 44042D1A0BE52AED00A6BBB2 /* ProgressBarWhite.png */; }; - 440EEAF30C03EC3D00ACAAB0 /* Change_Created.png in Resources */ = {isa = PBXBuildFile; fileRef = 440EEAF20C03EC3D00ACAAB0 /* Change_Created.png */; }; - 440EEAF90C03F0B800ACAAB0 /* Change_Deleted.png in Resources */ = {isa = PBXBuildFile; fileRef = 440EEAF60C03F0B800ACAAB0 /* Change_Deleted.png */; }; - 440EEAFA0C03F0B800ACAAB0 /* Change_Modified.png in Resources */ = {isa = PBXBuildFile; fileRef = 440EEAF70C03F0B800ACAAB0 /* Change_Modified.png */; }; - 440EEAFB0C03F0B800ACAAB0 /* Change_PropsChanged.png in Resources */ = {isa = PBXBuildFile; fileRef = 440EEAF80C03F0B800ACAAB0 /* Change_PropsChanged.png */; }; - 445A291B0BFA5B3300E4E641 /* Outline-Deep.png in Resources */ = {isa = PBXBuildFile; fileRef = 445A291A0BFA5B3300E4E641 /* Outline-Deep.png */; }; - 445A29270BFA5C1200E4E641 /* Outline-Flat.png in Resources */ = {isa = PBXBuildFile; fileRef = 445A29260BFA5C1200E4E641 /* Outline-Flat.png */; }; - 445A29290BFA5C1B00E4E641 /* Outline-Flattened.png in Resources */ = {isa = PBXBuildFile; fileRef = 445A29280BFA5C1B00E4E641 /* Outline-Flattened.png */; }; - 445A2A5E0BFAB6C300E4E641 /* ImageAndTextCell.m in Sources */ = {isa = PBXBuildFile; fileRef = 445A2A5D0BFAB6C300E4E641 /* ImageAndTextCell.m */; }; - 449F03E10BE00DE9003F15C8 /* Bridge.m in Sources */ = {isa = PBXBuildFile; fileRef = 449F03DF0BE00DE9003F15C8 /* Bridge.m */; }; - 44A794A10BE16C380069680C /* ExceptionHandling.framework in Frameworks */ = {isa = PBXBuildFile; fileRef = 44A794A00BE16C380069680C /* ExceptionHandling.framework */; }; - 44A797F40BE3F9B70069680C /* table-mixed.tif in Resources */ = {isa = PBXBuildFile; fileRef = 44A797F10BE3F9B70069680C /* table-mixed.tif */; }; - 44F472B10C0DB735006428EF /* Change_Absent.png in Resources */ = {isa = PBXBuildFile; fileRef = 44F472AF0C0DB735006428EF /* Change_Absent.png */; }; - 44F472B20C0DB735006428EF /* Change_Unmodified.png in Resources */ = {isa = PBXBuildFile; fileRef = 44F472B00C0DB735006428EF /* Change_Unmodified.png */; }; - 69C625E60664EC3300B3C46A /* MainMenu.nib in Resources */ = {isa = PBXBuildFile; fileRef = 29B97318FDCFA39411CA2CEA /* MainMenu.nib */; }; - 69C625E70664EC3300B3C46A /* InfoPlist.strings in Resources */ = {isa = PBXBuildFile; fileRef = 089C165CFE840E0CC02AAC07 /* InfoPlist.strings */; }; - 69C625E80664EC3300B3C46A /* Unison.icns in Resources */ = {isa = PBXBuildFile; fileRef = 69C625CA0664E94E00B3C46A /* Unison.icns */; }; - 69C625EA0664EC3300B3C46A /* main.m in Sources */ = {isa = PBXBuildFile; fileRef = 29B97316FDCFA39411CA2CEA /* main.m */; settings = {ATTRIBUTES = (); }; }; - 69C625EB0664EC3300B3C46A /* MyController.m in Sources */ = {isa = PBXBuildFile; fileRef = 69660DC704F08CC100CF23A4 /* MyController.m */; }; - 69C625EC0664EC3300B3C46A /* ProfileController.m in Sources */ = {isa = PBXBuildFile; fileRef = 690F564504F11EC300CF23A4 /* ProfileController.m */; }; - 69C625ED0664EC3300B3C46A /* ReconItem.m in Sources */ = {isa = PBXBuildFile; fileRef = 69D3C6F904F1CC3700CF23A4 /* ReconItem.m */; }; - 69C625EE0664EC3300B3C46A /* ReconTableView.m in Sources */ = {isa = PBXBuildFile; fileRef = 69BA7DA904FD695200CF23A4 /* ReconTableView.m */; }; - 69C625EF0664EC3300B3C46A /* PreferencesController.m in Sources */ = {isa = PBXBuildFile; fileRef = 697985CE050CFA2D00CF23A4 /* PreferencesController.m */; }; - 69C625F00664EC3300B3C46A /* ProfileTableView.m in Sources */ = {isa = PBXBuildFile; fileRef = 691CE181051BB44A00CF23A4 /* ProfileTableView.m */; }; - 69C625F20664EC3300B3C46A /* Cocoa.framework in Frameworks */ = {isa = PBXBuildFile; fileRef = 1058C7A1FEA54F0111CA2CBB /* Cocoa.framework */; }; - 69E407BA07EB95AA00D37AA1 /* Security.framework in Frameworks */ = {isa = PBXBuildFile; fileRef = 69E407B907EB95AA00D37AA1 /* Security.framework */; }; - B518071C09D6652100B1B21F /* add.tif in Resources */ = {isa = PBXBuildFile; fileRef = B518071209D6652100B1B21F /* add.tif */; }; - B518071D09D6652100B1B21F /* diff.tif in Resources */ = {isa = PBXBuildFile; fileRef = B518071309D6652100B1B21F /* diff.tif */; }; - B518071E09D6652100B1B21F /* go.tif in Resources */ = {isa = PBXBuildFile; fileRef = B518071409D6652100B1B21F /* go.tif */; }; - B518071F09D6652100B1B21F /* left.tif in Resources */ = {isa = PBXBuildFile; fileRef = B518071509D6652100B1B21F /* left.tif */; }; - B518072009D6652100B1B21F /* merge.tif in Resources */ = {isa = PBXBuildFile; fileRef = B518071609D6652100B1B21F /* merge.tif */; }; - B518072109D6652100B1B21F /* quit.tif in Resources */ = {isa = PBXBuildFile; fileRef = B518071709D6652100B1B21F /* quit.tif */; }; - B518072209D6652100B1B21F /* restart.tif in Resources */ = {isa = PBXBuildFile; fileRef = B518071809D6652100B1B21F /* restart.tif */; }; - B518072309D6652100B1B21F /* right.tif in Resources */ = {isa = PBXBuildFile; fileRef = B518071909D6652100B1B21F /* right.tif */; }; - B518072409D6652100B1B21F /* save.tif in Resources */ = {isa = PBXBuildFile; fileRef = B518071A09D6652100B1B21F /* save.tif */; }; - B518072509D6652100B1B21F /* skip.tif in Resources */ = {isa = PBXBuildFile; fileRef = B518071B09D6652100B1B21F /* skip.tif */; }; - B554004109C4E5AA0089E1C3 /* UnisonToolbar.m in Sources */ = {isa = PBXBuildFile; fileRef = B554004009C4E5AA0089E1C3 /* UnisonToolbar.m */; }; - B5B44C1909DF61A4000DC7AF /* table-conflict.tif in Resources */ = {isa = PBXBuildFile; fileRef = B5B44C1109DF61A4000DC7AF /* table-conflict.tif */; }; - B5B44C1A09DF61A4000DC7AF /* table-error.tif in Resources */ = {isa = PBXBuildFile; fileRef = B5B44C1209DF61A4000DC7AF /* table-error.tif */; }; - B5B44C1B09DF61A4000DC7AF /* table-left-blue.tif in Resources */ = {isa = PBXBuildFile; fileRef = B5B44C1309DF61A4000DC7AF /* table-left-blue.tif */; }; - B5B44C1C09DF61A4000DC7AF /* table-left-green.tif in Resources */ = {isa = PBXBuildFile; fileRef = B5B44C1409DF61A4000DC7AF /* table-left-green.tif */; }; - B5B44C1D09DF61A4000DC7AF /* table-merge.tif in Resources */ = {isa = PBXBuildFile; fileRef = B5B44C1509DF61A4000DC7AF /* table-merge.tif */; }; - B5B44C1E09DF61A4000DC7AF /* table-right-blue.tif in Resources */ = {isa = PBXBuildFile; fileRef = B5B44C1609DF61A4000DC7AF /* table-right-blue.tif */; }; - B5B44C1F09DF61A4000DC7AF /* table-right-green.tif in Resources */ = {isa = PBXBuildFile; fileRef = B5B44C1709DF61A4000DC7AF /* table-right-green.tif */; }; - B5B44C2009DF61A4000DC7AF /* table-skip.tif in Resources */ = {isa = PBXBuildFile; fileRef = B5B44C1809DF61A4000DC7AF /* table-skip.tif */; }; - B5E03B3909E38B9E0058C7B9 /* rescan.tif in Resources */ = {isa = PBXBuildFile; fileRef = B5E03B3809E38B9E0058C7B9 /* rescan.tif */; }; -/* End PBXBuildFile section */ - -/* Begin PBXContainerItemProxy section */ - 2A124E7F0DE1C4E400524237 /* PBXContainerItemProxy */ = { - isa = PBXContainerItemProxy; - containerPortal = 29B97313FDCFA39411CA2CEA /* Project object */; - proxyType = 1; - remoteGlobalIDString = 2A124E780DE1C48400524237; - remoteInfo = "Create ExternalSettings"; - }; -/* End PBXContainerItemProxy section */ - -/* Begin PBXCopyFilesBuildPhase section */ - 2A3C3F3709922AA600E404E9 /* CopyFiles */ = { - isa = PBXCopyFilesBuildPhase; - buildActionMask = 2147483647; - dstPath = ""; - dstSubfolderSpec = 10; - files = ( - 2A3C3F3309922A8000E404E9 /* Growl.framework in CopyFiles */, - ); - runOnlyForDeploymentPostprocessing = 0; - }; -/* End PBXCopyFilesBuildPhase section */ - -/* Begin PBXFileReference section */ - 089C165DFE840E0CC02AAC07 /* English */ = {isa = PBXFileReference; fileEncoding = 10; lastKnownFileType = text.plist.strings; name = English; path = English.lproj/InfoPlist.strings; sourceTree = ""; }; - 1058C7A1FEA54F0111CA2CBB /* Cocoa.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; name = Cocoa.framework; path = /System/Library/Frameworks/Cocoa.framework; sourceTree = ""; }; - 29B97316FDCFA39411CA2CEA /* main.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = main.m; sourceTree = ""; }; - 29B97319FDCFA39411CA2CEA /* English */ = {isa = PBXFileReference; lastKnownFileType = wrapper.nib; name = English; path = English.lproj/MainMenu.nib; sourceTree = ""; }; - 2A3C3F3209922A8000E404E9 /* Growl.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; path = Growl.framework; sourceTree = ""; }; - 2A3C3F7A09922D4900E404E9 /* NotificationController.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = NotificationController.h; sourceTree = ""; }; - 2A3C3F7B09922D4900E404E9 /* NotificationController.m */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.objc; path = NotificationController.m; sourceTree = ""; }; - 2E282CC70D9AE2B000439D01 /* unison-blob.o */ = {isa = PBXFileReference; lastKnownFileType = "compiled.mach-o.objfile"; name = "unison-blob.o"; path = "../unison-blob.o"; sourceTree = SOURCE_ROOT; }; - 2E282CCC0D9AE2E800439D01 /* ExternalSettings.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = ExternalSettings.xcconfig; sourceTree = ""; }; - 44042CB30BE4FC9B00A6BBB2 /* ProgressCell.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = ProgressCell.h; sourceTree = ""; }; - 44042CB40BE4FC9B00A6BBB2 /* ProgressCell.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = ProgressCell.m; sourceTree = ""; }; - 44042D100BE52AED00A6BBB2 /* ProgressBarAdvanced.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarAdvanced.png; path = progressicons/ProgressBarAdvanced.png; sourceTree = ""; }; - 44042D110BE52AED00A6BBB2 /* ProgressBarBlue.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarBlue.png; path = progressicons/ProgressBarBlue.png; sourceTree = ""; }; - 44042D120BE52AED00A6BBB2 /* ProgressBarEndAdvanced.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarEndAdvanced.png; path = progressicons/ProgressBarEndAdvanced.png; sourceTree = ""; }; - 44042D130BE52AED00A6BBB2 /* ProgressBarEndBlue.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarEndBlue.png; path = progressicons/ProgressBarEndBlue.png; sourceTree = ""; }; - 44042D140BE52AED00A6BBB2 /* ProgressBarEndGray.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarEndGray.png; path = progressicons/ProgressBarEndGray.png; sourceTree = ""; }; - 44042D150BE52AED00A6BBB2 /* ProgressBarEndGreen.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarEndGreen.png; path = progressicons/ProgressBarEndGreen.png; sourceTree = ""; }; - 44042D160BE52AED00A6BBB2 /* ProgressBarEndWhite.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarEndWhite.png; path = progressicons/ProgressBarEndWhite.png; sourceTree = ""; }; - 44042D170BE52AED00A6BBB2 /* ProgressBarGray.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarGray.png; path = progressicons/ProgressBarGray.png; sourceTree = ""; }; - 44042D180BE52AED00A6BBB2 /* ProgressBarGreen.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarGreen.png; path = progressicons/ProgressBarGreen.png; sourceTree = ""; }; - 44042D190BE52AED00A6BBB2 /* ProgressBarLightGreen.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarLightGreen.png; path = progressicons/ProgressBarLightGreen.png; sourceTree = ""; }; - 44042D1A0BE52AED00A6BBB2 /* ProgressBarWhite.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarWhite.png; path = progressicons/ProgressBarWhite.png; sourceTree = ""; }; - 440EEAF20C03EC3D00ACAAB0 /* Change_Created.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = Change_Created.png; sourceTree = ""; }; - 440EEAF60C03F0B800ACAAB0 /* Change_Deleted.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = Change_Deleted.png; sourceTree = ""; }; - 440EEAF70C03F0B800ACAAB0 /* Change_Modified.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = Change_Modified.png; sourceTree = ""; }; - 440EEAF80C03F0B800ACAAB0 /* Change_PropsChanged.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = Change_PropsChanged.png; sourceTree = ""; }; - 445A291A0BFA5B3300E4E641 /* Outline-Deep.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = "Outline-Deep.png"; sourceTree = ""; }; - 445A29260BFA5C1200E4E641 /* Outline-Flat.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = "Outline-Flat.png"; sourceTree = ""; }; - 445A29280BFA5C1B00E4E641 /* Outline-Flattened.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = "Outline-Flattened.png"; sourceTree = ""; }; - 445A2A5B0BFAB6A100E4E641 /* ImageAndTextCell.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = ImageAndTextCell.h; sourceTree = ""; }; - 445A2A5D0BFAB6C300E4E641 /* ImageAndTextCell.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = ImageAndTextCell.m; sourceTree = ""; }; - 449F03DE0BE00DE9003F15C8 /* Bridge.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = Bridge.h; sourceTree = ""; }; - 449F03DF0BE00DE9003F15C8 /* Bridge.m */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.objc; path = Bridge.m; sourceTree = ""; }; - 44A794A00BE16C380069680C /* ExceptionHandling.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; name = ExceptionHandling.framework; path = /System/Library/Frameworks/ExceptionHandling.framework; sourceTree = ""; }; - 44A797F10BE3F9B70069680C /* table-mixed.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-mixed.tif"; sourceTree = ""; }; - 44F472AF0C0DB735006428EF /* Change_Absent.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = Change_Absent.png; sourceTree = ""; }; - 44F472B00C0DB735006428EF /* Change_Unmodified.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = Change_Unmodified.png; sourceTree = ""; }; - 690F564404F11EC300CF23A4 /* ProfileController.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = ProfileController.h; sourceTree = ""; }; - 690F564504F11EC300CF23A4 /* ProfileController.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = ProfileController.m; sourceTree = ""; }; - 691CE180051BB44A00CF23A4 /* ProfileTableView.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = ProfileTableView.h; sourceTree = ""; }; - 691CE181051BB44A00CF23A4 /* ProfileTableView.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = ProfileTableView.m; sourceTree = ""; }; - 69660DC604F08CC100CF23A4 /* MyController.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = MyController.h; sourceTree = ""; }; - 69660DC704F08CC100CF23A4 /* MyController.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = MyController.m; sourceTree = ""; }; - 697985CD050CFA2D00CF23A4 /* PreferencesController.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = PreferencesController.h; sourceTree = ""; }; - 697985CE050CFA2D00CF23A4 /* PreferencesController.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = PreferencesController.m; sourceTree = ""; }; - 69BA7DA804FD695200CF23A4 /* ReconTableView.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = ReconTableView.h; sourceTree = ""; }; - 69BA7DA904FD695200CF23A4 /* ReconTableView.m */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.objc; path = ReconTableView.m; sourceTree = ""; }; - 69C625CA0664E94E00B3C46A /* Unison.icns */ = {isa = PBXFileReference; lastKnownFileType = image.icns; path = Unison.icns; sourceTree = ""; }; - 69C625F40664EC3300B3C46A /* Info.plist */ = {isa = PBXFileReference; lastKnownFileType = text.plist.xml; path = Info.plist; sourceTree = ""; }; - 69C625F50664EC3300B3C46A /* Unison.app */ = {isa = PBXFileReference; explicitFileType = wrapper.application; includeInIndex = 0; path = Unison.app; sourceTree = BUILT_PRODUCTS_DIR; }; - 69D3C6F904F1CC3700CF23A4 /* ReconItem.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = ReconItem.m; sourceTree = ""; }; - 69D3C6FA04F1CC3700CF23A4 /* ReconItem.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = ReconItem.h; sourceTree = ""; }; - 69E407B907EB95AA00D37AA1 /* Security.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; name = Security.framework; path = /System/Library/Frameworks/Security.framework; sourceTree = ""; }; - B518071209D6652100B1B21F /* add.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = add.tif; sourceTree = ""; }; - B518071309D6652100B1B21F /* diff.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = diff.tif; sourceTree = ""; }; - B518071409D6652100B1B21F /* go.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = go.tif; sourceTree = ""; }; - B518071509D6652100B1B21F /* left.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = left.tif; sourceTree = ""; }; - B518071609D6652100B1B21F /* merge.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = merge.tif; sourceTree = ""; }; - B518071709D6652100B1B21F /* quit.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = quit.tif; sourceTree = ""; }; - B518071809D6652100B1B21F /* restart.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = restart.tif; sourceTree = ""; }; - B518071909D6652100B1B21F /* right.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = right.tif; sourceTree = ""; }; - B518071A09D6652100B1B21F /* save.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = save.tif; sourceTree = ""; }; - B518071B09D6652100B1B21F /* skip.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = skip.tif; sourceTree = ""; }; - B554003E09C4E5A00089E1C3 /* UnisonToolbar.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = UnisonToolbar.h; sourceTree = ""; }; - B554004009C4E5AA0089E1C3 /* UnisonToolbar.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = UnisonToolbar.m; sourceTree = ""; }; - B5B44C1109DF61A4000DC7AF /* table-conflict.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-conflict.tif"; sourceTree = ""; }; - B5B44C1209DF61A4000DC7AF /* table-error.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-error.tif"; sourceTree = ""; }; - B5B44C1309DF61A4000DC7AF /* table-left-blue.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-left-blue.tif"; sourceTree = ""; }; - B5B44C1409DF61A4000DC7AF /* table-left-green.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-left-green.tif"; sourceTree = ""; }; - B5B44C1509DF61A4000DC7AF /* table-merge.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-merge.tif"; sourceTree = ""; }; - B5B44C1609DF61A4000DC7AF /* table-right-blue.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-right-blue.tif"; sourceTree = ""; }; - B5B44C1709DF61A4000DC7AF /* table-right-green.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-right-green.tif"; sourceTree = ""; }; - B5B44C1809DF61A4000DC7AF /* table-skip.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-skip.tif"; sourceTree = ""; }; - B5E03B3809E38B9E0058C7B9 /* rescan.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; name = rescan.tif; path = toolbar/rescan.tif; sourceTree = ""; }; -/* End PBXFileReference section */ - -/* Begin PBXFrameworksBuildPhase section */ - 69C625F10664EC3300B3C46A /* Frameworks */ = { - isa = PBXFrameworksBuildPhase; - buildActionMask = 2147483647; - files = ( - 69C625F20664EC3300B3C46A /* Cocoa.framework in Frameworks */, - 69E407BA07EB95AA00D37AA1 /* Security.framework in Frameworks */, - 2A3C3FAE0992323F00E404E9 /* Growl.framework in Frameworks */, - 44A794A10BE16C380069680C /* ExceptionHandling.framework in Frameworks */, - 2E282CC80D9AE2B000439D01 /* unison-blob.o in Frameworks */, - ); - runOnlyForDeploymentPostprocessing = 0; - }; -/* End PBXFrameworksBuildPhase section */ - -/* Begin PBXGroup section */ - 19C28FACFE9D520D11CA2CBB /* Products */ = { - isa = PBXGroup; - children = ( - 69C625F50664EC3300B3C46A /* Unison.app */, - ); - name = Products; - sourceTree = ""; - }; - 29B97314FDCFA39411CA2CEA /* uimac */ = { - isa = PBXGroup; - children = ( - B5E03B3809E38B9E0058C7B9 /* rescan.tif */, - 44042D0F0BE52AD700A6BBB2 /* progressicons */, - B5B44C1009DF61A4000DC7AF /* tableicons */, - B518071109D6652000B1B21F /* toolbar */, - 44A795C90BE2B91B0069680C /* Classes */, - 29B97315FDCFA39411CA2CEA /* Other Sources */, - 29B97317FDCFA39411CA2CEA /* Resources */, - 29B97323FDCFA39411CA2CEA /* Frameworks */, - 19C28FACFE9D520D11CA2CBB /* Products */, - 69C625F40664EC3300B3C46A /* Info.plist */, - 2E282CCC0D9AE2E800439D01 /* ExternalSettings.xcconfig */, - 2E282CB80D9AE16300439D01 /* External objects */, - ); - name = uimac; - sourceTree = ""; - }; - 29B97315FDCFA39411CA2CEA /* Other Sources */ = { - isa = PBXGroup; - children = ( - 29B97316FDCFA39411CA2CEA /* main.m */, - ); - name = "Other Sources"; - sourceTree = ""; - }; - 29B97317FDCFA39411CA2CEA /* Resources */ = { - isa = PBXGroup; - children = ( - 29B97318FDCFA39411CA2CEA /* MainMenu.nib */, - 089C165CFE840E0CC02AAC07 /* InfoPlist.strings */, - 69C625CA0664E94E00B3C46A /* Unison.icns */, - ); - name = Resources; - sourceTree = ""; - }; - 29B97323FDCFA39411CA2CEA /* Frameworks */ = { - isa = PBXGroup; - children = ( - 1058C7A1FEA54F0111CA2CBB /* Cocoa.framework */, - 44A794A00BE16C380069680C /* ExceptionHandling.framework */, - 2A3C3F3209922A8000E404E9 /* Growl.framework */, - 69E407B907EB95AA00D37AA1 /* Security.framework */, - ); - name = Frameworks; - sourceTree = ""; - }; - 2E282CB80D9AE16300439D01 /* External objects */ = { - isa = PBXGroup; - children = ( - 2E282CC70D9AE2B000439D01 /* unison-blob.o */, - ); - name = "External objects"; - sourceTree = ""; - }; - 44042D0F0BE52AD700A6BBB2 /* progressicons */ = { - isa = PBXGroup; - children = ( - 44042D100BE52AED00A6BBB2 /* ProgressBarAdvanced.png */, - 44042D110BE52AED00A6BBB2 /* ProgressBarBlue.png */, - 44042D120BE52AED00A6BBB2 /* ProgressBarEndAdvanced.png */, - 44042D130BE52AED00A6BBB2 /* ProgressBarEndBlue.png */, - 44042D140BE52AED00A6BBB2 /* ProgressBarEndGray.png */, - 44042D150BE52AED00A6BBB2 /* ProgressBarEndGreen.png */, - 44042D160BE52AED00A6BBB2 /* ProgressBarEndWhite.png */, - 44042D170BE52AED00A6BBB2 /* ProgressBarGray.png */, - 44042D180BE52AED00A6BBB2 /* ProgressBarGreen.png */, - 44042D190BE52AED00A6BBB2 /* ProgressBarLightGreen.png */, - 44042D1A0BE52AED00A6BBB2 /* ProgressBarWhite.png */, - ); - name = progressicons; - sourceTree = ""; - }; - 44A795C90BE2B91B0069680C /* Classes */ = { - isa = PBXGroup; - children = ( - 69660DC604F08CC100CF23A4 /* MyController.h */, - 69660DC704F08CC100CF23A4 /* MyController.m */, - 2A3C3F7A09922D4900E404E9 /* NotificationController.h */, - 2A3C3F7B09922D4900E404E9 /* NotificationController.m */, - 69BA7DA804FD695200CF23A4 /* ReconTableView.h */, - 69BA7DA904FD695200CF23A4 /* ReconTableView.m */, - 69D3C6FA04F1CC3700CF23A4 /* ReconItem.h */, - 69D3C6F904F1CC3700CF23A4 /* ReconItem.m */, - 445A2A5B0BFAB6A100E4E641 /* ImageAndTextCell.h */, - 445A2A5D0BFAB6C300E4E641 /* ImageAndTextCell.m */, - 44042CB30BE4FC9B00A6BBB2 /* ProgressCell.h */, - 44042CB40BE4FC9B00A6BBB2 /* ProgressCell.m */, - 690F564404F11EC300CF23A4 /* ProfileController.h */, - 690F564504F11EC300CF23A4 /* ProfileController.m */, - 697985CD050CFA2D00CF23A4 /* PreferencesController.h */, - 697985CE050CFA2D00CF23A4 /* PreferencesController.m */, - 691CE180051BB44A00CF23A4 /* ProfileTableView.h */, - 691CE181051BB44A00CF23A4 /* ProfileTableView.m */, - B554003E09C4E5A00089E1C3 /* UnisonToolbar.h */, - B554004009C4E5AA0089E1C3 /* UnisonToolbar.m */, - 449F03DE0BE00DE9003F15C8 /* Bridge.h */, - 449F03DF0BE00DE9003F15C8 /* Bridge.m */, - ); - name = Classes; - sourceTree = ""; - }; - B518071109D6652000B1B21F /* toolbar */ = { - isa = PBXGroup; - children = ( - B518071209D6652100B1B21F /* add.tif */, - B518071309D6652100B1B21F /* diff.tif */, - B518071409D6652100B1B21F /* go.tif */, - B518071509D6652100B1B21F /* left.tif */, - B518071609D6652100B1B21F /* merge.tif */, - B518071709D6652100B1B21F /* quit.tif */, - B518071809D6652100B1B21F /* restart.tif */, - B518071909D6652100B1B21F /* right.tif */, - B518071A09D6652100B1B21F /* save.tif */, - B518071B09D6652100B1B21F /* skip.tif */, - ); - path = toolbar; - sourceTree = ""; - }; - B5B44C1009DF61A4000DC7AF /* tableicons */ = { - isa = PBXGroup; - children = ( - 44F472AF0C0DB735006428EF /* Change_Absent.png */, - 44F472B00C0DB735006428EF /* Change_Unmodified.png */, - 440EEAF60C03F0B800ACAAB0 /* Change_Deleted.png */, - 440EEAF70C03F0B800ACAAB0 /* Change_Modified.png */, - 440EEAF80C03F0B800ACAAB0 /* Change_PropsChanged.png */, - 440EEAF20C03EC3D00ACAAB0 /* Change_Created.png */, - 44A797F10BE3F9B70069680C /* table-mixed.tif */, - B5B44C1109DF61A4000DC7AF /* table-conflict.tif */, - B5B44C1209DF61A4000DC7AF /* table-error.tif */, - B5B44C1309DF61A4000DC7AF /* table-left-blue.tif */, - B5B44C1409DF61A4000DC7AF /* table-left-green.tif */, - B5B44C1509DF61A4000DC7AF /* table-merge.tif */, - B5B44C1609DF61A4000DC7AF /* table-right-blue.tif */, - B5B44C1709DF61A4000DC7AF /* table-right-green.tif */, - B5B44C1809DF61A4000DC7AF /* table-skip.tif */, - 445A291A0BFA5B3300E4E641 /* Outline-Deep.png */, - 445A29260BFA5C1200E4E641 /* Outline-Flat.png */, - 445A29280BFA5C1B00E4E641 /* Outline-Flattened.png */, - ); - path = tableicons; - sourceTree = ""; - }; -/* End PBXGroup section */ - -/* Begin PBXNativeTarget section */ - 69C625DD0664EC3300B3C46A /* uimac */ = { - isa = PBXNativeTarget; - buildConfigurationList = 2A3C3F280992245300E404E9 /* Build configuration list for PBXNativeTarget "uimac" */; - buildPhases = ( - 2E282CBA0D9AE17300439D01 /* Run Script (make unison-blob.o) */, - 69C625E50664EC3300B3C46A /* Resources */, - 69C625E90664EC3300B3C46A /* Sources */, - 69C625F10664EC3300B3C46A /* Frameworks */, - 2A3C3F3709922AA600E404E9 /* CopyFiles */, - ); - buildRules = ( - ); - dependencies = ( - 2A124E800DE1C4E400524237 /* PBXTargetDependency */, - ); - name = uimac; - productInstallPath = "$(HOME)/Applications"; - productName = uimac; - productReference = 69C625F50664EC3300B3C46A /* Unison.app */; - productType = "com.apple.product-type.application"; - }; -/* End PBXNativeTarget section */ - -/* Begin PBXProject section */ - 29B97313FDCFA39411CA2CEA /* Project object */ = { - isa = PBXProject; - buildConfigurationList = 2A3C3F2C0992245300E404E9 /* Build configuration list for PBXProject "uimacnew" */; - compatibilityVersion = "Xcode 2.4"; - hasScannedForEncodings = 1; - mainGroup = 29B97314FDCFA39411CA2CEA /* uimac */; - projectDirPath = ""; - projectRoot = ""; - targets = ( - 69C625DD0664EC3300B3C46A /* uimac */, - 2A124E780DE1C48400524237 /* Create ExternalSettings */, - ); - }; -/* End PBXProject section */ - -/* Begin PBXResourcesBuildPhase section */ - 69C625E50664EC3300B3C46A /* Resources */ = { - isa = PBXResourcesBuildPhase; - buildActionMask = 2147483647; - files = ( - 69C625E60664EC3300B3C46A /* MainMenu.nib in Resources */, - 69C625E70664EC3300B3C46A /* InfoPlist.strings in Resources */, - 69C625E80664EC3300B3C46A /* Unison.icns in Resources */, - B518071C09D6652100B1B21F /* add.tif in Resources */, - B518071D09D6652100B1B21F /* diff.tif in Resources */, - B518071E09D6652100B1B21F /* go.tif in Resources */, - B518071F09D6652100B1B21F /* left.tif in Resources */, - B518072009D6652100B1B21F /* merge.tif in Resources */, - B518072109D6652100B1B21F /* quit.tif in Resources */, - B518072209D6652100B1B21F /* restart.tif in Resources */, - B518072309D6652100B1B21F /* right.tif in Resources */, - B518072409D6652100B1B21F /* save.tif in Resources */, - B518072509D6652100B1B21F /* skip.tif in Resources */, - B5B44C1909DF61A4000DC7AF /* table-conflict.tif in Resources */, - B5B44C1A09DF61A4000DC7AF /* table-error.tif in Resources */, - B5B44C1B09DF61A4000DC7AF /* table-left-blue.tif in Resources */, - B5B44C1C09DF61A4000DC7AF /* table-left-green.tif in Resources */, - B5B44C1D09DF61A4000DC7AF /* table-merge.tif in Resources */, - B5B44C1E09DF61A4000DC7AF /* table-right-blue.tif in Resources */, - B5B44C1F09DF61A4000DC7AF /* table-right-green.tif in Resources */, - B5B44C2009DF61A4000DC7AF /* table-skip.tif in Resources */, - B5E03B3909E38B9E0058C7B9 /* rescan.tif in Resources */, - 44A797F40BE3F9B70069680C /* table-mixed.tif in Resources */, - 44042D1B0BE52AED00A6BBB2 /* ProgressBarAdvanced.png in Resources */, - 44042D1C0BE52AEE00A6BBB2 /* ProgressBarBlue.png in Resources */, - 44042D1D0BE52AEE00A6BBB2 /* ProgressBarEndAdvanced.png in Resources */, - 44042D1E0BE52AEE00A6BBB2 /* ProgressBarEndBlue.png in Resources */, - 44042D1F0BE52AEE00A6BBB2 /* ProgressBarEndGray.png in Resources */, - 44042D200BE52AEE00A6BBB2 /* ProgressBarEndGreen.png in Resources */, - 44042D210BE52AEE00A6BBB2 /* ProgressBarEndWhite.png in Resources */, - 44042D220BE52AEE00A6BBB2 /* ProgressBarGray.png in Resources */, - 44042D230BE52AEE00A6BBB2 /* ProgressBarGreen.png in Resources */, - 44042D240BE52AEE00A6BBB2 /* ProgressBarLightGreen.png in Resources */, - 44042D250BE52AEE00A6BBB2 /* ProgressBarWhite.png in Resources */, - 445A291B0BFA5B3300E4E641 /* Outline-Deep.png in Resources */, - 445A29270BFA5C1200E4E641 /* Outline-Flat.png in Resources */, - 445A29290BFA5C1B00E4E641 /* Outline-Flattened.png in Resources */, - 440EEAF30C03EC3D00ACAAB0 /* Change_Created.png in Resources */, - 440EEAF90C03F0B800ACAAB0 /* Change_Deleted.png in Resources */, - 440EEAFA0C03F0B800ACAAB0 /* Change_Modified.png in Resources */, - 440EEAFB0C03F0B800ACAAB0 /* Change_PropsChanged.png in Resources */, - 44F472B10C0DB735006428EF /* Change_Absent.png in Resources */, - 44F472B20C0DB735006428EF /* Change_Unmodified.png in Resources */, - ); - runOnlyForDeploymentPostprocessing = 0; - }; -/* End PBXResourcesBuildPhase section */ - -/* Begin PBXShellScriptBuildPhase section */ - 2A124E7E0DE1C4BE00524237 /* Run Script (version, ocaml lib dir) */ = { - isa = PBXShellScriptBuildPhase; - buildActionMask = 2147483647; - files = ( - ); - inputPaths = ( - ); - name = "Run Script (version, ocaml lib dir)"; - outputPaths = ( - ); - runOnlyForDeploymentPostprocessing = 0; - shellPath = /bin/sh; - shellScript = "if [ -x /usr/libexec/path_helper ]; then\n eval `/usr/libexec/path_helper -s`\nfi\nif [ ! -x ${PROJECT_DIR}/../Makefile.ProjectInfo ]; then\n if [ ! -x ${PROJECT_DIR}/../mkProjectInfo ]; then\n cd ${PROJECT_DIR}/..; ocamlc -o mkProjectInfo mkProjectInfo.ml\n fi\n cd ${PROJECT_DIR}/..; ./mkProjectInfo > Makefile.ProjectInfo\nfi\nOCAMLLIBDIR=`ocamlc -v | tail -n -1 | sed -e 's/.* //g' | sed -e 's/\\\\\\/\\\\//g' | tr -d '\\r'`\nsource ${PROJECT_DIR}/../Makefile.ProjectInfo\necho MARKETING_VERSION = $VERSION > ${PROJECT_DIR}/ExternalSettings.xcconfig\necho OCAMLLIBDIR = $OCAMLLIBDIR >> ${PROJECT_DIR}/ExternalSettings.xcconfig"; - }; - 2E282CBA0D9AE17300439D01 /* Run Script (make unison-blob.o) */ = { - isa = PBXShellScriptBuildPhase; - buildActionMask = 2147483647; - files = ( - ); - inputPaths = ( - ); - name = "Run Script (make unison-blob.o)"; - outputPaths = ( - ); - runOnlyForDeploymentPostprocessing = 0; - shellPath = /bin/sh; - shellScript = "echo \"Building unison-blob.o...\"\nif [ -x /usr/libexec/path_helper ]; then\n eval `/usr/libexec/path_helper -s`\nfi\ncd ${PROJECT_DIR}/..\nmake unison-blob.o\necho \"done\""; - }; -/* End PBXShellScriptBuildPhase section */ - -/* Begin PBXSourcesBuildPhase section */ - 69C625E90664EC3300B3C46A /* Sources */ = { - isa = PBXSourcesBuildPhase; - buildActionMask = 2147483647; - files = ( - 69C625EA0664EC3300B3C46A /* main.m in Sources */, - 69C625EB0664EC3300B3C46A /* MyController.m in Sources */, - 69C625EC0664EC3300B3C46A /* ProfileController.m in Sources */, - 69C625ED0664EC3300B3C46A /* ReconItem.m in Sources */, - 69C625EE0664EC3300B3C46A /* ReconTableView.m in Sources */, - 69C625EF0664EC3300B3C46A /* PreferencesController.m in Sources */, - 69C625F00664EC3300B3C46A /* ProfileTableView.m in Sources */, - 2A3C3F7D09922D4900E404E9 /* NotificationController.m in Sources */, - B554004109C4E5AA0089E1C3 /* UnisonToolbar.m in Sources */, - 449F03E10BE00DE9003F15C8 /* Bridge.m in Sources */, - 44042CB60BE4FC9B00A6BBB2 /* ProgressCell.m in Sources */, - 445A2A5E0BFAB6C300E4E641 /* ImageAndTextCell.m in Sources */, - ); - runOnlyForDeploymentPostprocessing = 0; - }; -/* End PBXSourcesBuildPhase section */ - -/* Begin PBXTargetDependency section */ - 2A124E800DE1C4E400524237 /* PBXTargetDependency */ = { - isa = PBXTargetDependency; - target = 2A124E780DE1C48400524237 /* Create ExternalSettings */; - targetProxy = 2A124E7F0DE1C4E400524237 /* PBXContainerItemProxy */; - }; -/* End PBXTargetDependency section */ - -/* Begin PBXVariantGroup section */ - 089C165CFE840E0CC02AAC07 /* InfoPlist.strings */ = { - isa = PBXVariantGroup; - children = ( - 089C165DFE840E0CC02AAC07 /* English */, - ); - name = InfoPlist.strings; - sourceTree = ""; - }; - 29B97318FDCFA39411CA2CEA /* MainMenu.nib */ = { - isa = PBXVariantGroup; - children = ( - 29B97319FDCFA39411CA2CEA /* English */, - ); - name = MainMenu.nib; - sourceTree = ""; - }; -/* End PBXVariantGroup section */ - -/* Begin XCBuildConfiguration section */ - 2A124E790DE1C48400524237 /* Development */ = { - isa = XCBuildConfiguration; - buildSettings = { - COPY_PHASE_STRIP = NO; - GCC_DYNAMIC_NO_PIC = NO; - GCC_OPTIMIZATION_LEVEL = 0; - PRODUCT_NAME = "Create ExternalSettings"; - }; - name = Development; - }; - 2A124E7A0DE1C48400524237 /* Deployment */ = { - isa = XCBuildConfiguration; - buildSettings = { - COPY_PHASE_STRIP = YES; - DEBUG_INFORMATION_FORMAT = "dwarf-with-dsym"; - GCC_ENABLE_FIX_AND_CONTINUE = NO; - PRODUCT_NAME = "Create ExternalSettings"; - ZERO_LINK = NO; - }; - name = Deployment; - }; - 2A124E7B0DE1C48400524237 /* Default */ = { - isa = XCBuildConfiguration; - buildSettings = { - PRODUCT_NAME = "Create ExternalSettings"; - }; - name = Default; - }; - 2A3C3F290992245300E404E9 /* Development */ = { - isa = XCBuildConfiguration; - buildSettings = { - COPY_PHASE_STRIP = NO; - FRAMEWORK_SEARCH_PATHS = ( - "$(FRAMEWORK_SEARCH_PATHS)", - "$(SRCROOT)", - ); - GCC_DYNAMIC_NO_PIC = NO; - GCC_ENABLE_FIX_AND_CONTINUE = YES; - GCC_ENABLE_OBJC_EXCEPTIONS = YES; - GCC_GENERATE_DEBUGGING_SYMBOLS = YES; - GCC_OPTIMIZATION_LEVEL = 0; - GCC_PRECOMPILE_PREFIX_HEADER = YES; - INFOPLIST_FILE = Info.plist; - INSTALL_PATH = "$(HOME)/Applications"; - LIBRARY_SEARCH_PATHS = ""; - NSZombieEnabled = YES; - OTHER_CFLAGS = ""; - OTHER_LDFLAGS = ( - "-L$(OCAMLLIBDIR)", - "-lunix", - "-lthreadsnat", - "-lstr", - "-lasmrun", - ); - PREBINDING = NO; - PRODUCT_NAME = Unison; - SECTORDER_FLAGS = ""; - WARNING_CFLAGS = ( - "-Wmost", - "-Wno-four-char-constants", - "-Wno-unknown-pragmas", - ); - WRAPPER_EXTENSION = app; - ZERO_LINK = YES; - }; - name = Development; - }; - 2A3C3F2A0992245300E404E9 /* Deployment */ = { - isa = XCBuildConfiguration; - buildSettings = { - COPY_PHASE_STRIP = YES; - FRAMEWORK_SEARCH_PATHS = ( - "$(FRAMEWORK_SEARCH_PATHS)", - "$(SRCROOT)", - ); - GCC_ENABLE_FIX_AND_CONTINUE = NO; - GCC_ENABLE_OBJC_EXCEPTIONS = YES; - GCC_PRECOMPILE_PREFIX_HEADER = YES; - GCC_WARN_FOUR_CHARACTER_CONSTANTS = YES; - INFOPLIST_FILE = Info.plist; - INSTALL_PATH = "$(HOME)/Applications"; - LIBRARY_SEARCH_PATHS = ""; - OTHER_CFLAGS = ""; - OTHER_LDFLAGS = ( - "-L$(OCAMLLIBDIR)", - "-lunix", - "-lthreadsnat", - "-lstr", - "-lasmrun", - ); - PREBINDING = NO; - PRODUCT_NAME = Unison; - SECTORDER_FLAGS = ""; - WARNING_CFLAGS = ( - "-Wmost", - "-Wno-four-char-constants", - "-Wno-unknown-pragmas", - ); - WRAPPER_EXTENSION = app; - ZERO_LINK = NO; - }; - name = Deployment; - }; - 2A3C3F2B0992245300E404E9 /* Default */ = { - isa = XCBuildConfiguration; - buildSettings = { - FRAMEWORK_SEARCH_PATHS = ( - "$(FRAMEWORK_SEARCH_PATHS)", - "$(SRCROOT)", - ); - GCC_ENABLE_OBJC_EXCEPTIONS = YES; - GCC_PRECOMPILE_PREFIX_HEADER = YES; - INFOPLIST_FILE = Info.plist; - INSTALL_PATH = "$(HOME)/Applications"; - LIBRARY_SEARCH_PATHS = ""; - OTHER_CFLAGS = ""; - OTHER_LDFLAGS = ( - "-L$(OCAMLLIBDIR)", - "-lunix", - "-lthreadsnat", - "-lstr", - "-lasmrun", - ); - PREBINDING = NO; - PRODUCT_NAME = Unison; - SECTORDER_FLAGS = ""; - WARNING_CFLAGS = ( - "-Wmost", - "-Wno-four-char-constants", - "-Wno-unknown-pragmas", - ); - WRAPPER_EXTENSION = app; - }; - name = Default; - }; - 2A3C3F2D0992245300E404E9 /* Development */ = { - isa = XCBuildConfiguration; - baseConfigurationReference = 2E282CCC0D9AE2E800439D01 /* ExternalSettings.xcconfig */; - buildSettings = { - LIBRARY_SEARCH_PATHS = ""; - SDKROOT = /Developer/SDKs/MacOSX10.4u.sdk; - USER_HEADER_SEARCH_PATHS = $OCAMLLIBDIR; - }; - name = Development; - }; - 2A3C3F2E0992245300E404E9 /* Deployment */ = { - isa = XCBuildConfiguration; - baseConfigurationReference = 2E282CCC0D9AE2E800439D01 /* ExternalSettings.xcconfig */; - buildSettings = { - LIBRARY_SEARCH_PATHS = ""; - SDKROOT = /Developer/SDKs/MacOSX10.4u.sdk; - USER_HEADER_SEARCH_PATHS = $OCAMLLIBDIR; - }; - name = Deployment; - }; - 2A3C3F2F0992245300E404E9 /* Default */ = { - isa = XCBuildConfiguration; - baseConfigurationReference = 2E282CCC0D9AE2E800439D01 /* ExternalSettings.xcconfig */; - buildSettings = { - LIBRARY_SEARCH_PATHS = ""; - SDKROOT = /Developer/SDKs/MacOSX10.4u.sdk; - USER_HEADER_SEARCH_PATHS = $OCAMLLIBDIR; - }; - name = Default; - }; -/* End XCBuildConfiguration section */ - -/* Begin XCConfigurationList section */ - 2A124E7C0DE1C4A200524237 /* Build configuration list for PBXAggregateTarget "Create ExternalSettings" */ = { - isa = XCConfigurationList; - buildConfigurations = ( - 2A124E790DE1C48400524237 /* Development */, - 2A124E7A0DE1C48400524237 /* Deployment */, - 2A124E7B0DE1C48400524237 /* Default */, - ); - defaultConfigurationIsVisible = 0; - defaultConfigurationName = Default; - }; - 2A3C3F280992245300E404E9 /* Build configuration list for PBXNativeTarget "uimac" */ = { - isa = XCConfigurationList; - buildConfigurations = ( - 2A3C3F290992245300E404E9 /* Development */, - 2A3C3F2A0992245300E404E9 /* Deployment */, - 2A3C3F2B0992245300E404E9 /* Default */, - ); - defaultConfigurationIsVisible = 0; - defaultConfigurationName = Default; - }; - 2A3C3F2C0992245300E404E9 /* Build configuration list for PBXProject "uimacnew" */ = { - isa = XCConfigurationList; - buildConfigurations = ( - 2A3C3F2D0992245300E404E9 /* Development */, - 2A3C3F2E0992245300E404E9 /* Deployment */, - 2A3C3F2F0992245300E404E9 /* Default */, - ); - defaultConfigurationIsVisible = 0; - defaultConfigurationName = Default; - }; -/* End XCConfigurationList section */ - }; - rootObject = 29B97313FDCFA39411CA2CEA /* Project object */; -} Copied: branches/2.32/src/uimacnew/uimacnew.xcodeproj/project.pbxproj (from rev 320, trunk/src/uimacnew/uimacnew.xcodeproj/project.pbxproj) =================================================================== --- branches/2.32/src/uimacnew/uimacnew.xcodeproj/project.pbxproj (rev 0) +++ branches/2.32/src/uimacnew/uimacnew.xcodeproj/project.pbxproj 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,733 @@ +// !$*UTF8*$! +{ + archiveVersion = 1; + classes = { + }; + objectVersion = 42; + objects = { + +/* Begin PBXAggregateTarget section */ + 2A124E780DE1C48400524237 /* Create ExternalSettings */ = { + isa = PBXAggregateTarget; + buildConfigurationList = 2A124E7C0DE1C4A200524237 /* Build configuration list for PBXAggregateTarget "Create ExternalSettings" */; + buildPhases = ( + 2A124E7E0DE1C4BE00524237 /* Run Script (version, ocaml lib dir) */, + ); + dependencies = ( + ); + name = "Create ExternalSettings"; + productName = "Create ExternalSettings"; + }; +/* End PBXAggregateTarget section */ + +/* Begin PBXBuildFile section */ + 2A3C3F3309922A8000E404E9 /* Growl.framework in CopyFiles */ = {isa = PBXBuildFile; fileRef = 2A3C3F3209922A8000E404E9 /* Growl.framework */; }; + 2A3C3F7D09922D4900E404E9 /* NotificationController.m in Sources */ = {isa = PBXBuildFile; fileRef = 2A3C3F7B09922D4900E404E9 /* NotificationController.m */; }; + 2A3C3FAE0992323F00E404E9 /* Growl.framework in Frameworks */ = {isa = PBXBuildFile; fileRef = 2A3C3F3209922A8000E404E9 /* Growl.framework */; }; + 2E282CC80D9AE2B000439D01 /* unison-blob.o in Frameworks */ = {isa = PBXBuildFile; fileRef = 2E282CC70D9AE2B000439D01 /* unison-blob.o */; }; + 44042CB60BE4FC9B00A6BBB2 /* ProgressCell.m in Sources */ = {isa = PBXBuildFile; fileRef = 44042CB40BE4FC9B00A6BBB2 /* ProgressCell.m */; }; + 44042D1B0BE52AED00A6BBB2 /* ProgressBarAdvanced.png in Resources */ = {isa = PBXBuildFile; fileRef = 44042D100BE52AED00A6BBB2 /* ProgressBarAdvanced.png */; }; + 44042D1C0BE52AEE00A6BBB2 /* ProgressBarBlue.png in Resources */ = {isa = PBXBuildFile; fileRef = 44042D110BE52AED00A6BBB2 /* ProgressBarBlue.png */; }; + 44042D1D0BE52AEE00A6BBB2 /* ProgressBarEndAdvanced.png in Resources */ = {isa = PBXBuildFile; fileRef = 44042D120BE52AED00A6BBB2 /* ProgressBarEndAdvanced.png */; }; + 44042D1E0BE52AEE00A6BBB2 /* ProgressBarEndBlue.png in Resources */ = {isa = PBXBuildFile; fileRef = 44042D130BE52AED00A6BBB2 /* ProgressBarEndBlue.png */; }; + 44042D1F0BE52AEE00A6BBB2 /* ProgressBarEndGray.png in Resources */ = {isa = PBXBuildFile; fileRef = 44042D140BE52AED00A6BBB2 /* ProgressBarEndGray.png */; }; + 44042D200BE52AEE00A6BBB2 /* ProgressBarEndGreen.png in Resources */ = {isa = PBXBuildFile; fileRef = 44042D150BE52AED00A6BBB2 /* ProgressBarEndGreen.png */; }; + 44042D210BE52AEE00A6BBB2 /* ProgressBarEndWhite.png in Resources */ = {isa = PBXBuildFile; fileRef = 44042D160BE52AED00A6BBB2 /* ProgressBarEndWhite.png */; }; + 44042D220BE52AEE00A6BBB2 /* ProgressBarGray.png in Resources */ = {isa = PBXBuildFile; fileRef = 44042D170BE52AED00A6BBB2 /* ProgressBarGray.png */; }; + 44042D230BE52AEE00A6BBB2 /* ProgressBarGreen.png in Resources */ = {isa = PBXBuildFile; fileRef = 44042D180BE52AED00A6BBB2 /* ProgressBarGreen.png */; }; + 44042D240BE52AEE00A6BBB2 /* ProgressBarLightGreen.png in Resources */ = {isa = PBXBuildFile; fileRef = 44042D190BE52AED00A6BBB2 /* ProgressBarLightGreen.png */; }; + 44042D250BE52AEE00A6BBB2 /* ProgressBarWhite.png in Resources */ = {isa = PBXBuildFile; fileRef = 44042D1A0BE52AED00A6BBB2 /* ProgressBarWhite.png */; }; + 440EEAF30C03EC3D00ACAAB0 /* Change_Created.png in Resources */ = {isa = PBXBuildFile; fileRef = 440EEAF20C03EC3D00ACAAB0 /* Change_Created.png */; }; + 440EEAF90C03F0B800ACAAB0 /* Change_Deleted.png in Resources */ = {isa = PBXBuildFile; fileRef = 440EEAF60C03F0B800ACAAB0 /* Change_Deleted.png */; }; + 440EEAFA0C03F0B800ACAAB0 /* Change_Modified.png in Resources */ = {isa = PBXBuildFile; fileRef = 440EEAF70C03F0B800ACAAB0 /* Change_Modified.png */; }; + 440EEAFB0C03F0B800ACAAB0 /* Change_PropsChanged.png in Resources */ = {isa = PBXBuildFile; fileRef = 440EEAF80C03F0B800ACAAB0 /* Change_PropsChanged.png */; }; + 445A291B0BFA5B3300E4E641 /* Outline-Deep.png in Resources */ = {isa = PBXBuildFile; fileRef = 445A291A0BFA5B3300E4E641 /* Outline-Deep.png */; }; + 445A29270BFA5C1200E4E641 /* Outline-Flat.png in Resources */ = {isa = PBXBuildFile; fileRef = 445A29260BFA5C1200E4E641 /* Outline-Flat.png */; }; + 445A29290BFA5C1B00E4E641 /* Outline-Flattened.png in Resources */ = {isa = PBXBuildFile; fileRef = 445A29280BFA5C1B00E4E641 /* Outline-Flattened.png */; }; + 445A2A5E0BFAB6C300E4E641 /* ImageAndTextCell.m in Sources */ = {isa = PBXBuildFile; fileRef = 445A2A5D0BFAB6C300E4E641 /* ImageAndTextCell.m */; }; + 449F03E10BE00DE9003F15C8 /* Bridge.m in Sources */ = {isa = PBXBuildFile; fileRef = 449F03DF0BE00DE9003F15C8 /* Bridge.m */; }; + 44A794A10BE16C380069680C /* ExceptionHandling.framework in Frameworks */ = {isa = PBXBuildFile; fileRef = 44A794A00BE16C380069680C /* ExceptionHandling.framework */; }; + 44A797F40BE3F9B70069680C /* table-mixed.tif in Resources */ = {isa = PBXBuildFile; fileRef = 44A797F10BE3F9B70069680C /* table-mixed.tif */; }; + 44F472B10C0DB735006428EF /* Change_Absent.png in Resources */ = {isa = PBXBuildFile; fileRef = 44F472AF0C0DB735006428EF /* Change_Absent.png */; }; + 44F472B20C0DB735006428EF /* Change_Unmodified.png in Resources */ = {isa = PBXBuildFile; fileRef = 44F472B00C0DB735006428EF /* Change_Unmodified.png */; }; + 69C625E60664EC3300B3C46A /* MainMenu.nib in Resources */ = {isa = PBXBuildFile; fileRef = 29B97318FDCFA39411CA2CEA /* MainMenu.nib */; }; + 69C625E70664EC3300B3C46A /* InfoPlist.strings in Resources */ = {isa = PBXBuildFile; fileRef = 089C165CFE840E0CC02AAC07 /* InfoPlist.strings */; }; + 69C625E80664EC3300B3C46A /* Unison.icns in Resources */ = {isa = PBXBuildFile; fileRef = 69C625CA0664E94E00B3C46A /* Unison.icns */; }; + 69C625EA0664EC3300B3C46A /* main.m in Sources */ = {isa = PBXBuildFile; fileRef = 29B97316FDCFA39411CA2CEA /* main.m */; settings = {ATTRIBUTES = (); }; }; + 69C625EB0664EC3300B3C46A /* MyController.m in Sources */ = {isa = PBXBuildFile; fileRef = 69660DC704F08CC100CF23A4 /* MyController.m */; }; + 69C625EC0664EC3300B3C46A /* ProfileController.m in Sources */ = {isa = PBXBuildFile; fileRef = 690F564504F11EC300CF23A4 /* ProfileController.m */; }; + 69C625ED0664EC3300B3C46A /* ReconItem.m in Sources */ = {isa = PBXBuildFile; fileRef = 69D3C6F904F1CC3700CF23A4 /* ReconItem.m */; }; + 69C625EE0664EC3300B3C46A /* ReconTableView.m in Sources */ = {isa = PBXBuildFile; fileRef = 69BA7DA904FD695200CF23A4 /* ReconTableView.m */; }; + 69C625EF0664EC3300B3C46A /* PreferencesController.m in Sources */ = {isa = PBXBuildFile; fileRef = 697985CE050CFA2D00CF23A4 /* PreferencesController.m */; }; + 69C625F00664EC3300B3C46A /* ProfileTableView.m in Sources */ = {isa = PBXBuildFile; fileRef = 691CE181051BB44A00CF23A4 /* ProfileTableView.m */; }; + 69C625F20664EC3300B3C46A /* Cocoa.framework in Frameworks */ = {isa = PBXBuildFile; fileRef = 1058C7A1FEA54F0111CA2CBB /* Cocoa.framework */; }; + 69E407BA07EB95AA00D37AA1 /* Security.framework in Frameworks */ = {isa = PBXBuildFile; fileRef = 69E407B907EB95AA00D37AA1 /* Security.framework */; }; + B518071C09D6652100B1B21F /* add.tif in Resources */ = {isa = PBXBuildFile; fileRef = B518071209D6652100B1B21F /* add.tif */; }; + B518071D09D6652100B1B21F /* diff.tif in Resources */ = {isa = PBXBuildFile; fileRef = B518071309D6652100B1B21F /* diff.tif */; }; + B518071E09D6652100B1B21F /* go.tif in Resources */ = {isa = PBXBuildFile; fileRef = B518071409D6652100B1B21F /* go.tif */; }; + B518071F09D6652100B1B21F /* left.tif in Resources */ = {isa = PBXBuildFile; fileRef = B518071509D6652100B1B21F /* left.tif */; }; + B518072009D6652100B1B21F /* merge.tif in Resources */ = {isa = PBXBuildFile; fileRef = B518071609D6652100B1B21F /* merge.tif */; }; + B518072109D6652100B1B21F /* quit.tif in Resources */ = {isa = PBXBuildFile; fileRef = B518071709D6652100B1B21F /* quit.tif */; }; + B518072209D6652100B1B21F /* restart.tif in Resources */ = {isa = PBXBuildFile; fileRef = B518071809D6652100B1B21F /* restart.tif */; }; + B518072309D6652100B1B21F /* right.tif in Resources */ = {isa = PBXBuildFile; fileRef = B518071909D6652100B1B21F /* right.tif */; }; + B518072409D6652100B1B21F /* save.tif in Resources */ = {isa = PBXBuildFile; fileRef = B518071A09D6652100B1B21F /* save.tif */; }; + B518072509D6652100B1B21F /* skip.tif in Resources */ = {isa = PBXBuildFile; fileRef = B518071B09D6652100B1B21F /* skip.tif */; }; + B554004109C4E5AA0089E1C3 /* UnisonToolbar.m in Sources */ = {isa = PBXBuildFile; fileRef = B554004009C4E5AA0089E1C3 /* UnisonToolbar.m */; }; + B5B44C1909DF61A4000DC7AF /* table-conflict.tif in Resources */ = {isa = PBXBuildFile; fileRef = B5B44C1109DF61A4000DC7AF /* table-conflict.tif */; }; + B5B44C1A09DF61A4000DC7AF /* table-error.tif in Resources */ = {isa = PBXBuildFile; fileRef = B5B44C1209DF61A4000DC7AF /* table-error.tif */; }; + B5B44C1B09DF61A4000DC7AF /* table-left-blue.tif in Resources */ = {isa = PBXBuildFile; fileRef = B5B44C1309DF61A4000DC7AF /* table-left-blue.tif */; }; + B5B44C1C09DF61A4000DC7AF /* table-left-green.tif in Resources */ = {isa = PBXBuildFile; fileRef = B5B44C1409DF61A4000DC7AF /* table-left-green.tif */; }; + B5B44C1D09DF61A4000DC7AF /* table-merge.tif in Resources */ = {isa = PBXBuildFile; fileRef = B5B44C1509DF61A4000DC7AF /* table-merge.tif */; }; + B5B44C1E09DF61A4000DC7AF /* table-right-blue.tif in Resources */ = {isa = PBXBuildFile; fileRef = B5B44C1609DF61A4000DC7AF /* table-right-blue.tif */; }; + B5B44C1F09DF61A4000DC7AF /* table-right-green.tif in Resources */ = {isa = PBXBuildFile; fileRef = B5B44C1709DF61A4000DC7AF /* table-right-green.tif */; }; + B5B44C2009DF61A4000DC7AF /* table-skip.tif in Resources */ = {isa = PBXBuildFile; fileRef = B5B44C1809DF61A4000DC7AF /* table-skip.tif */; }; + B5E03B3909E38B9E0058C7B9 /* rescan.tif in Resources */ = {isa = PBXBuildFile; fileRef = B5E03B3809E38B9E0058C7B9 /* rescan.tif */; }; +/* End PBXBuildFile section */ + +/* Begin PBXContainerItemProxy section */ + 2A124E7F0DE1C4E400524237 /* PBXContainerItemProxy */ = { + isa = PBXContainerItemProxy; + containerPortal = 29B97313FDCFA39411CA2CEA /* Project object */; + proxyType = 1; + remoteGlobalIDString = 2A124E780DE1C48400524237; + remoteInfo = "Create ExternalSettings"; + }; +/* End PBXContainerItemProxy section */ + +/* Begin PBXCopyFilesBuildPhase section */ + 2A3C3F3709922AA600E404E9 /* CopyFiles */ = { + isa = PBXCopyFilesBuildPhase; + buildActionMask = 2147483647; + dstPath = ""; + dstSubfolderSpec = 10; + files = ( + 2A3C3F3309922A8000E404E9 /* Growl.framework in CopyFiles */, + ); + runOnlyForDeploymentPostprocessing = 0; + }; +/* End PBXCopyFilesBuildPhase section */ + +/* Begin PBXFileReference section */ + 089C165DFE840E0CC02AAC07 /* English */ = {isa = PBXFileReference; fileEncoding = 10; lastKnownFileType = text.plist.strings; name = English; path = English.lproj/InfoPlist.strings; sourceTree = ""; }; + 1058C7A1FEA54F0111CA2CBB /* Cocoa.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; name = Cocoa.framework; path = /System/Library/Frameworks/Cocoa.framework; sourceTree = ""; }; + 29B97316FDCFA39411CA2CEA /* main.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = main.m; sourceTree = ""; }; + 29B97319FDCFA39411CA2CEA /* English */ = {isa = PBXFileReference; lastKnownFileType = wrapper.nib; name = English; path = English.lproj/MainMenu.nib; sourceTree = ""; }; + 2A3C3F3209922A8000E404E9 /* Growl.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; path = Growl.framework; sourceTree = ""; }; + 2A3C3F7A09922D4900E404E9 /* NotificationController.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = NotificationController.h; sourceTree = ""; }; + 2A3C3F7B09922D4900E404E9 /* NotificationController.m */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.objc; path = NotificationController.m; sourceTree = ""; }; + 2E282CC70D9AE2B000439D01 /* unison-blob.o */ = {isa = PBXFileReference; lastKnownFileType = "compiled.mach-o.objfile"; name = "unison-blob.o"; path = "../unison-blob.o"; sourceTree = SOURCE_ROOT; }; + 2E282CCC0D9AE2E800439D01 /* ExternalSettings.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = ExternalSettings.xcconfig; sourceTree = ""; }; + 44042CB30BE4FC9B00A6BBB2 /* ProgressCell.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = ProgressCell.h; sourceTree = ""; }; + 44042CB40BE4FC9B00A6BBB2 /* ProgressCell.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = ProgressCell.m; sourceTree = ""; }; + 44042D100BE52AED00A6BBB2 /* ProgressBarAdvanced.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarAdvanced.png; path = progressicons/ProgressBarAdvanced.png; sourceTree = ""; }; + 44042D110BE52AED00A6BBB2 /* ProgressBarBlue.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarBlue.png; path = progressicons/ProgressBarBlue.png; sourceTree = ""; }; + 44042D120BE52AED00A6BBB2 /* ProgressBarEndAdvanced.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarEndAdvanced.png; path = progressicons/ProgressBarEndAdvanced.png; sourceTree = ""; }; + 44042D130BE52AED00A6BBB2 /* ProgressBarEndBlue.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarEndBlue.png; path = progressicons/ProgressBarEndBlue.png; sourceTree = ""; }; + 44042D140BE52AED00A6BBB2 /* ProgressBarEndGray.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarEndGray.png; path = progressicons/ProgressBarEndGray.png; sourceTree = ""; }; + 44042D150BE52AED00A6BBB2 /* ProgressBarEndGreen.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarEndGreen.png; path = progressicons/ProgressBarEndGreen.png; sourceTree = ""; }; + 44042D160BE52AED00A6BBB2 /* ProgressBarEndWhite.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarEndWhite.png; path = progressicons/ProgressBarEndWhite.png; sourceTree = ""; }; + 44042D170BE52AED00A6BBB2 /* ProgressBarGray.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarGray.png; path = progressicons/ProgressBarGray.png; sourceTree = ""; }; + 44042D180BE52AED00A6BBB2 /* ProgressBarGreen.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarGreen.png; path = progressicons/ProgressBarGreen.png; sourceTree = ""; }; + 44042D190BE52AED00A6BBB2 /* ProgressBarLightGreen.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarLightGreen.png; path = progressicons/ProgressBarLightGreen.png; sourceTree = ""; }; + 44042D1A0BE52AED00A6BBB2 /* ProgressBarWhite.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarWhite.png; path = progressicons/ProgressBarWhite.png; sourceTree = ""; }; + 440EEAF20C03EC3D00ACAAB0 /* Change_Created.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = Change_Created.png; sourceTree = ""; }; + 440EEAF60C03F0B800ACAAB0 /* Change_Deleted.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = Change_Deleted.png; sourceTree = ""; }; + 440EEAF70C03F0B800ACAAB0 /* Change_Modified.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = Change_Modified.png; sourceTree = ""; }; + 440EEAF80C03F0B800ACAAB0 /* Change_PropsChanged.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = Change_PropsChanged.png; sourceTree = ""; }; + 445A291A0BFA5B3300E4E641 /* Outline-Deep.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = "Outline-Deep.png"; sourceTree = ""; }; + 445A29260BFA5C1200E4E641 /* Outline-Flat.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = "Outline-Flat.png"; sourceTree = ""; }; + 445A29280BFA5C1B00E4E641 /* Outline-Flattened.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = "Outline-Flattened.png"; sourceTree = ""; }; + 445A2A5B0BFAB6A100E4E641 /* ImageAndTextCell.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = ImageAndTextCell.h; sourceTree = ""; }; + 445A2A5D0BFAB6C300E4E641 /* ImageAndTextCell.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = ImageAndTextCell.m; sourceTree = ""; }; + 449F03DE0BE00DE9003F15C8 /* Bridge.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = Bridge.h; sourceTree = ""; }; + 449F03DF0BE00DE9003F15C8 /* Bridge.m */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.objc; path = Bridge.m; sourceTree = ""; }; + 44A794A00BE16C380069680C /* ExceptionHandling.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; name = ExceptionHandling.framework; path = /System/Library/Frameworks/ExceptionHandling.framework; sourceTree = ""; }; + 44A797F10BE3F9B70069680C /* table-mixed.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-mixed.tif"; sourceTree = ""; }; + 44F472AF0C0DB735006428EF /* Change_Absent.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = Change_Absent.png; sourceTree = ""; }; + 44F472B00C0DB735006428EF /* Change_Unmodified.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = Change_Unmodified.png; sourceTree = ""; }; + 690F564404F11EC300CF23A4 /* ProfileController.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = ProfileController.h; sourceTree = ""; }; + 690F564504F11EC300CF23A4 /* ProfileController.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = ProfileController.m; sourceTree = ""; }; + 691CE180051BB44A00CF23A4 /* ProfileTableView.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = ProfileTableView.h; sourceTree = ""; }; + 691CE181051BB44A00CF23A4 /* ProfileTableView.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = ProfileTableView.m; sourceTree = ""; }; + 69660DC604F08CC100CF23A4 /* MyController.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = MyController.h; sourceTree = ""; }; + 69660DC704F08CC100CF23A4 /* MyController.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = MyController.m; sourceTree = ""; }; + 697985CD050CFA2D00CF23A4 /* PreferencesController.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = PreferencesController.h; sourceTree = ""; }; + 697985CE050CFA2D00CF23A4 /* PreferencesController.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = PreferencesController.m; sourceTree = ""; }; + 69BA7DA804FD695200CF23A4 /* ReconTableView.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = ReconTableView.h; sourceTree = ""; }; + 69BA7DA904FD695200CF23A4 /* ReconTableView.m */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.objc; path = ReconTableView.m; sourceTree = ""; }; + 69C625CA0664E94E00B3C46A /* Unison.icns */ = {isa = PBXFileReference; lastKnownFileType = image.icns; path = Unison.icns; sourceTree = ""; }; + 69C625F40664EC3300B3C46A /* Info.plist */ = {isa = PBXFileReference; lastKnownFileType = text.plist.xml; path = Info.plist; sourceTree = ""; }; + 69C625F50664EC3300B3C46A /* Unison.app */ = {isa = PBXFileReference; explicitFileType = wrapper.application; includeInIndex = 0; path = Unison.app; sourceTree = BUILT_PRODUCTS_DIR; }; + 69D3C6F904F1CC3700CF23A4 /* ReconItem.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = ReconItem.m; sourceTree = ""; }; + 69D3C6FA04F1CC3700CF23A4 /* ReconItem.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = ReconItem.h; sourceTree = ""; }; + 69E407B907EB95AA00D37AA1 /* Security.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; name = Security.framework; path = /System/Library/Frameworks/Security.framework; sourceTree = ""; }; + B518071209D6652100B1B21F /* add.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = add.tif; sourceTree = ""; }; + B518071309D6652100B1B21F /* diff.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = diff.tif; sourceTree = ""; }; + B518071409D6652100B1B21F /* go.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = go.tif; sourceTree = ""; }; + B518071509D6652100B1B21F /* left.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = left.tif; sourceTree = ""; }; + B518071609D6652100B1B21F /* merge.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = merge.tif; sourceTree = ""; }; + B518071709D6652100B1B21F /* quit.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = quit.tif; sourceTree = ""; }; + B518071809D6652100B1B21F /* restart.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = restart.tif; sourceTree = ""; }; + B518071909D6652100B1B21F /* right.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = right.tif; sourceTree = ""; }; + B518071A09D6652100B1B21F /* save.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = save.tif; sourceTree = ""; }; + B518071B09D6652100B1B21F /* skip.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = skip.tif; sourceTree = ""; }; + B554003E09C4E5A00089E1C3 /* UnisonToolbar.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = UnisonToolbar.h; sourceTree = ""; }; + B554004009C4E5AA0089E1C3 /* UnisonToolbar.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = UnisonToolbar.m; sourceTree = ""; }; + B5B44C1109DF61A4000DC7AF /* table-conflict.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-conflict.tif"; sourceTree = ""; }; + B5B44C1209DF61A4000DC7AF /* table-error.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-error.tif"; sourceTree = ""; }; + B5B44C1309DF61A4000DC7AF /* table-left-blue.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-left-blue.tif"; sourceTree = ""; }; + B5B44C1409DF61A4000DC7AF /* table-left-green.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-left-green.tif"; sourceTree = ""; }; + B5B44C1509DF61A4000DC7AF /* table-merge.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-merge.tif"; sourceTree = ""; }; + B5B44C1609DF61A4000DC7AF /* table-right-blue.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-right-blue.tif"; sourceTree = ""; }; + B5B44C1709DF61A4000DC7AF /* table-right-green.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-right-green.tif"; sourceTree = ""; }; + B5B44C1809DF61A4000DC7AF /* table-skip.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-skip.tif"; sourceTree = ""; }; + B5E03B3809E38B9E0058C7B9 /* rescan.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; name = rescan.tif; path = toolbar/rescan.tif; sourceTree = ""; }; +/* End PBXFileReference section */ + +/* Begin PBXFrameworksBuildPhase section */ + 69C625F10664EC3300B3C46A /* Frameworks */ = { + isa = PBXFrameworksBuildPhase; + buildActionMask = 2147483647; + files = ( + 69C625F20664EC3300B3C46A /* Cocoa.framework in Frameworks */, + 69E407BA07EB95AA00D37AA1 /* Security.framework in Frameworks */, + 2A3C3FAE0992323F00E404E9 /* Growl.framework in Frameworks */, + 44A794A10BE16C380069680C /* ExceptionHandling.framework in Frameworks */, + 2E282CC80D9AE2B000439D01 /* unison-blob.o in Frameworks */, + ); + runOnlyForDeploymentPostprocessing = 0; + }; +/* End PBXFrameworksBuildPhase section */ + +/* Begin PBXGroup section */ + 19C28FACFE9D520D11CA2CBB /* Products */ = { + isa = PBXGroup; + children = ( + 69C625F50664EC3300B3C46A /* Unison.app */, + ); + name = Products; + sourceTree = ""; + }; + 29B97314FDCFA39411CA2CEA /* uimac */ = { + isa = PBXGroup; + children = ( + B5E03B3809E38B9E0058C7B9 /* rescan.tif */, + 44042D0F0BE52AD700A6BBB2 /* progressicons */, + B5B44C1009DF61A4000DC7AF /* tableicons */, + B518071109D6652000B1B21F /* toolbar */, + 44A795C90BE2B91B0069680C /* Classes */, + 29B97315FDCFA39411CA2CEA /* Other Sources */, + 29B97317FDCFA39411CA2CEA /* Resources */, + 29B97323FDCFA39411CA2CEA /* Frameworks */, + 19C28FACFE9D520D11CA2CBB /* Products */, + 69C625F40664EC3300B3C46A /* Info.plist */, + 2E282CCC0D9AE2E800439D01 /* ExternalSettings.xcconfig */, + 2E282CB80D9AE16300439D01 /* External objects */, + ); + name = uimac; + sourceTree = ""; + }; + 29B97315FDCFA39411CA2CEA /* Other Sources */ = { + isa = PBXGroup; + children = ( + 29B97316FDCFA39411CA2CEA /* main.m */, + ); + name = "Other Sources"; + sourceTree = ""; + }; + 29B97317FDCFA39411CA2CEA /* Resources */ = { + isa = PBXGroup; + children = ( + 29B97318FDCFA39411CA2CEA /* MainMenu.nib */, + 089C165CFE840E0CC02AAC07 /* InfoPlist.strings */, + 69C625CA0664E94E00B3C46A /* Unison.icns */, + ); + name = Resources; + sourceTree = ""; + }; + 29B97323FDCFA39411CA2CEA /* Frameworks */ = { + isa = PBXGroup; + children = ( + 1058C7A1FEA54F0111CA2CBB /* Cocoa.framework */, + 44A794A00BE16C380069680C /* ExceptionHandling.framework */, + 2A3C3F3209922A8000E404E9 /* Growl.framework */, + 69E407B907EB95AA00D37AA1 /* Security.framework */, + ); + name = Frameworks; + sourceTree = ""; + }; + 2E282CB80D9AE16300439D01 /* External objects */ = { + isa = PBXGroup; + children = ( + 2E282CC70D9AE2B000439D01 /* unison-blob.o */, + ); + name = "External objects"; + sourceTree = ""; + }; + 44042D0F0BE52AD700A6BBB2 /* progressicons */ = { + isa = PBXGroup; + children = ( + 44042D100BE52AED00A6BBB2 /* ProgressBarAdvanced.png */, + 44042D110BE52AED00A6BBB2 /* ProgressBarBlue.png */, + 44042D120BE52AED00A6BBB2 /* ProgressBarEndAdvanced.png */, + 44042D130BE52AED00A6BBB2 /* ProgressBarEndBlue.png */, + 44042D140BE52AED00A6BBB2 /* ProgressBarEndGray.png */, + 44042D150BE52AED00A6BBB2 /* ProgressBarEndGreen.png */, + 44042D160BE52AED00A6BBB2 /* ProgressBarEndWhite.png */, + 44042D170BE52AED00A6BBB2 /* ProgressBarGray.png */, + 44042D180BE52AED00A6BBB2 /* ProgressBarGreen.png */, + 44042D190BE52AED00A6BBB2 /* ProgressBarLightGreen.png */, + 44042D1A0BE52AED00A6BBB2 /* ProgressBarWhite.png */, + ); + name = progressicons; + sourceTree = ""; + }; + 44A795C90BE2B91B0069680C /* Classes */ = { + isa = PBXGroup; + children = ( + 69660DC604F08CC100CF23A4 /* MyController.h */, + 69660DC704F08CC100CF23A4 /* MyController.m */, + 2A3C3F7A09922D4900E404E9 /* NotificationController.h */, + 2A3C3F7B09922D4900E404E9 /* NotificationController.m */, + 69BA7DA804FD695200CF23A4 /* ReconTableView.h */, + 69BA7DA904FD695200CF23A4 /* ReconTableView.m */, + 69D3C6FA04F1CC3700CF23A4 /* ReconItem.h */, + 69D3C6F904F1CC3700CF23A4 /* ReconItem.m */, + 445A2A5B0BFAB6A100E4E641 /* ImageAndTextCell.h */, + 445A2A5D0BFAB6C300E4E641 /* ImageAndTextCell.m */, + 44042CB30BE4FC9B00A6BBB2 /* ProgressCell.h */, + 44042CB40BE4FC9B00A6BBB2 /* ProgressCell.m */, + 690F564404F11EC300CF23A4 /* ProfileController.h */, + 690F564504F11EC300CF23A4 /* ProfileController.m */, + 697985CD050CFA2D00CF23A4 /* PreferencesController.h */, + 697985CE050CFA2D00CF23A4 /* PreferencesController.m */, + 691CE180051BB44A00CF23A4 /* ProfileTableView.h */, + 691CE181051BB44A00CF23A4 /* ProfileTableView.m */, + B554003E09C4E5A00089E1C3 /* UnisonToolbar.h */, + B554004009C4E5AA0089E1C3 /* UnisonToolbar.m */, + 449F03DE0BE00DE9003F15C8 /* Bridge.h */, + 449F03DF0BE00DE9003F15C8 /* Bridge.m */, + ); + name = Classes; + sourceTree = ""; + }; + B518071109D6652000B1B21F /* toolbar */ = { + isa = PBXGroup; + children = ( + B518071209D6652100B1B21F /* add.tif */, + B518071309D6652100B1B21F /* diff.tif */, + B518071409D6652100B1B21F /* go.tif */, + B518071509D6652100B1B21F /* left.tif */, + B518071609D6652100B1B21F /* merge.tif */, + B518071709D6652100B1B21F /* quit.tif */, + B518071809D6652100B1B21F /* restart.tif */, + B518071909D6652100B1B21F /* right.tif */, + B518071A09D6652100B1B21F /* save.tif */, + B518071B09D6652100B1B21F /* skip.tif */, + ); + path = toolbar; + sourceTree = ""; + }; + B5B44C1009DF61A4000DC7AF /* tableicons */ = { + isa = PBXGroup; + children = ( + 44F472AF0C0DB735006428EF /* Change_Absent.png */, + 44F472B00C0DB735006428EF /* Change_Unmodified.png */, + 440EEAF60C03F0B800ACAAB0 /* Change_Deleted.png */, + 440EEAF70C03F0B800ACAAB0 /* Change_Modified.png */, + 440EEAF80C03F0B800ACAAB0 /* Change_PropsChanged.png */, + 440EEAF20C03EC3D00ACAAB0 /* Change_Created.png */, + 44A797F10BE3F9B70069680C /* table-mixed.tif */, + B5B44C1109DF61A4000DC7AF /* table-conflict.tif */, + B5B44C1209DF61A4000DC7AF /* table-error.tif */, + B5B44C1309DF61A4000DC7AF /* table-left-blue.tif */, + B5B44C1409DF61A4000DC7AF /* table-left-green.tif */, + B5B44C1509DF61A4000DC7AF /* table-merge.tif */, + B5B44C1609DF61A4000DC7AF /* table-right-blue.tif */, + B5B44C1709DF61A4000DC7AF /* table-right-green.tif */, + B5B44C1809DF61A4000DC7AF /* table-skip.tif */, + 445A291A0BFA5B3300E4E641 /* Outline-Deep.png */, + 445A29260BFA5C1200E4E641 /* Outline-Flat.png */, + 445A29280BFA5C1B00E4E641 /* Outline-Flattened.png */, + ); + path = tableicons; + sourceTree = ""; + }; +/* End PBXGroup section */ + +/* Begin PBXNativeTarget section */ + 69C625DD0664EC3300B3C46A /* uimac */ = { + isa = PBXNativeTarget; + buildConfigurationList = 2A3C3F280992245300E404E9 /* Build configuration list for PBXNativeTarget "uimac" */; + buildPhases = ( + 2E282CBA0D9AE17300439D01 /* Run Script (make unison-blob.o) */, + 69C625E50664EC3300B3C46A /* Resources */, + 69C625E90664EC3300B3C46A /* Sources */, + 69C625F10664EC3300B3C46A /* Frameworks */, + 2A3C3F3709922AA600E404E9 /* CopyFiles */, + ); + buildRules = ( + ); + dependencies = ( + 2A124E800DE1C4E400524237 /* PBXTargetDependency */, + ); + name = uimac; + productInstallPath = "$(HOME)/Applications"; + productName = uimac; + productReference = 69C625F50664EC3300B3C46A /* Unison.app */; + productType = "com.apple.product-type.application"; + }; +/* End PBXNativeTarget section */ + +/* Begin PBXProject section */ + 29B97313FDCFA39411CA2CEA /* Project object */ = { + isa = PBXProject; + buildConfigurationList = 2A3C3F2C0992245300E404E9 /* Build configuration list for PBXProject "uimacnew" */; + compatibilityVersion = "Xcode 2.4"; + hasScannedForEncodings = 1; + mainGroup = 29B97314FDCFA39411CA2CEA /* uimac */; + projectDirPath = ""; + projectRoot = ""; + targets = ( + 69C625DD0664EC3300B3C46A /* uimac */, + 2A124E780DE1C48400524237 /* Create ExternalSettings */, + ); + }; +/* End PBXProject section */ + +/* Begin PBXResourcesBuildPhase section */ + 69C625E50664EC3300B3C46A /* Resources */ = { + isa = PBXResourcesBuildPhase; + buildActionMask = 2147483647; + files = ( + 69C625E60664EC3300B3C46A /* MainMenu.nib in Resources */, + 69C625E70664EC3300B3C46A /* InfoPlist.strings in Resources */, + 69C625E80664EC3300B3C46A /* Unison.icns in Resources */, + B518071C09D6652100B1B21F /* add.tif in Resources */, + B518071D09D6652100B1B21F /* diff.tif in Resources */, + B518071E09D6652100B1B21F /* go.tif in Resources */, + B518071F09D6652100B1B21F /* left.tif in Resources */, + B518072009D6652100B1B21F /* merge.tif in Resources */, + B518072109D6652100B1B21F /* quit.tif in Resources */, + B518072209D6652100B1B21F /* restart.tif in Resources */, + B518072309D6652100B1B21F /* right.tif in Resources */, + B518072409D6652100B1B21F /* save.tif in Resources */, + B518072509D6652100B1B21F /* skip.tif in Resources */, + B5B44C1909DF61A4000DC7AF /* table-conflict.tif in Resources */, + B5B44C1A09DF61A4000DC7AF /* table-error.tif in Resources */, + B5B44C1B09DF61A4000DC7AF /* table-left-blue.tif in Resources */, + B5B44C1C09DF61A4000DC7AF /* table-left-green.tif in Resources */, + B5B44C1D09DF61A4000DC7AF /* table-merge.tif in Resources */, + B5B44C1E09DF61A4000DC7AF /* table-right-blue.tif in Resources */, + B5B44C1F09DF61A4000DC7AF /* table-right-green.tif in Resources */, + B5B44C2009DF61A4000DC7AF /* table-skip.tif in Resources */, + B5E03B3909E38B9E0058C7B9 /* rescan.tif in Resources */, + 44A797F40BE3F9B70069680C /* table-mixed.tif in Resources */, + 44042D1B0BE52AED00A6BBB2 /* ProgressBarAdvanced.png in Resources */, + 44042D1C0BE52AEE00A6BBB2 /* ProgressBarBlue.png in Resources */, + 44042D1D0BE52AEE00A6BBB2 /* ProgressBarEndAdvanced.png in Resources */, + 44042D1E0BE52AEE00A6BBB2 /* ProgressBarEndBlue.png in Resources */, + 44042D1F0BE52AEE00A6BBB2 /* ProgressBarEndGray.png in Resources */, + 44042D200BE52AEE00A6BBB2 /* ProgressBarEndGreen.png in Resources */, + 44042D210BE52AEE00A6BBB2 /* ProgressBarEndWhite.png in Resources */, + 44042D220BE52AEE00A6BBB2 /* ProgressBarGray.png in Resources */, + 44042D230BE52AEE00A6BBB2 /* ProgressBarGreen.png in Resources */, + 44042D240BE52AEE00A6BBB2 /* ProgressBarLightGreen.png in Resources */, + 44042D250BE52AEE00A6BBB2 /* ProgressBarWhite.png in Resources */, + 445A291B0BFA5B3300E4E641 /* Outline-Deep.png in Resources */, + 445A29270BFA5C1200E4E641 /* Outline-Flat.png in Resources */, + 445A29290BFA5C1B00E4E641 /* Outline-Flattened.png in Resources */, + 440EEAF30C03EC3D00ACAAB0 /* Change_Created.png in Resources */, + 440EEAF90C03F0B800ACAAB0 /* Change_Deleted.png in Resources */, + 440EEAFA0C03F0B800ACAAB0 /* Change_Modified.png in Resources */, + 440EEAFB0C03F0B800ACAAB0 /* Change_PropsChanged.png in Resources */, + 44F472B10C0DB735006428EF /* Change_Absent.png in Resources */, + 44F472B20C0DB735006428EF /* Change_Unmodified.png in Resources */, + ); + runOnlyForDeploymentPostprocessing = 0; + }; +/* End PBXResourcesBuildPhase section */ + +/* Begin PBXShellScriptBuildPhase section */ + 2A124E7E0DE1C4BE00524237 /* Run Script (version, ocaml lib dir) */ = { + isa = PBXShellScriptBuildPhase; + buildActionMask = 2147483647; + files = ( + ); + inputPaths = ( + ); + name = "Run Script (version, ocaml lib dir)"; + outputPaths = ( + ); + runOnlyForDeploymentPostprocessing = 0; + shellPath = /bin/sh; + shellScript = "if [ -x /usr/libexec/path_helper ]; then\n eval `/usr/libexec/path_helper -s`\nfi\nif [ ! -x ${PROJECT_DIR}/../Makefile.ProjectInfo ]; then\n if [ ! -x ${PROJECT_DIR}/../mkProjectInfo ]; then\n cd ${PROJECT_DIR}/..; ocamlc -o mkProjectInfo mkProjectInfo.ml\n fi\n cd ${PROJECT_DIR}/..; ./mkProjectInfo > Makefile.ProjectInfo\nfi\nOCAMLLIBDIR=`ocamlc -v | tail -n -1 | sed -e 's/.* //g' | sed -e 's/\\\\\\/\\\\//g' | tr -d '\\r'`\nsource ${PROJECT_DIR}/../Makefile.ProjectInfo\necho MARKETING_VERSION = $VERSION > ${PROJECT_DIR}/ExternalSettings.xcconfig\necho OCAMLLIBDIR = $OCAMLLIBDIR >> ${PROJECT_DIR}/ExternalSettings.xcconfig"; + }; + 2E282CBA0D9AE17300439D01 /* Run Script (make unison-blob.o) */ = { + isa = PBXShellScriptBuildPhase; + buildActionMask = 2147483647; + files = ( + ); + inputPaths = ( + ); + name = "Run Script (make unison-blob.o)"; + outputPaths = ( + ); + runOnlyForDeploymentPostprocessing = 0; + shellPath = /bin/sh; + shellScript = "echo \"Building unison-blob.o...\"\nif [ -x /usr/libexec/path_helper ]; then\n eval `/usr/libexec/path_helper -s`\nfi\ncd ${PROJECT_DIR}/..\nmake unison-blob.o\necho \"done\""; + }; +/* End PBXShellScriptBuildPhase section */ + +/* Begin PBXSourcesBuildPhase section */ + 69C625E90664EC3300B3C46A /* Sources */ = { + isa = PBXSourcesBuildPhase; + buildActionMask = 2147483647; + files = ( + 69C625EA0664EC3300B3C46A /* main.m in Sources */, + 69C625EB0664EC3300B3C46A /* MyController.m in Sources */, + 69C625EC0664EC3300B3C46A /* ProfileController.m in Sources */, + 69C625ED0664EC3300B3C46A /* ReconItem.m in Sources */, + 69C625EE0664EC3300B3C46A /* ReconTableView.m in Sources */, + 69C625EF0664EC3300B3C46A /* PreferencesController.m in Sources */, + 69C625F00664EC3300B3C46A /* ProfileTableView.m in Sources */, + 2A3C3F7D09922D4900E404E9 /* NotificationController.m in Sources */, + B554004109C4E5AA0089E1C3 /* UnisonToolbar.m in Sources */, + 449F03E10BE00DE9003F15C8 /* Bridge.m in Sources */, + 44042CB60BE4FC9B00A6BBB2 /* ProgressCell.m in Sources */, + 445A2A5E0BFAB6C300E4E641 /* ImageAndTextCell.m in Sources */, + ); + runOnlyForDeploymentPostprocessing = 0; + }; +/* End PBXSourcesBuildPhase section */ + +/* Begin PBXTargetDependency section */ + 2A124E800DE1C4E400524237 /* PBXTargetDependency */ = { + isa = PBXTargetDependency; + target = 2A124E780DE1C48400524237 /* Create ExternalSettings */; + targetProxy = 2A124E7F0DE1C4E400524237 /* PBXContainerItemProxy */; + }; +/* End PBXTargetDependency section */ + +/* Begin PBXVariantGroup section */ + 089C165CFE840E0CC02AAC07 /* InfoPlist.strings */ = { + isa = PBXVariantGroup; + children = ( + 089C165DFE840E0CC02AAC07 /* English */, + ); + name = InfoPlist.strings; + sourceTree = ""; + }; + 29B97318FDCFA39411CA2CEA /* MainMenu.nib */ = { + isa = PBXVariantGroup; + children = ( + 29B97319FDCFA39411CA2CEA /* English */, + ); + name = MainMenu.nib; + sourceTree = ""; + }; +/* End PBXVariantGroup section */ + +/* Begin XCBuildConfiguration section */ + 2A124E790DE1C48400524237 /* Development */ = { + isa = XCBuildConfiguration; + buildSettings = { + COPY_PHASE_STRIP = NO; + GCC_DYNAMIC_NO_PIC = NO; + GCC_OPTIMIZATION_LEVEL = 0; + PRODUCT_NAME = "Create ExternalSettings"; + }; + name = Development; + }; + 2A124E7A0DE1C48400524237 /* Deployment */ = { + isa = XCBuildConfiguration; + buildSettings = { + COPY_PHASE_STRIP = YES; + DEBUG_INFORMATION_FORMAT = "dwarf-with-dsym"; + GCC_ENABLE_FIX_AND_CONTINUE = NO; + PRODUCT_NAME = "Create ExternalSettings"; + ZERO_LINK = NO; + }; + name = Deployment; + }; + 2A124E7B0DE1C48400524237 /* Default */ = { + isa = XCBuildConfiguration; + buildSettings = { + PRODUCT_NAME = "Create ExternalSettings"; + }; + name = Default; + }; + 2A3C3F290992245300E404E9 /* Development */ = { + isa = XCBuildConfiguration; + buildSettings = { + COPY_PHASE_STRIP = NO; + FRAMEWORK_SEARCH_PATHS = ( + "$(FRAMEWORK_SEARCH_PATHS)", + "$(SRCROOT)", + ); + GCC_DYNAMIC_NO_PIC = NO; + GCC_ENABLE_FIX_AND_CONTINUE = YES; + GCC_ENABLE_OBJC_EXCEPTIONS = YES; + GCC_GENERATE_DEBUGGING_SYMBOLS = YES; + GCC_OPTIMIZATION_LEVEL = 0; + GCC_PRECOMPILE_PREFIX_HEADER = YES; + INFOPLIST_FILE = Info.plist; + INSTALL_PATH = "$(HOME)/Applications"; + LIBRARY_SEARCH_PATHS = ""; + NSZombieEnabled = YES; + OTHER_CFLAGS = ""; + OTHER_LDFLAGS = ( + "-L$(OCAMLLIBDIR)", + "-lunix", + "-lthreadsnat", + "-lstr", + "-lasmrun", + ); + PREBINDING = NO; + PRODUCT_NAME = Unison; + SECTORDER_FLAGS = ""; + WARNING_CFLAGS = ( + "-Wmost", + "-Wno-four-char-constants", + "-Wno-unknown-pragmas", + ); + WRAPPER_EXTENSION = app; + ZERO_LINK = YES; + }; + name = Development; + }; + 2A3C3F2A0992245300E404E9 /* Deployment */ = { + isa = XCBuildConfiguration; + buildSettings = { + COPY_PHASE_STRIP = YES; + FRAMEWORK_SEARCH_PATHS = ( + "$(FRAMEWORK_SEARCH_PATHS)", + "$(SRCROOT)", + ); + GCC_ENABLE_FIX_AND_CONTINUE = NO; + GCC_ENABLE_OBJC_EXCEPTIONS = YES; + GCC_PRECOMPILE_PREFIX_HEADER = YES; + GCC_WARN_FOUR_CHARACTER_CONSTANTS = YES; + INFOPLIST_FILE = Info.plist; + INSTALL_PATH = "$(HOME)/Applications"; + LIBRARY_SEARCH_PATHS = ""; + OTHER_CFLAGS = ""; + OTHER_LDFLAGS = ( + "-L$(OCAMLLIBDIR)", + "-lunix", + "-lthreadsnat", + "-lstr", + "-lasmrun", + ); + PREBINDING = NO; + PRODUCT_NAME = Unison; + SECTORDER_FLAGS = ""; + WARNING_CFLAGS = ( + "-Wmost", + "-Wno-four-char-constants", + "-Wno-unknown-pragmas", + ); + WRAPPER_EXTENSION = app; + ZERO_LINK = NO; + }; + name = Deployment; + }; + 2A3C3F2B0992245300E404E9 /* Default */ = { + isa = XCBuildConfiguration; + buildSettings = { + FRAMEWORK_SEARCH_PATHS = ( + "$(FRAMEWORK_SEARCH_PATHS)", + "$(SRCROOT)", + ); + GCC_ENABLE_OBJC_EXCEPTIONS = YES; + GCC_PRECOMPILE_PREFIX_HEADER = YES; + INFOPLIST_FILE = Info.plist; + INSTALL_PATH = "$(HOME)/Applications"; + LIBRARY_SEARCH_PATHS = ""; + OTHER_CFLAGS = ""; + OTHER_LDFLAGS = ( + "-L$(OCAMLLIBDIR)", + "-lunix", + "-lthreadsnat", + "-lstr", + "-lasmrun", + ); + PREBINDING = NO; + PRODUCT_NAME = Unison; + SECTORDER_FLAGS = ""; + WARNING_CFLAGS = ( + "-Wmost", + "-Wno-four-char-constants", + "-Wno-unknown-pragmas", + ); + WRAPPER_EXTENSION = app; + }; + name = Default; + }; + 2A3C3F2D0992245300E404E9 /* Development */ = { + isa = XCBuildConfiguration; + baseConfigurationReference = 2E282CCC0D9AE2E800439D01 /* ExternalSettings.xcconfig */; + buildSettings = { + LIBRARY_SEARCH_PATHS = ""; + SDKROOT = /Developer/SDKs/MacOSX10.5.sdk; + USER_HEADER_SEARCH_PATHS = $OCAMLLIBDIR; + }; + name = Development; + }; + 2A3C3F2E0992245300E404E9 /* Deployment */ = { + isa = XCBuildConfiguration; + baseConfigurationReference = 2E282CCC0D9AE2E800439D01 /* ExternalSettings.xcconfig */; + buildSettings = { + LIBRARY_SEARCH_PATHS = ""; + SDKROOT = /Developer/SDKs/MacOSX10.4u.sdk; + USER_HEADER_SEARCH_PATHS = $OCAMLLIBDIR; + }; + name = Deployment; + }; + 2A3C3F2F0992245300E404E9 /* Default */ = { + isa = XCBuildConfiguration; + baseConfigurationReference = 2E282CCC0D9AE2E800439D01 /* ExternalSettings.xcconfig */; + buildSettings = { + LIBRARY_SEARCH_PATHS = ""; + SDKROOT = /Developer/SDKs/MacOSX10.4u.sdk; + USER_HEADER_SEARCH_PATHS = $OCAMLLIBDIR; + }; + name = Default; + }; +/* End XCBuildConfiguration section */ + +/* Begin XCConfigurationList section */ + 2A124E7C0DE1C4A200524237 /* Build configuration list for PBXAggregateTarget "Create ExternalSettings" */ = { + isa = XCConfigurationList; + buildConfigurations = ( + 2A124E790DE1C48400524237 /* Development */, + 2A124E7A0DE1C48400524237 /* Deployment */, + 2A124E7B0DE1C48400524237 /* Default */, + ); + defaultConfigurationIsVisible = 0; + defaultConfigurationName = Default; + }; + 2A3C3F280992245300E404E9 /* Build configuration list for PBXNativeTarget "uimac" */ = { + isa = XCConfigurationList; + buildConfigurations = ( + 2A3C3F290992245300E404E9 /* Development */, + 2A3C3F2A0992245300E404E9 /* Deployment */, + 2A3C3F2B0992245300E404E9 /* Default */, + ); + defaultConfigurationIsVisible = 0; + defaultConfigurationName = Default; + }; + 2A3C3F2C0992245300E404E9 /* Build configuration list for PBXProject "uimacnew" */ = { + isa = XCConfigurationList; + buildConfigurations = ( + 2A3C3F2D0992245300E404E9 /* Development */, + 2A3C3F2E0992245300E404E9 /* Deployment */, + 2A3C3F2F0992245300E404E9 /* Default */, + ); + defaultConfigurationIsVisible = 0; + defaultConfigurationName = Default; + }; +/* End XCConfigurationList section */ + }; + rootObject = 29B97313FDCFA39411CA2CEA /* Project object */; +} Deleted: branches/2.32/src/uitext.ml =================================================================== --- trunk/src/uitext.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/uitext.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,755 +0,0 @@ -(* Unison file synchronizer: src/uitext.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -open Common -open Lwt - -module Body : Uicommon.UI = struct - -let debug = Trace.debug "ui" - -let dumbtty = - Prefs.createBool "dumbtty" - (match Util.osType with - `Unix -> - (try (Unix.getenv "EMACS" <> "") with - Not_found -> false) - | _ -> - true) - "!do not change terminal settings in text UI" - ("When set to \\verb|true|, this flag makes the text mode user " - ^ "interface avoid trying to change any of the terminal settings. " - ^ "(Normally, Unison puts the terminal in `raw mode', so that it can " - ^ "do things like overwriting the current line.) This is useful, for " - ^ "example, when Unison runs in a shell inside of Emacs. " - ^ "\n\n" - ^ "When \\verb|dumbtty| is set, commands to the user interface need to " - ^ "be followed by a carriage return before Unison will execute them. " - ^ "(When it is off, Unison " - ^ "recognizes keystrokes as soon as they are typed.)\n\n" - ^ "This preference has no effect on the graphical user " - ^ "interface.") - -let silent = - Prefs.createBool "silent" false "print nothing except error messages" - ("When this preference is set to {\\tt true}, the textual user " - ^ "interface will print nothing at all, except in the case of errors. " - ^ "Setting \\texttt{silent} to true automatically sets the " - ^ "\\texttt{batch} preference to {\\tt true}.") - -let cbreakMode = ref None - -let rawTerminal () = - match !cbreakMode with - None -> () - | Some state -> - let newstate = - { state with Unix.c_icanon = false; Unix.c_echo = false; - Unix.c_vmin = 1 } - in - Unix.tcsetattr Unix.stdin Unix.TCSANOW newstate - -let defaultTerminal () = - match !cbreakMode with - None -> () - | Some state -> - Unix.tcsetattr Unix.stdin Unix.TCSANOW state - -let restoreTerminal() = - if Util.osType = `Unix && not (Prefs.read dumbtty) then - Sys.set_signal Sys.sigcont Sys.Signal_default; - defaultTerminal (); - cbreakMode := None - -let setupTerminal() = - if Util.osType = `Unix && not (Prefs.read dumbtty) then - try - cbreakMode := Some (Unix.tcgetattr Unix.stdin); - let suspend _ = - defaultTerminal (); - Sys.set_signal Sys.sigtstp Sys.Signal_default; - Unix.kill (Unix.getpid ()) Sys.sigtstp - in - let resume _ = - Sys.set_signal Sys.sigtstp (Sys.Signal_handle suspend); - rawTerminal () - in - Sys.set_signal Sys.sigcont (Sys.Signal_handle resume); - resume () - with Unix.Unix_error _ -> - restoreTerminal () - -let alwaysDisplay message = - print_string message; - flush stdout - -let alwaysDisplayAndLog message = -(* alwaysDisplay message;*) - Trace.log (message ^ "\n") - -let display message = - if not (Prefs.read silent) then alwaysDisplay message - -let displayWhenInteractive message = - if not (Prefs.read Globals.batch) then alwaysDisplay message - -let getInput () = - if !cbreakMode = None then - let l = input_line stdin in - if l="" then "" else String.sub l 0 1 - else - let c = input_char stdin in - let c = if c='\n' then "" else String.make 1 c in - display c; - c - -let newLine () = - if !cbreakMode <> None then display "\n" - -let overwrite () = - if !cbreakMode <> None then display "\r" - -let rec selectAction batch actions tryagain = - let formatname = function - "" -> "" - | " " -> "" - | n -> n in - let summarizeChoices() = - display "["; - Safelist.iter - (fun (names,doc,action) -> - if (Safelist.nth names 0) = "" then - display (formatname (Safelist.nth names 1))) - actions; - display "] " in - let tryagainOrLoop() = - tryagain (); - selectAction batch actions tryagain in - let rec find n = function - [] -> raise Not_found - | (names,doc,action)::rest -> - if Safelist.mem n names then action else find n rest - in - let doAction a = - if a="?" then - (newLine (); - display "Commands:\n"; - Safelist.iter (fun (names,doc,action) -> - let n = Util.concatmap " or " formatname names in - let space = String.make (max 2 (22 - String.length n)) ' ' in - display (" " ^ n ^ space ^ doc ^ "\n")) - actions; - tryagainOrLoop()) - else - try find a actions () with Not_found -> - newLine (); - if a="" then - display ("No default command [type '?' for help]\n") - else - display ("Unrecognized command '" ^ String.escaped a - ^ "': try again [type '?' for help]\n"); - tryagainOrLoop() - in - doAction (match batch with - None -> - summarizeChoices(); - getInput () - | Some i -> i) - -let alwaysDisplayDetails ri = - alwaysDisplay ((Uicommon.details2string ri " ") ^ "\n") - -let displayDetails ri = - if not (Prefs.read silent) then alwaysDisplayDetails ri - -let displayri ri = - let s = Uicommon.reconItem2string Path.empty ri "" ^ " " in - let s = - match ri.replicas with - Different(_,_,d,def) when !d<>def -> - let s = Util.replacesubstring s "<-?->" "<=?=>" in - let s = Util.replacesubstring s "---->" "====>" in - let s = Util.replacesubstring s "<----" "<====" in - s - | _ -> s in - match ri.replicas with - Problem _ -> - alwaysDisplay s - | Different (_,_,d,_) when !d=Conflict -> - alwaysDisplay s - | _ -> - display s - -type proceed = ConfirmBeforeProceeding | ProceedImmediately - -let interact rilist = - let (r1,r2) = Globals.roots() in - let (host1, host2) = root2hostname r1, root2hostname r2 in - if not (Prefs.read Globals.batch) then display ("\n" ^ Uicommon.roots2string() ^ "\n"); - let rec loop prev = - function - [] -> (ConfirmBeforeProceeding, Safelist.rev prev) - | ri::rest as ril -> - let next() = loop (ri::prev) rest in - let repeat() = loop prev ril in - let ignore pat rest what = - if !cbreakMode <> None then display "\n"; - display " "; - Uicommon.addIgnorePattern pat; - display (" Permanently ignoring " ^ what ^ "\n"); - begin match !Prefs.profileName with None -> assert false | - Some(n) -> - display (" To un-ignore, edit " - ^ (Prefs.profilePathname n) - ^ " and restart " ^ Uutil.myName ^ "\n") end; - let nukeIgnoredRis = - Safelist.filter (fun ri -> not (Globals.shouldIgnore ri.path)) in - loop (nukeIgnoredRis (ri::prev)) (nukeIgnoredRis ril) in - (* This should work on most terminals: *) - let redisplayri() = overwrite (); displayri ri; display "\n" in - displayri ri; - match ri.replicas with - Problem s -> display "\n"; display s; display "\n"; next() - | Different(rc1,rc2,dir,_) -> - if Prefs.read Uicommon.auto && !dir<>Conflict then begin - display "\n"; next() - end else - let (descr, descl) = - if host1 = host2 then - "left to right", "right to left" - else - "from "^host1^" to "^host2, - "from "^host2^" to "^host1 - in - if Prefs.read Globals.batch then begin - display "\n"; - if not (Prefs.read Trace.terse) then - displayDetails ri - end; - selectAction - (if Prefs.read Globals.batch then Some " " else None) - [((if !dir=Conflict && not (Prefs.read Globals.batch) - then ["f"] (* Offer no default behavior if we've got - a conflict and we're in interactive mode *) - else ["";"f";" "]), - ("follow " ^ Uutil.myName ^ "'s recommendation (if any)"), - fun ()-> - newLine (); - if !dir = Conflict && not (Prefs.read Globals.batch) - then begin - display "No default action [type '?' for help]\n"; - repeat() - end else - next()); - (["I"], - ("ignore this path permanently"), - (fun () -> - ignore (Uicommon.ignorePath ri.path) rest - "this path")); - (["E"], - ("permanently ignore files with this extension"), - (fun () -> - ignore (Uicommon.ignoreExt ri.path) rest - "files with this extension")); - (["N"], - ("permanently ignore paths ending with this name"), - (fun () -> - ignore (Uicommon.ignoreName ri.path) rest - "files with this name")); - (["m"], - ("merge the versions"), - (fun () -> - dir := Merge; - redisplayri(); - next())); - (["d"], - ("show differences"), - (fun () -> - newLine (); - Uicommon.showDiffs ri - (fun title text -> - try - let pager = Sys.getenv "PAGER" in - restoreTerminal (); - let out = Unix.open_process_out pager in - Printf.fprintf out "\n%s\n\n%s\n\n" title text; - let _ = Unix.close_process_out out in - setupTerminal () - with Not_found -> - Printf.printf "\n%s\n\n%s\n\n" title text) - (fun s -> Printf.printf "%s\n" s) - Uutil.File.dummy; - repeat())); - (["x"], - ("show details"), - (fun () -> display "\n"; displayDetails ri; repeat())); - (["L"], - ("list all suggested changes tersely"), - (fun () -> display "\n"; - Safelist.iter - (fun ri -> displayri ri; display "\n ") - ril; - display "\n"; - repeat())); - (["l"], - ("list all suggested changes with details"), - (fun () -> display "\n"; - Safelist.iter - (fun ri -> displayri ri; display "\n "; - alwaysDisplayDetails ri) - ril; - display "\n"; - repeat())); - (["p";"b"], - ("go back to previous item"), - (fun () -> - newLine(); - match prev with - [] -> repeat() - | prevri::prevprev -> loop prevprev (prevri :: ril))); - (["g"], - ("proceed immediately to propagating changes"), - (fun() -> - (ProceedImmediately, Safelist.rev_append prev ril))); - (["q"], - ("exit " ^ Uutil.myName ^ " without propagating any changes"), - fun () -> raise Sys.Break); - (["/"], - ("skip"), - (fun () -> - dir := Conflict; - redisplayri(); - next())); - ([">";"."], - ("propagate from " ^ descr), - (fun () -> - dir := Replica1ToReplica2; - redisplayri(); - next())); - (["<";","], - ("propagate from " ^ descl), - (fun () -> - dir := Replica2ToReplica1; - redisplayri(); - next())) - ] - (fun () -> displayri ri) - in - loop [] rilist - -let verifyMerge title text = - Printf.printf "%s\n" text; - if Prefs.read Globals.batch then - true - else begin - if Prefs.read Uicommon.confirmmerge then begin - display "Commit results of merge? "; - selectAction - None (* Maybe better: (Some "n") *) - [(["y";"g"], - "Yes: commit", - (fun() -> true)); - (["n"], - "No: leave this file unchanged", - (fun () -> false)); - ] - (fun () -> display "Commit results of merge? ") - end else - true - end - -let doTransport reconItemList = - let totalBytesToTransfer = - ref - (Safelist.fold_left - (fun l ri -> Uutil.Filesize.add l (Common.riLength ri)) - Uutil.Filesize.zero reconItemList) in - let totalBytesTransferred = ref Uutil.Filesize.zero in - let t0 = Unix.gettimeofday () in - let showProgress _ b _ = - totalBytesTransferred := Uutil.Filesize.add !totalBytesTransferred b; - let v = - (Uutil.Filesize.percentageOfTotalSize - !totalBytesTransferred !totalBytesToTransfer) - in - let t1 = Unix.gettimeofday () in - let remTime = - if v <= 0. then "--:--" - else if v >= 100. then "00:00" - else - let t = truncate ((t1 -. t0) *. (100. -. v) /. v +. 0.5) in - Format.sprintf "%02d:%02d" (t / 60) (t mod 60) - in - Util.set_infos - (Format.sprintf "%s %s ETA" (Util.percent2string v) remTime) - in - if not (Prefs.read Trace.terse) && (Prefs.read Trace.debugmods = []) then - Uutil.setProgressPrinter showProgress; - - Transport.logStart (); - let fFailedPaths = ref [] in - let uiWrapper ri f = - catch f - (fun e -> - match e with - Util.Transient s -> - let m = "[" ^ (Path.toString ri.path) ^ "]: " ^ s in - alwaysDisplay ("Failed " ^ m ^ "\n"); - fFailedPaths := ri.path :: !fFailedPaths; - return () - | _ -> - fail e) in - let counter = ref 0 in - let rec loop ris actions pRiThisRound = - match ris with - [] -> - actions - | ri :: rest when pRiThisRound ri -> - loop rest - (uiWrapper ri - (fun () -> (* We need different line numbers so that - transport operations are aborted independently *) - incr counter; - Transport.transportItem ri - (Uutil.File.ofLine !counter) verifyMerge) - :: actions) - pRiThisRound - | _ :: rest -> - loop rest actions pRiThisRound - in - Lwt_unix.run - (let actions = loop reconItemList [] - (fun ri -> not (Common.isDeletion ri)) in - Lwt_util.join actions); - Lwt_unix.run - (let actions = loop reconItemList [] Common.isDeletion in - Lwt_util.join actions); - Transport.logFinish (); - - Uutil.setProgressPrinter (fun _ _ _ -> ()); - Util.set_infos ""; - - (Safelist.rev !fFailedPaths) - -let setWarnPrinterForInitialization()= - Util.warnPrinter := - Some(fun s -> - alwaysDisplay "Error: "; - alwaysDisplay s; - alwaysDisplay "\n"; - exit Uicommon.fatalExit) - -let setWarnPrinter() = - Util.warnPrinter := - Some(fun s -> - alwaysDisplay "Warning: "; - alwaysDisplay s; - if not (Prefs.read Globals.batch) then begin - display "Press return to continue."; - selectAction None - [(["";" ";"y"], - ("Continue"), - fun()->()); - (["n";"q";"x"], - ("Exit"), - fun()-> - alwaysDisplay "\n"; - restoreTerminal (); - Lwt_unix.run (Update.unlockArchives ()); - exit Uicommon.fatalExit)] - (fun()-> display "Press return to continue.") - end) - -let lastMajor = ref "" - -let formatStatus major minor = - let s = - if major = !lastMajor then " " ^ minor - else major ^ (if minor="" then "" else "\n " ^ minor) - in - lastMajor := major; - s - -let rec interactAndPropagateChanges reconItemList - : bool * bool * (Path.t list) - (* anySkipped?, anyFailures?, failingPaths *) = - let (proceed,newReconItemList) = interact reconItemList in - let (updatesToDo, skipped) = - Safelist.fold_left - (fun (howmany, skipped) ri -> - if problematic ri then (howmany, skipped + 1) - else (howmany + 1, skipped)) - (0, 0) newReconItemList in - let doit() = - if not (Prefs.read Globals.batch || Prefs.read Trace.terse) then newLine(); - if not (Prefs.read Trace.terse) then Trace.status "Propagating updates"; - let timer = Trace.startTimer "Transmitting all files" in - let failedPaths = doTransport newReconItemList in - let failures = Safelist.length failedPaths in - Trace.showTimer timer; - if not (Prefs.read Trace.terse) then Trace.status "Saving synchronizer state"; - Update.commitUpdates (); - let trans = updatesToDo - failures in - let summary = - Printf.sprintf - "Synchronization %s at %s (%d item%s transferred, %d skipped, %d failed)" - (if failures=0 then "complete" else "incomplete") - (let tm = Util.localtime (Util.time()) in - Printf.sprintf "%02d:%02d:%02d" - tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec) - trans (if trans=1 then "" else "s") - skipped - failures in - Trace.log (summary ^ "\n"); - if skipped>0 then - Safelist.iter - (fun ri -> - if problematic ri then - alwaysDisplayAndLog - (" skipped: " ^ (Path.toString ri.path))) - newReconItemList; - if failures>0 then - Safelist.iter - (fun p -> alwaysDisplayAndLog (" failed: " ^ (Path.toString p))) - failedPaths; - (skipped > 0, failures > 0, failedPaths) in - if updatesToDo = 0 then begin - display "No updates to propagate\n"; - (* BCP (3/09): We need to commit the archives even if there are - 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 (); - (skipped > 0, false, []) - end else if proceed=ProceedImmediately then begin - doit() - end else begin - displayWhenInteractive "\nProceed with propagating updates? "; - selectAction - (* BCP: I find it counterintuitive that every other prompt except this one - would expect as a default. But I got talked out of offering a default - here, because of safety considerations (too easy to press one time - too many). *) - (if Prefs.read Globals.batch then Some "y" else None) - [(["y";"g"], - "Yes: proceed with updates as selected above", - doit); - (["n"], - "No: go through selections again", - (fun () -> - Prefs.set Uicommon.auto false; - newLine(); - interactAndPropagateChanges reconItemList)); - (["q"], - ("exit " ^ Uutil.myName ^ " without propagating any changes"), - fun () -> raise Sys.Break) - ] - (fun () -> display "Proceed with propagating updates? ") - end - -let checkForDangerousPath dangerousPaths = - if Prefs.read Globals.confirmBigDeletes then begin - if dangerousPaths <> [] then begin - alwaysDisplayAndLog (Uicommon.dangerousPathMsg dangerousPaths); - if Prefs.read Globals.batch then begin - alwaysDisplay "Aborting...\n"; restoreTerminal (); - exit Uicommon.fatalExit - end else begin - displayWhenInteractive "Do you really want to proceed? "; - selectAction - None - [(["y"], - "Continue", - (fun() -> ())); - (["n"; "q"; "x"; ""], - "Exit", - (fun () -> alwaysDisplay "\n"; restoreTerminal (); - exit Uicommon.fatalExit))] - (fun () -> display "Do you really want to proceed? ") - end - end - end - -let synchronizeOnce() = - Trace.status "Looking for changes"; - let (reconItemList, anyEqualUpdates, dangerousPaths) = - Recon.reconcileAll (Update.findUpdates()) in - if reconItemList = [] then begin - (if anyEqualUpdates then - Trace.status ("Nothing to do: replicas have been changed only " - ^ "in identical ways since last sync.") - else - Trace.status "Nothing to do: replicas have not changed since last sync."); - (Uicommon.perfectExit, []) - end else begin - checkForDangerousPath dangerousPaths; - let (anySkipped, anyFailures, failedPaths) = - interactAndPropagateChanges reconItemList in - let exitStatus = Uicommon.exitCode(anySkipped,anyFailures) in - (exitStatus, failedPaths) - end - -let watchinterval = 10 - -(* FIX; Using string concatenation to accumulate characters is - pretty inefficient! *) -let charsRead = ref "" -let linesRead = ref [] -let watcherchan = ref None - -let suckOnWatcherFileLocal n = - Util.convertUnixErrorsToFatal - ("Reading changes from watcher process in file " ^ n) - (fun () -> - (* The main loop, invoked from two places below *) - let rec loop ch = - match try Some(input_char ch) with End_of_file -> None with - None -> - let res = !linesRead in - linesRead := []; - res - | Some(c) -> - if c = '\n' then begin - linesRead := !charsRead - :: !linesRead; - charsRead := ""; - loop ch - end else begin - charsRead := (!charsRead) ^ (String.make 1 c); - loop ch - end in - (* Make sure there's a file to watch, then read from it *) - match !watcherchan with - None -> - if Sys.file_exists n then begin - let ch = open_in n in - watcherchan := Some(ch); - loop ch - end else [] - | Some(ch) -> loop ch - ) - -let suckOnWatcherFileRoot: Common.root -> string -> (string list) Lwt.t = - Remote.registerRootCmd - "suckOnWatcherFile" - (fun (fspath, n) -> - Lwt.return (suckOnWatcherFileLocal n)) - -let suckOnWatcherFiles n = - Safelist.concat - (Lwt_unix.run ( - Globals.allRootsMap (fun r -> suckOnWatcherFileRoot r n))) - -let synchronizePathsFromFilesystemWatcher () = - let watcherfilename = "" in - (* STOPPED HERE -- need to find the program using watcherosx preference and invoke it using a redirect to get the output into a temp file... *) - let rec loop failedPaths = - let newpaths = suckOnWatcherFiles watcherfilename in - if newpaths <> [] then - display (Printf.sprintf "Changed paths:\n %s\n" - (String.concat "\n " newpaths)); - let p = failedPaths @ (Safelist.map Path.fromString newpaths) in - if p <> [] then begin - Prefs.set Globals.paths p; - let (exitStatus,newFailedPaths) = synchronizeOnce() in - debug (fun() -> Util.msg "Sleeping for %d seconds...\n" watchinterval); - Unix.sleep watchinterval; - loop newFailedPaths - end else begin - debug (fun() -> Util.msg "Nothing changed: sleeping for %d seconds...\n" - watchinterval); - Unix.sleep watchinterval; - loop [] - end in - loop [] - -let synchronizeUntilNoFailures () = - let initValueOfPathsPreference = Prefs.read Globals.paths in - let rec loop triesLeft = - let (exitStatus,failedPaths) = synchronizeOnce() in - if failedPaths <> [] && triesLeft <> 0 then begin - loop (triesLeft - 1) - end else begin - Prefs.set Globals.paths initValueOfPathsPreference; - exitStatus - end in - loop (Prefs.read Uicommon.retry) - -let rec synchronizeUntilDone () = - let repeatinterval = - if Prefs.read Uicommon.repeat = "" then -1 else - try int_of_string (Prefs.read Uicommon.repeat) - with Failure "int_of_string" -> - (* If the 'repeat' pref is not a number, switch modes... *) - if Prefs.read Uicommon.repeat = "watch" then - synchronizePathsFromFilesystemWatcher() - else - raise (Util.Fatal ("Value of 'repeat' preference (" - ^Prefs.read Uicommon.repeat - ^") should be either a number or 'watch'\n")) in - - let exitStatus = synchronizeUntilNoFailures() in - if repeatinterval < 0 then - exitStatus - else begin - (* Do it again *) - Trace.status (Printf.sprintf "\nSleeping for %d seconds...\n" repeatinterval); - Unix.sleep repeatinterval; - synchronizeUntilDone () - end - -let start _ = - begin try - (* Just to make sure something is there... *) - setWarnPrinterForInitialization(); - Uicommon.uiInit - (fun s -> Util.msg "%s\n%s\n" Uicommon.shortUsageMsg s; exit 1) - (fun s -> Util.msg "%s" Uicommon.shortUsageMsg; exit 1) - (fun () -> if not (Prefs.read silent) - then Util.msg "%s\n" (Uicommon.contactingServerMsg())) - (fun () -> Some "default") - (fun () -> Util.msg "%s" Uicommon.shortUsageMsg; exit 1) - (fun () -> Util.msg "%s" Uicommon.shortUsageMsg; exit 1) - None; - - (* Some preference settings imply others... *) - if Prefs.read silent then begin - Prefs.set Globals.batch true; - Prefs.set Trace.terse true; - Prefs.set dumbtty true; - Trace.sendLogMsgsToStderr := false; - end; - if Prefs.read Uicommon.repeat <> "" then begin - Prefs.set Globals.batch true; - end; - - (* Tell OCaml that we want to catch Control-C ourselves, so that - we get a chance to reset the terminal before exiting *) - Sys.catch_break true; - (* Put the terminal in cbreak mode if possible *) - if not (Prefs.read Globals.batch) then setupTerminal(); - setWarnPrinter(); - Trace.statusFormatter := formatStatus; - - let exitStatus = synchronizeUntilDone() in - - (* Put the terminal back in "sane" mode, if necessary, and quit. *) - restoreTerminal(); - exit exitStatus - - with - e -> - restoreTerminal(); - let msg = Uicommon.exn2string e in - Trace.log (msg ^ "\n"); - if not !Trace.sendLogMsgsToStderr then begin - alwaysDisplay "\n"; - alwaysDisplay msg; - alwaysDisplay "\n"; - end; - exit Uicommon.fatalExit - end - -let defaultUi = Uicommon.Text - -end Copied: branches/2.32/src/uitext.ml (from rev 320, trunk/src/uitext.ml) =================================================================== --- branches/2.32/src/uitext.ml (rev 0) +++ branches/2.32/src/uitext.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,770 @@ +(* Unison file synchronizer: src/uitext.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +open Common +open Lwt + +module Body : Uicommon.UI = struct + +let debug = Trace.debug "ui" + +let dumbtty = + Prefs.createBool "dumbtty" + (match Util.osType with + `Unix -> + (try (Unix.getenv "EMACS" <> "") with + Not_found -> false) + | _ -> + true) + "!do not change terminal settings in text UI" + ("When set to \\verb|true|, this flag makes the text mode user " + ^ "interface avoid trying to change any of the terminal settings. " + ^ "(Normally, Unison puts the terminal in `raw mode', so that it can " + ^ "do things like overwriting the current line.) This is useful, for " + ^ "example, when Unison runs in a shell inside of Emacs. " + ^ "\n\n" + ^ "When \\verb|dumbtty| is set, commands to the user interface need to " + ^ "be followed by a carriage return before Unison will execute them. " + ^ "(When it is off, Unison " + ^ "recognizes keystrokes as soon as they are typed.)\n\n" + ^ "This preference has no effect on the graphical user " + ^ "interface.") + +let silent = + Prefs.createBool "silent" false "print nothing except error messages" + ("When this preference is set to {\\tt true}, the textual user " + ^ "interface will print nothing at all, except in the case of errors. " + ^ "Setting \\texttt{silent} to true automatically sets the " + ^ "\\texttt{batch} preference to {\\tt true}.") + +let cbreakMode = ref None + +let rawTerminal () = + match !cbreakMode with + None -> () + | Some state -> + let newstate = + { state with Unix.c_icanon = false; Unix.c_echo = false; + Unix.c_vmin = 1 } + in + Unix.tcsetattr Unix.stdin Unix.TCSANOW newstate + +let defaultTerminal () = + match !cbreakMode with + None -> () + | Some state -> + Unix.tcsetattr Unix.stdin Unix.TCSANOW state + +let restoreTerminal() = + if Util.osType = `Unix && not (Prefs.read dumbtty) then + Sys.set_signal Sys.sigcont Sys.Signal_default; + defaultTerminal (); + cbreakMode := None + +let setupTerminal() = + if Util.osType = `Unix && not (Prefs.read dumbtty) then + try + cbreakMode := Some (Unix.tcgetattr Unix.stdin); + let suspend _ = + defaultTerminal (); + Sys.set_signal Sys.sigtstp Sys.Signal_default; + Unix.kill (Unix.getpid ()) Sys.sigtstp + in + let resume _ = + Sys.set_signal Sys.sigtstp (Sys.Signal_handle suspend); + rawTerminal () + in + Sys.set_signal Sys.sigcont (Sys.Signal_handle resume); + resume () + with Unix.Unix_error _ -> + restoreTerminal () + +let alwaysDisplay message = + print_string message; + flush stdout + +let alwaysDisplayAndLog message = +(* alwaysDisplay message;*) + Trace.log (message ^ "\n") + +let display message = + if not (Prefs.read silent) then alwaysDisplay message + +let displayWhenInteractive message = + if not (Prefs.read Globals.batch) then alwaysDisplay message + +let getInput () = + if !cbreakMode = None then + let l = input_line stdin in + if l="" then "" else String.sub l 0 1 + else + let c = input_char stdin in + let c = if c='\n' then "" else String.make 1 c in + display c; + c + +let newLine () = + if !cbreakMode <> None then display "\n" + +let overwrite () = + if !cbreakMode <> None then display "\r" + +let rec selectAction batch actions tryagain = + let formatname = function + "" -> "" + | " " -> "" + | n -> n in + let summarizeChoices() = + display "["; + Safelist.iter + (fun (names,doc,action) -> + if (Safelist.nth names 0) = "" then + display (formatname (Safelist.nth names 1))) + actions; + display "] " in + let tryagainOrLoop() = + tryagain (); + selectAction batch actions tryagain in + let rec find n = function + [] -> raise Not_found + | (names,doc,action)::rest -> + if Safelist.mem n names then action else find n rest + in + let doAction a = + if a="?" then + (newLine (); + display "Commands:\n"; + Safelist.iter (fun (names,doc,action) -> + let n = Util.concatmap " or " formatname names in + let space = String.make (max 2 (22 - String.length n)) ' ' in + display (" " ^ n ^ space ^ doc ^ "\n")) + actions; + tryagainOrLoop()) + else + try find a actions () with Not_found -> + newLine (); + if a="" then + display ("No default command [type '?' for help]\n") + else + display ("Unrecognized command '" ^ String.escaped a + ^ "': try again [type '?' for help]\n"); + tryagainOrLoop() + in + doAction (match batch with + None -> + summarizeChoices(); + getInput () + | Some i -> i) + +let alwaysDisplayDetails ri = + alwaysDisplay ((Uicommon.details2string ri " ") ^ "\n") + +let displayDetails ri = + if not (Prefs.read silent) then alwaysDisplayDetails ri + +let displayri ri = + let s = Uicommon.reconItem2string Path.empty ri "" ^ " " in + let s = + match ri.replicas with + Different(_,_,d,def) when !d<>def -> + let s = Util.replacesubstring s "<-?->" "<=?=>" in + let s = Util.replacesubstring s "---->" "====>" in + let s = Util.replacesubstring s "<----" "<====" in + s + | _ -> s in + match ri.replicas with + Problem _ -> + alwaysDisplay s + | Different (_,_,d,_) when !d=Conflict -> + alwaysDisplay s + | _ -> + display s + +type proceed = ConfirmBeforeProceeding | ProceedImmediately + +let interact rilist = + let (r1,r2) = Globals.roots() in + let (host1, host2) = root2hostname r1, root2hostname r2 in + if not (Prefs.read Globals.batch) then display ("\n" ^ Uicommon.roots2string() ^ "\n"); + let rec loop prev = + function + [] -> (ConfirmBeforeProceeding, Safelist.rev prev) + | ri::rest as ril -> + let next() = loop (ri::prev) rest in + let repeat() = loop prev ril in + let ignore pat rest what = + if !cbreakMode <> None then display "\n"; + display " "; + Uicommon.addIgnorePattern pat; + display (" Permanently ignoring " ^ what ^ "\n"); + begin match !Prefs.profileName with None -> assert false | + Some(n) -> + display (" To un-ignore, edit " + ^ (Prefs.profilePathname n) + ^ " and restart " ^ Uutil.myName ^ "\n") end; + let nukeIgnoredRis = + Safelist.filter (fun ri -> not (Globals.shouldIgnore ri.path)) in + loop (nukeIgnoredRis (ri::prev)) (nukeIgnoredRis ril) in + (* This should work on most terminals: *) + let redisplayri() = overwrite (); displayri ri; display "\n" in + displayri ri; + match ri.replicas with + Problem s -> display "\n"; display s; display "\n"; next() + | Different(rc1,rc2,dir,_) -> + if Prefs.read Uicommon.auto && !dir<>Conflict then begin + display "\n"; next() + end else + let (descr, descl) = + if host1 = host2 then + "left to right", "right to left" + else + "from "^host1^" to "^host2, + "from "^host2^" to "^host1 + in + if Prefs.read Globals.batch then begin + display "\n"; + if not (Prefs.read Trace.terse) then + displayDetails ri + end; + selectAction + (if Prefs.read Globals.batch then Some " " else None) + [((if !dir=Conflict && not (Prefs.read Globals.batch) + then ["f"] (* Offer no default behavior if we've got + a conflict and we're in interactive mode *) + else ["";"f";" "]), + ("follow " ^ Uutil.myName ^ "'s recommendation (if any)"), + fun ()-> + newLine (); + if !dir = Conflict && not (Prefs.read Globals.batch) + then begin + display "No default action [type '?' for help]\n"; + repeat() + end else + next()); + (["I"], + ("ignore this path permanently"), + (fun () -> + ignore (Uicommon.ignorePath ri.path) rest + "this path")); + (["E"], + ("permanently ignore files with this extension"), + (fun () -> + ignore (Uicommon.ignoreExt ri.path) rest + "files with this extension")); + (["N"], + ("permanently ignore paths ending with this name"), + (fun () -> + ignore (Uicommon.ignoreName ri.path) rest + "files with this name")); + (["m"], + ("merge the versions"), + (fun () -> + dir := Merge; + redisplayri(); + next())); + (["d"], + ("show differences"), + (fun () -> + newLine (); + Uicommon.showDiffs ri + (fun title text -> + try + let pager = Sys.getenv "PAGER" in + restoreTerminal (); + let out = Unix.open_process_out pager in + Printf.fprintf out "\n%s\n\n%s\n\n" title text; + let _ = Unix.close_process_out out in + setupTerminal () + with Not_found -> + Printf.printf "\n%s\n\n%s\n\n" title text) + (fun s -> Printf.printf "%s\n" s) + Uutil.File.dummy; + repeat())); + (["x"], + ("show details"), + (fun () -> display "\n"; displayDetails ri; repeat())); + (["L"], + ("list all suggested changes tersely"), + (fun () -> display "\n"; + Safelist.iter + (fun ri -> displayri ri; display "\n ") + ril; + display "\n"; + repeat())); + (["l"], + ("list all suggested changes with details"), + (fun () -> display "\n"; + Safelist.iter + (fun ri -> displayri ri; display "\n "; + alwaysDisplayDetails ri) + ril; + display "\n"; + repeat())); + (["p";"b"], + ("go back to previous item"), + (fun () -> + newLine(); + match prev with + [] -> repeat() + | prevri::prevprev -> loop prevprev (prevri :: ril))); + (["g"], + ("proceed immediately to propagating changes"), + (fun() -> + (ProceedImmediately, Safelist.rev_append prev ril))); + (["q"], + ("exit " ^ Uutil.myName ^ " without propagating any changes"), + fun () -> raise Sys.Break); + (["/"], + ("skip"), + (fun () -> + dir := Conflict; + redisplayri(); + next())); + ([">";"."], + ("propagate from " ^ descr), + (fun () -> + dir := Replica1ToReplica2; + redisplayri(); + next())); + (["<";","], + ("propagate from " ^ descl), + (fun () -> + dir := Replica2ToReplica1; + redisplayri(); + next())) + ] + (fun () -> displayri ri) + in + loop [] rilist + +let verifyMerge title text = + Printf.printf "%s\n" text; + if Prefs.read Globals.batch then + true + else begin + if Prefs.read Uicommon.confirmmerge then begin + display "Commit results of merge? "; + selectAction + None (* Maybe better: (Some "n") *) + [(["y";"g"], + "Yes: commit", + (fun() -> true)); + (["n"], + "No: leave this file unchanged", + (fun () -> false)); + ] + (fun () -> display "Commit results of merge? ") + end else + true + end + +let doTransport reconItemList = + let totalBytesToTransfer = + ref + (Safelist.fold_left + (fun l ri -> Uutil.Filesize.add l (Common.riLength ri)) + Uutil.Filesize.zero reconItemList) in + let totalBytesTransferred = ref Uutil.Filesize.zero in + let t0 = Unix.gettimeofday () in + let showProgress _ b _ = + totalBytesTransferred := Uutil.Filesize.add !totalBytesTransferred b; + let v = + (Uutil.Filesize.percentageOfTotalSize + !totalBytesTransferred !totalBytesToTransfer) + in + let t1 = Unix.gettimeofday () in + let remTime = + if v <= 0. then "--:--" + else if v >= 100. then "00:00" + else + let t = truncate ((t1 -. t0) *. (100. -. v) /. v +. 0.5) in + Format.sprintf "%02d:%02d" (t / 60) (t mod 60) + in + Util.set_infos + (Format.sprintf "%s %s ETA" (Util.percent2string v) remTime) + in + if not (Prefs.read Trace.terse) && (Prefs.read Trace.debugmods = []) then + Uutil.setProgressPrinter showProgress; + + Transport.logStart (); + let fFailedPaths = ref [] in + let uiWrapper ri f = + catch f + (fun e -> + match e with + Util.Transient s -> + let m = "[" ^ (Path.toString ri.path) ^ "]: " ^ s in + alwaysDisplay ("Failed " ^ m ^ "\n"); + fFailedPaths := ri.path :: !fFailedPaths; + return () + | _ -> + fail e) in + let counter = ref 0 in + let rec loop ris actions pRiThisRound = + match ris with + [] -> + actions + | ri :: rest when pRiThisRound ri -> + loop rest + (uiWrapper ri + (fun () -> (* We need different line numbers so that + transport operations are aborted independently *) + incr counter; + Transport.transportItem ri + (Uutil.File.ofLine !counter) verifyMerge) + :: actions) + pRiThisRound + | _ :: rest -> + loop rest actions pRiThisRound + in + Lwt_unix.run + (let actions = loop reconItemList [] + (fun ri -> not (Common.isDeletion ri)) in + Lwt_util.join actions); + Lwt_unix.run + (let actions = loop reconItemList [] Common.isDeletion in + Lwt_util.join actions); + Transport.logFinish (); + + Uutil.setProgressPrinter (fun _ _ _ -> ()); + Util.set_infos ""; + + (Safelist.rev !fFailedPaths) + +let setWarnPrinterForInitialization()= + Util.warnPrinter := + Some(fun s -> + alwaysDisplay "Error: "; + alwaysDisplay s; + alwaysDisplay "\n"; + exit Uicommon.fatalExit) + +let setWarnPrinter() = + Util.warnPrinter := + Some(fun s -> + alwaysDisplay "Warning: "; + alwaysDisplay s; + if not (Prefs.read Globals.batch) then begin + display "Press return to continue."; + selectAction None + [(["";" ";"y"], + ("Continue"), + fun()->()); + (["n";"q";"x"], + ("Exit"), + fun()-> + alwaysDisplay "\n"; + restoreTerminal (); + Lwt_unix.run (Update.unlockArchives ()); + exit Uicommon.fatalExit)] + (fun()-> display "Press return to continue.") + end) + +let lastMajor = ref "" + +let formatStatus major minor = + let s = + if major = !lastMajor then " " ^ minor + else major ^ (if minor="" then "" else "\n " ^ minor) + in + lastMajor := major; + s + +let rec interactAndPropagateChanges reconItemList + : bool * bool * (Path.t list) + (* anySkipped?, anyFailures?, failingPaths *) = + let (proceed,newReconItemList) = interact reconItemList in + let (updatesToDo, skipped) = + Safelist.fold_left + (fun (howmany, skipped) ri -> + if problematic ri then (howmany, skipped + 1) + else (howmany + 1, skipped)) + (0, 0) newReconItemList in + let doit() = + if not (Prefs.read Globals.batch || Prefs.read Trace.terse) then newLine(); + if not (Prefs.read Trace.terse) then Trace.status "Propagating updates"; + let timer = Trace.startTimer "Transmitting all files" in + let failedPaths = doTransport newReconItemList in + let failures = Safelist.length failedPaths in + Trace.showTimer timer; + if not (Prefs.read Trace.terse) then Trace.status "Saving synchronizer state"; + Update.commitUpdates (); + let trans = updatesToDo - failures in + let summary = + Printf.sprintf + "Synchronization %s at %s (%d item%s transferred, %d skipped, %d failed)" + (if failures=0 then "complete" else "incomplete") + (let tm = Util.localtime (Util.time()) in + Printf.sprintf "%02d:%02d:%02d" + tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec) + trans (if trans=1 then "" else "s") + skipped + failures in + Trace.log (summary ^ "\n"); + if skipped>0 then + Safelist.iter + (fun ri -> + if problematic ri then + alwaysDisplayAndLog + (" skipped: " ^ (Path.toString ri.path))) + newReconItemList; + if failures>0 then + Safelist.iter + (fun p -> alwaysDisplayAndLog (" failed: " ^ (Path.toString p))) + failedPaths; + (skipped > 0, failures > 0, failedPaths) in + if updatesToDo = 0 then begin + display "No updates to propagate\n"; + (* BCP (3/09): We need to commit the archives even if there are + 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 (); + (skipped > 0, false, []) + end else if proceed=ProceedImmediately then begin + doit() + end else begin + displayWhenInteractive "\nProceed with propagating updates? "; + selectAction + (* BCP: I find it counterintuitive that every other prompt except this one + would expect as a default. But I got talked out of offering a default + here, because of safety considerations (too easy to press one time + too many). *) + (if Prefs.read Globals.batch then Some "y" else None) + [(["y";"g"], + "Yes: proceed with updates as selected above", + doit); + (["n"], + "No: go through selections again", + (fun () -> + Prefs.set Uicommon.auto false; + newLine(); + interactAndPropagateChanges reconItemList)); + (["q"], + ("exit " ^ Uutil.myName ^ " without propagating any changes"), + fun () -> raise Sys.Break) + ] + (fun () -> display "Proceed with propagating updates? ") + end + +let checkForDangerousPath dangerousPaths = + if Prefs.read Globals.confirmBigDeletes then begin + if dangerousPaths <> [] then begin + alwaysDisplayAndLog (Uicommon.dangerousPathMsg dangerousPaths); + if Prefs.read Globals.batch then begin + alwaysDisplay "Aborting...\n"; restoreTerminal (); + exit Uicommon.fatalExit + end else begin + displayWhenInteractive "Do you really want to proceed? "; + selectAction + None + [(["y"], + "Continue", + (fun() -> ())); + (["n"; "q"; "x"; ""], + "Exit", + (fun () -> alwaysDisplay "\n"; restoreTerminal (); + exit Uicommon.fatalExit))] + (fun () -> display "Do you really want to proceed? ") + end + end + end + +let synchronizeOnce() = + Trace.status "Looking for changes"; + let (reconItemList, anyEqualUpdates, dangerousPaths) = + Recon.reconcileAll (Update.findUpdates()) in + if reconItemList = [] then begin + (if anyEqualUpdates then + Trace.status ("Nothing to do: replicas have been changed only " + ^ "in identical ways since last sync.") + else + Trace.status "Nothing to do: replicas have not changed since last sync."); + (Uicommon.perfectExit, []) + end else begin + checkForDangerousPath dangerousPaths; + let (anySkipped, anyFailures, failedPaths) = + interactAndPropagateChanges reconItemList in + let exitStatus = Uicommon.exitCode(anySkipped,anyFailures) in + (exitStatus, failedPaths) + end + +let watchinterval = 10 + +(* FIX; Using string concatenation to accumulate characters is + pretty inefficient! *) +let charsRead = ref "" +let linesRead = ref [] +let watcherchan = ref None + +let suckOnWatcherFileLocal n = + Util.convertUnixErrorsToFatal + ("Reading changes from watcher process in file " ^ n) + (fun () -> + (* The main loop, invoked from two places below *) + let rec loop ch = + match try Some(input_char ch) with End_of_file -> None with + None -> + let res = !linesRead in + linesRead := []; + res + | Some(c) -> + if c = '\n' then begin + linesRead := !charsRead + :: !linesRead; + charsRead := ""; + loop ch + end else begin + charsRead := (!charsRead) ^ (String.make 1 c); + loop ch + end in + (* Make sure there's a file to watch, then read from it *) + match !watcherchan with + None -> + if Sys.file_exists n then begin + let ch = open_in n in + watcherchan := Some(ch); + loop ch + end else [] + | Some(ch) -> loop ch + ) + +let suckOnWatcherFileRoot: Common.root -> string -> (string list) Lwt.t = + Remote.registerRootCmd + "suckOnWatcherFile" + (fun (fspath, n) -> + Lwt.return (suckOnWatcherFileLocal n)) + +let suckOnWatcherFiles n = + Safelist.concat + (Lwt_unix.run ( + Globals.allRootsMap (fun r -> suckOnWatcherFileRoot r n))) + +let synchronizePathsFromFilesystemWatcher () = + let watcherfilename = "" in + (* STOPPED HERE -- need to find the program using watcherosx preference and invoke it using a redirect to get the output into a temp file... *) + let rec loop failedPaths = + let newpaths = suckOnWatcherFiles watcherfilename in + if newpaths <> [] then + display (Printf.sprintf "Changed paths:\n %s\n" + (String.concat "\n " newpaths)); + let p = failedPaths @ (Safelist.map Path.fromString newpaths) in + if p <> [] then begin + Prefs.set Globals.paths p; + let (exitStatus,newFailedPaths) = synchronizeOnce() in + debug (fun() -> Util.msg "Sleeping for %d seconds...\n" watchinterval); + Unix.sleep watchinterval; + loop newFailedPaths + end else begin + debug (fun() -> Util.msg "Nothing changed: sleeping for %d seconds...\n" + watchinterval); + Unix.sleep watchinterval; + loop [] + end in + loop [] + +let synchronizeUntilNoFailures () = + let initValueOfPathsPreference = Prefs.read Globals.paths in + let rec loop triesLeft = + let (exitStatus,failedPaths) = synchronizeOnce() in + if failedPaths <> [] && triesLeft <> 0 then begin + loop (triesLeft - 1) + end else begin + Prefs.set Globals.paths initValueOfPathsPreference; + exitStatus + end in + loop (Prefs.read Uicommon.retry) + +let rec synchronizeUntilDone () = + let repeatinterval = + if Prefs.read Uicommon.repeat = "" then -1 else + try int_of_string (Prefs.read Uicommon.repeat) + with Failure "int_of_string" -> + (* If the 'repeat' pref is not a number, switch modes... *) + if Prefs.read Uicommon.repeat = "watch" then + synchronizePathsFromFilesystemWatcher() + else + raise (Util.Fatal ("Value of 'repeat' preference (" + ^Prefs.read Uicommon.repeat + ^") should be either a number or 'watch'\n")) in + + let exitStatus = synchronizeUntilNoFailures() in + if repeatinterval < 0 then + exitStatus + else begin + (* Do it again *) + Trace.status (Printf.sprintf "\nSleeping for %d seconds...\n" repeatinterval); + Unix.sleep repeatinterval; + synchronizeUntilDone () + end + +let start _ = + begin try + (* Just to make sure something is there... *) + setWarnPrinterForInitialization(); + Uicommon.uiInit + (fun s -> Util.msg "%s\n%s\n" Uicommon.shortUsageMsg s; exit 1) + (fun s -> Util.msg "%s" Uicommon.shortUsageMsg; exit 1) + (fun () -> if not (Prefs.read silent) + then Util.msg "%s\n" (Uicommon.contactingServerMsg())) + (fun () -> Some "default") + (fun () -> Util.msg "%s" Uicommon.shortUsageMsg; exit 1) + (fun () -> Util.msg "%s" Uicommon.shortUsageMsg; exit 1) + None; + + (* Some preference settings imply others... *) + if Prefs.read silent then begin + Prefs.set Globals.batch true; + Prefs.set Trace.terse true; + Prefs.set dumbtty true; + Trace.sendLogMsgsToStderr := false; + end; + if Prefs.read Uicommon.repeat <> "" then begin + Prefs.set Globals.batch true; + end; + + (* Tell OCaml that we want to catch Control-C ourselves, so that + we get a chance to reset the terminal before exiting *) + Sys.catch_break true; + (* Put the terminal in cbreak mode if possible *) + if not (Prefs.read Globals.batch) then setupTerminal(); + setWarnPrinter(); + Trace.statusFormatter := formatStatus; + + let exitStatus = synchronizeUntilDone() in + + (* Put the terminal back in "sane" mode, if necessary, and quit. *) + restoreTerminal(); + exit exitStatus + + with + e -> + restoreTerminal(); + let msg = Uicommon.exn2string e in + Trace.log (msg ^ "\n"); + if not !Trace.sendLogMsgsToStderr then begin + alwaysDisplay "\n"; + alwaysDisplay msg; + alwaysDisplay "\n"; + end; + exit Uicommon.fatalExit + end + +let defaultUi = Uicommon.Text + +end Deleted: branches/2.32/src/uitext.mli =================================================================== --- trunk/src/uitext.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/uitext.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,4 +0,0 @@ -(* Unison file synchronizer: src/uitext.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -module Body : Uicommon.UI Copied: branches/2.32/src/uitext.mli (from rev 320, trunk/src/uitext.mli) =================================================================== --- branches/2.32/src/uitext.mli (rev 0) +++ branches/2.32/src/uitext.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,4 @@ +(* Unison file synchronizer: src/uitext.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +module Body : Uicommon.UI Deleted: branches/2.32/src/update.ml =================================================================== --- trunk/src/update.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/update.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,1931 +0,0 @@ -(* Unison file synchronizer: src/update.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -open Common -let (>>=) = Lwt.(>>=) - -let debug = Trace.debug "update" -let debugverbose = Trace.debug "update+" -let debugalias = Trace.debug "rootalias" -let debugignore = Trace.debug "ignore" - -(*****************************************************************************) -(* ARCHIVE DATATYPE *) -(*****************************************************************************) - -(* Remember to increment archiveFormat each time the representation of the - archive changes: old archives will then automatically be discarded. (We - do not use the unison version number for this because usually the archive - representation does not change between unison versions.) *) -(*FIX: Use similar_correct in props.ml next time the - format is modified (see file props.ml for the new function) *) -(*FIX: use Case.normalize next time the format is modified *) -(*FIX: also change Fileinfo.stamp to drop the info.ctime component, next time the - format is modified *) -(*FIX: also make Jerome's suggested change about file times (see his mesg in - unison-pending email folder). *) -let archiveFormat = 22 - -module NameMap = MyMap.Make (Name) - -type archive = - ArchiveDir of Props.t * archive NameMap.t - | ArchiveFile of Props.t * Os.fullfingerprint * Fileinfo.stamp * Osx.ressStamp - | ArchiveSymlink of string - | NoArchive - -(* For directories, only the permissions part of the file description (desc) - is used for synchronization at the moment. *) - -let archive2string = function - ArchiveDir(_) -> "ArchiveDir" - | ArchiveFile(_) -> "ArchiveFile" - | ArchiveSymlink(_) -> "ArchiveSymlink" - | NoArchive -> "NoArchive" - -(*****************************************************************************) -(* ARCHIVE NAMING *) -(*****************************************************************************) - -(* DETERMINING THE ARCHIVE NAME *) - -(* The canonical name of a root consists of its canonical host name and - canonical fspath. - - The canonical name of a set of roots consists of the canonical names of - the roots in sorted order. - - There is one archive for each root to be synchronized. The canonical - name of the archive is the canonical name of the root plus the canonical - name of the set of all roots to be synchronized. Because this is a long - string we store the archive in a file whose name is the hash of the - canonical archive name. - - For example, suppose we are synchronizing roots A and B, with canonical - names A' and B', where A' < B'. Then the canonical archive name for root - A is A' + A' + B', and the canonical archive name for root B is B' + A' + - B'. - - Currently, we determine A' + B' during startup and store this in the - ref cell rootsName, below. This rootsName is passed as an argument to - functions that need to determine a canonical archive name. Note, since - we have a client/server architecture, there are TWO rootsName ref cells - (one in the client's address space, one in the server's). It is vital - therefore that the rootsName be determined on the client and passed to - the server. This is not good and we should get rid of the ref cell in - the future; we have implemented it this way at first for historical - reasons. *) - -let rootsName : string Prefs.t = - Prefs.createString "rootsName" "" "*Canonical root names" "" - -let getRootsName () = Prefs.read rootsName - -let foundArchives = ref true - -(*****************************************************************************) -(* COMMON DEFINITIONS *) -(*****************************************************************************) - -let rootAliases : string list Prefs.t = - Prefs.createStringList "rootalias" - "!register alias for canonical root names" - ("When calculating the name of the archive files for a given pair of roots," - ^ " Unison replaces any roots matching the left-hand side of any rootalias" - ^ " rule by the corresponding right-hand side.") - -(* [root2stringOrAlias root] returns the string form of [root], taking into - account the preference [rootAliases], whose items are of the form ` -> - ' *) -let root2stringOrAlias (root: Common.root): string = - let r = Common.root2string root in - let aliases : (string * string) list = - Safelist.map - (fun s -> match Util.splitIntoWordsByString s " -> " with - [n;n'] -> (Util.trimWhitespace n, Util.trimWhitespace n') - | _ -> raise (Util.Fatal (Printf.sprintf - "rootalias %s should be two strings separated by ' -> '" s))) - (Prefs.read rootAliases) in - let r' = try Safelist.assoc r aliases with Not_found -> r in - if r<>r' then debugalias (fun()-> - Util.msg "Canonical root name %s is aliased to %s\n" r r'); - r' - -(* (Called from the UI startup sequence...) `normalize' root names, - sort them, get their string form, and put into the preference [rootsname] - as a comma-separated string *) -let storeRootsName () = - let n = - String.concat ", " - (Safelist.sort compare - (Safelist.map root2stringOrAlias - (Safelist.map - (function - (Common.Local,f) -> - (Common.Remote Os.myCanonicalHostName,f) - | r -> - r) - (Globals.rootsInCanonicalOrder())))) in - Prefs.set rootsName n - -(* How many characters of the filename should be used for the unique id of - the archive? On Unix systems, we use the full fingerprint (32 bytes). - On windows systems, filenames longer than 8 bytes can cause problems, so - we chop off all but the first 6 from the fingerprint. *) -let significantDigits = - match Util.osType with - `Win32 -> 6 - | `Unix -> 32 - -let thisRootsGlobalName (fspath: Fspath.t): string = - root2stringOrAlias (Common.Remote Os.myCanonicalHostName, fspath) - -(* ----- *) - -(* The status of an archive *) -type archiveVersion = MainArch | NewArch | ScratchArch | Lock - -let showArchiveName = - Prefs.createBool "showarchive" false - "!show 'true names' (for rootalias) of roots and archive" - ("When this preference is set, Unison will print out the 'true names'" - ^ "of the roots, in the same form as is expected by the {\\tt rootalias}" - ^ "preference.") - -let _ = Prefs.alias showArchiveName "showArchiveName" - -let archiveHash fspath = - (* Conjoin the canonical name of the current host and the canonical - presentation of the current fspath with the list of names/fspaths of - all the roots and the current archive format *) - let thisRoot = thisRootsGlobalName fspath in - let r = Prefs.read rootsName in - let n = Printf.sprintf "%s;%s;%d" thisRoot r archiveFormat in - let d = Fingerprint.toString (Fingerprint.string n) in - debugverbose (fun()-> Util.msg "Archive name is %s; hashcode is %s\n" n d); - if Prefs.read showArchiveName then - Util.msg "Archive name is %s; hashcode is %s\n" n d; - (String.sub d 0 significantDigits) - -(* We include the hash part of the archive name in the names of temp files - created by this run of Unison. The reason for this is that, during - update detection, we are going to silently delete any old temp files that - we find along the way, and we want to prevent ourselves from deleting - temp files belonging to other instances of Unison that may be running - in parallel, e.g. synchronizing with a different host. *) -let addHashToTempNames fspath = Os.includeInTempNames (archiveHash fspath) - -(* [archiveName fspath] returns a pair (arcName, thisRootsGlobalName) *) -let archiveName fspath (v: archiveVersion): string * string = - let n = archiveHash fspath in - let temp = match v with - MainArch -> "ar" | NewArch -> "tm" | ScratchArch -> "sc" | Lock -> "lk" - in - (Printf.sprintf "%s%s" temp n, - thisRootsGlobalName fspath) - - -(*****************************************************************************) -(* SANITY CHECKS *) -(*****************************************************************************) - -(* [checkArchive] checks the sanity of an archive, and returns its - hash-value. 'Sanity' means (1) no repeated name under any path, and (2) - 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 = - match arch with - ArchiveDir (desc, children) -> - begin match NameMap.validate children with - `Ok -> - () - | `Duplicate nm -> - raise - (Util.Fatal (Printf.sprintf - "Corrupted archive: \ - the file %s occurs twice in path %s" - (Name.toString nm) (Path.toString path))); - | `Invalid -> - raise - (Util.Fatal (Printf.sprintf - "Corrupted archive: the files are not \ - correctely ordered in directory %s" - (Path.toString path))); - end; - NameMap.fold - (fun n a h -> - Uutil.hash2 (Name.hash n) - (checkArchive false (Path.child path n) a h)) - children (Props.hash desc h) - | ArchiveFile (desc, dig, _, ress) -> - Uutil.hash2 (Hashtbl.hash dig) (Props.hash desc h) - | ArchiveSymlink content -> - Uutil.hash2 (Hashtbl.hash content) h - | NoArchive -> - 135 - -(* [archivesIdentical l] returns true if all elements in [l] are the - same and distinct from None *) -let archivesIdentical l = - match l with - h::r -> h <> None && Safelist.for_all (fun h' -> h = h') r - | _ -> true - -(*****************************************************************************) -(* LOADING AND SAVING ARCHIVES *) -(*****************************************************************************) - -(* [formatString] and [verboseArchiveName thisRoot] are the verbose forms of - archiveFormat and root names. They appear in the header of the archive - files *) -let formatString = Printf.sprintf "Unison archive format %d" archiveFormat - -let verboseArchiveName thisRoot = - Printf.sprintf "Archive for root %s synchronizing roots %s" - thisRoot (Prefs.read rootsName) - -(* Load in the archive in [fspath]; check that archiveFormat (first line) - and roots (second line) match skip the third line (time stamp), and read - in the archive *) -let loadArchiveLocal (fspath: Fspath.t) (thisRoot: string) : - (archive * int * string) option = - let f = Fspath.toString fspath in - debug (fun() -> Util.msg "Loading archive from %s\n" f); - Util.convertUnixErrorsToFatal "loading archive" (fun () -> - if Sys.file_exists f then - let c = open_in_bin f in - let header = input_line c in - (* Sanity check on archive format *) - if header<>formatString then begin - Util.warn - (Printf.sprintf - "Archive format mismatch: found\n '%s'\n\ - but expected\n '%s'.\n\ - I will delete the old archive and start from scratch.\n" - header formatString); - None - end else - let roots = input_line c in - (* Sanity check on roots. *) - if roots <> verboseArchiveName thisRoot then begin - Util.warn - (Printf.sprintf - "Archive mismatch: found\n '%s'\n\ - but expected\n '%s'.\n\ - I will delete the old archive and start from scratch.\n" - roots (verboseArchiveName thisRoot)); - None - end else - (* Throw away the timestamp line *) - let _ = input_line c in - (* Load the datastructure *) - try - let ((archive, hash, magic) : archive * int * string) = - Marshal.from_channel c in - close_in c; - Some (archive, hash, magic) - with Failure s -> raise (Util.Fatal (Printf.sprintf - "Archive file seems damaged (%s): \ - throw away archives on both machines and try again" s)) - else - (debug (fun() -> Util.msg "Archive %s not found\n" f); - None)) - -(* Inverse to loadArchiveLocal *) -let storeArchiveLocal fspath thisRoot archive hash magic = - let f = Fspath.toString fspath in - debug (fun() -> Util.msg "Saving archive in %s\n" f); - Util.convertUnixErrorsToFatal "saving archive" (fun () -> - let c = - open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_binary] 0o600 f - in - output_string c formatString; - 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()))); - Marshal.to_channel c (archive, hash, magic) [Marshal.No_sharing]; - close_out c) - -(* Remove the archieve under the root path [fspath] with archiveVersion [v] *) -let removeArchiveLocal ((fspath: Fspath.t), (v: archiveVersion)): unit Lwt.t = - Lwt.return - (let (name,_) = archiveName fspath v in - let f = Fspath.toString (Os.fileInUnisonDir name) in - debug (fun() -> Util.msg "Removing archive %s\n" f); - Util.convertUnixErrorsToFatal "removing archive" (fun () -> - if Sys.file_exists f then Sys.remove f)) - -(* [removeArchiveOnRoot root v] invokes [removeArchive fspath v] on the - server, where [fspath] is the path to root on the server *) -let removeArchiveOnRoot: Common.root -> archiveVersion -> unit Lwt.t = - Remote.registerRootCmd "removeArchive" removeArchiveLocal - -(* [commitArchive (fspath, ())] commits the archive for [fspath] by changing - the filenames from ScratchArch-ones to a NewArch-ones *) -let commitArchiveLocal ((fspath: Fspath.t), ()) - : unit Lwt.t = - Lwt.return - (let (fromname,_) = archiveName fspath ScratchArch in - let (toname,_) = archiveName fspath NewArch in - let ffrom = Fspath.toString (Os.fileInUnisonDir fromname) in - let fto = Fspath.toString (Os.fileInUnisonDir toname) in - Util.convertUnixErrorsToFatal - "committing" - (fun () -> Unix.rename ffrom fto)) - -(* [commitArchiveOnRoot root v] invokes [commitArchive fspath v] on the - server, where [fspath] is the path to root on the server *) -let commitArchiveOnRoot: Common.root -> unit -> unit Lwt.t = - Remote.registerRootCmd "commitArchive" commitArchiveLocal - -let archiveInfoCache = Hashtbl.create 7 -(* [postCommitArchive (fspath, v)] finishes the committing protocol by - copying files from NewArch-files to MainArch-files *) -let postCommitArchiveLocal (fspath,()) - : unit Lwt.t = - Lwt.return - (let (fromname,_) = archiveName fspath NewArch in - let (toname, thisRoot) = archiveName fspath MainArch in - let ffrom = Fspath.toString (Os.fileInUnisonDir fromname) in - let fto = Fspath.toString (Os.fileInUnisonDir toname) in - debug (fun() -> Util.msg "Copying archive %s to %s\n" ffrom fto); - Util.convertUnixErrorsToFatal "copying archive" (fun () -> - let outFd = - open_out_gen - [Open_wronly; Open_creat; Open_trunc; Open_binary] 0o600 fto in - Unix.chmod fto 0o600; (* In case the file already existed *) - let inFd = open_in_gen [Open_rdonly; Open_binary] 0o444 ffrom in - Uutil.readWrite inFd outFd (fun _ -> ()); - close_in inFd; - close_out outFd; - let arcFspath = Os.fileInUnisonDir toname in - let info = Fileinfo.get false arcFspath Path.empty in - Hashtbl.replace archiveInfoCache thisRoot info)) - -(* [postCommitArchiveOnRoot root v] invokes [postCommitArchive fspath v] on - the server, where [fspath] is the path to root on the server *) -let postCommitArchiveOnRoot: Common.root -> unit -> unit Lwt.t = - Remote.registerRootCmd "postCommitArchive" postCommitArchiveLocal - - -(*************************************************************************) -(* Archive cache *) -(*************************************************************************) - -(* archiveCache: map(rootGlobalName, archive) *) -let archiveCache = Hashtbl.create 7 - -(* commitAction: map(rootGlobalName * transactionId, action: unit -> unit) *) -let commitActions = Hashtbl.create 7 - -(* Retrieve an archive from the cache *) -let getArchive (thisRoot: string): archive = - Hashtbl.find archiveCache thisRoot - -(* Update the cache. *) -let setArchiveLocal (thisRoot: string) (archive: archive) = - (* Also this: *) - debug (fun () -> Printf.eprintf "Setting archive for %s\n" thisRoot); - Hashtbl.replace archiveCache thisRoot archive - -let fileUnchanged oldInfo newInfo = - oldInfo.Fileinfo.typ = `FILE && newInfo.Fileinfo.typ = `FILE - && - Props.same_time oldInfo.Fileinfo.desc newInfo.Fileinfo.desc - && - match Fileinfo.stamp oldInfo, Fileinfo.stamp newInfo with - Fileinfo.InodeStamp in1, Fileinfo.InodeStamp in2 -> in1 = in2 - | Fileinfo.CtimeStamp t1, Fileinfo.CtimeStamp t2 -> t1 = t2 - | _ -> false - -let archiveUnchanged fspath newInfo = - let (arcName, thisRoot) = archiveName fspath MainArch in - try - fileUnchanged (Hashtbl.find archiveInfoCache thisRoot) newInfo - with Not_found -> - false - -(************************************************************************* - DUMPING ARCHIVES - *************************************************************************) - -let rec showArchive = function - ArchiveDir (props, children) -> - Format.printf "Directory, %s@\n @[" (Props.syncedPartsToString props); - NameMap.iter (fun n c -> - Format.printf "%s -> @\n " (Name.toString n); - showArchive c) - children; - Format.printf "@]" - | ArchiveFile (props, fingerprint, _, _) -> - Format.printf "File, %s %s@\n" - (Props.syncedPartsToString props) - (Os.fullfingerprint_to_string fingerprint) - | ArchiveSymlink(s) -> - Format.printf "Symbolic link: %s@\n" s - | NoArchive -> - Format.printf "No archive@\n" - -let dumpArchiveLocal (fspath,()) = - let (name, root) = archiveName fspath MainArch in - let archive = getArchive root in - let f = Util.fileInHomeDir "unison.dump" in - debug (fun () -> Printf.eprintf "Dumping archive into `%s'\n" f); - let ch = open_out_gen [Open_wronly; Open_trunc; Open_creat] 0o600 f in - let (outfn,flushfn) = Format.get_formatter_output_functions () in - Format.set_formatter_out_channel ch; - Format.printf "Contents of archive for %s\n" root; - Format.printf "Written at %s\n\n" (Util.time2string (Util.time())); - showArchive archive; - Format.print_flush(); - Format.set_formatter_output_functions outfn flushfn; - flush ch; - close_out ch; - Lwt.return () - -let dumpArchiveOnRoot : Common.root -> unit -> unit Lwt.t = - Remote.registerRootCmd "dumpArchive" dumpArchiveLocal - -(*************************************************************************) -(* Loading archives *) -(*************************************************************************) - -(* Load (main) root archive and cache it on the given server *) -let loadArchiveOnRoot: Common.root -> bool -> (int * string) option Lwt.t = - Remote.registerRootCmd - "loadArchive" - (fun (fspath, optimistic) -> - let (arcName,thisRoot) = archiveName fspath MainArch in - let arcFspath = Os.fileInUnisonDir arcName in - if optimistic then begin - let (newArcName, _) = archiveName fspath NewArch in - if - (* If the archive is not in a stable state, we need to - perform archive recovery. So, the optimistic loading - fails. *) - Sys.file_exists (Fspath.toString (Os.fileInUnisonDir newArcName)) - || - let (lockFilename, _) = archiveName fspath Lock in - let lockFile = Fspath.toString (Os.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 info = Fileinfo.get false arcFspath Path.empty in - if archiveUnchanged fspath info then - (* The archive is unchanged. So, we don't need to do - anything. *) - Lwt.return (Some (0, "")) - else begin - match loadArchiveLocal arcFspath thisRoot with - Some (arch, hash, magic) -> - let info' = Fileinfo.get false arcFspath Path.empty in - if fileUnchanged info info' then begin - setArchiveLocal thisRoot arch; - Hashtbl.replace archiveInfoCache thisRoot info; - Lwt.return (Some (hash, magic)) - end else - (* The archive was modified during loading. We fail. *) - Lwt.return None - | None -> - (* No archive found *) - Lwt.return None - end - end else begin - match loadArchiveLocal arcFspath thisRoot with - Some (arch, hash, magic) -> - setArchiveLocal thisRoot arch; - let info = Fileinfo.get false arcFspath Path.empty in - Hashtbl.replace archiveInfoCache thisRoot info; - Lwt.return (Some (hash, magic)) - | None -> - (* No archive found *) - setArchiveLocal thisRoot NoArchive; - Hashtbl.remove archiveInfoCache thisRoot; - Lwt.return (Some (0, "")) - end) - -let dumpArchives = - Prefs.createBool "dumparchives" false - "*dump contents of archives just after loading" - ("When this preference is set, Unison will create a file unison.dump " - ^ "on each host, containing a text summary of the archive, immediately " - ^ "after loading it.") - -(* For all roots (local or remote), load the archive and cache *) -let loadArchives (optimistic: bool) : bool Lwt.t = - Globals.allRootsMap (fun r -> loadArchiveOnRoot r optimistic) - >>= (fun checksums -> - let identicals = archivesIdentical checksums in - if not (optimistic || identicals) then - raise (Util.Fatal( - "Internal error: On-disk archives are not identical.\n" - ^ "\n" - ^ "This can happen when both machines have the same hostname.\n" - ^ "\n" - ^ "If this is not the case and you get this message repeatedly, please:\n" - ^ " a) Send a bug report to unison-users at yahoogroups.com (you may need" - ^ " to join the group before you will be allowed to post).\n" - ^ " b) Move the archive files on each machine to some other directory\n" - ^ " (in case they may be useful for debugging).\n" - ^ " The archive files on this machine are in the directory\n" - ^ (Printf.sprintf " %s\n" (Fspath.toString Os.unisonDir)) - ^ " and have names of the form\n" - ^ " arXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX\n" - ^ " where the X's are a hexidecimal number .\n" - ^ " c) Run unison again to synchronize from scratch.\n")); - if Prefs.read dumpArchives then - Globals.allRootsMap (fun r -> dumpArchiveOnRoot r ()) - >>= (fun _ -> Lwt.return identicals) - else Lwt.return identicals) - -(* commitActions(thisRoot, id) <- action *) -let setCommitAction (thisRoot: string) (id: int) (action: unit -> unit): unit = - let key = (thisRoot, id) in - Hashtbl.add commitActions key action - -(* perform and remove the action associated with (thisRoot, id) *) -let softCommitLocal (thisRoot: string) (id: int) = - debug (fun () -> - Util.msg "Committing %d\n" id); - let key = (thisRoot, id) in - Hashtbl.find commitActions key (); - Hashtbl.remove commitActions key - -(* invoke softCommitLocal on a given root (which is possibly remote) *) -let softCommitOnRoot: Common.root -> int -> unit Lwt.t = - Remote.registerRootCmd - "softCommit" - (fun (fspath, id) -> - Lwt.return (softCommitLocal (thisRootsGlobalName fspath) id)) - -(* Commit the archive on all roots. The archive must have been updated on - all roots before that. I.e., carry out the action corresponding to [id] - on all the roots *) -let softCommit (id: int): unit Lwt.t = - Util.convertUnixErrorsToFatal "softCommit" (*XXX*) - (fun () -> - Globals.allRootsIter - (fun r -> softCommitOnRoot r id)) - -(* [rollBackLocal thisRoot id] removes the action associated with (thisRoot, - id) *) -let rollBackLocal thisRoot id = - let key = (thisRoot, id) in - try Hashtbl.remove commitActions key with Not_found -> () - -let rollBackOnRoot: Common.root -> int -> unit Lwt.t = - Remote.registerRootCmd - "rollBack" - (fun (fspath, id) -> - Lwt.return (rollBackLocal (thisRootsGlobalName fspath) id)) - -(* Rollback the archive on all roots. *) -(* I.e., remove the action associated with [id] on all roots *) -let rollBack id = - Util.convertUnixErrorsToFatal "rollBack" (*XXX*) - (fun () -> - Globals.allRootsIter - (fun r -> rollBackOnRoot r id)) - -let ids = ref 0 -let new_id () = incr ids; !ids - -type transaction = int - -(* [transaction f]: transactional execution - * [f] should take in a unique id, which it can use to `setCommitAction', - * and returns a thread. - * When the thread finishes execution, the committing action associated with - * [id] is invoked. - *) -let transaction (f: int -> unit Lwt.t): unit Lwt.t = - let id = new_id () in - Lwt.catch - (fun () -> - f id >>= (fun () -> - softCommit id)) - (fun exn -> - match exn with - Util.Transient _ -> - rollBack id >>= (fun () -> - Lwt.fail exn) - | _ -> - Lwt.fail exn) - -(*****************************************************************************) -(* Archive locking *) -(*****************************************************************************) - -let lockArchiveLocal fspath = - let (lockFilename, _) = archiveName fspath Lock in - let lockFile = Fspath.toString (Os.fileInUnisonDir lockFilename) in - if Lock.acquire lockFile then - None - else - Some (Printf.sprintf "The file %s on host %s should be deleted" - lockFile Os.myCanonicalHostName) - -let lockArchiveOnRoot: Common.root -> unit -> string option Lwt.t = - Remote.registerRootCmd - "lockArchive" (fun (fspath, ()) -> Lwt.return (lockArchiveLocal fspath)) - -let unlockArchiveLocal fspath = - Lock.release - (Fspath.toString (Os.fileInUnisonDir (fst (archiveName fspath Lock)))) - -let unlockArchiveOnRoot: Common.root -> unit -> unit Lwt.t = - Remote.registerRootCmd - "unlockArchive" - (fun (fspath, ()) -> Lwt.return (unlockArchiveLocal fspath)) - -let ignorelocks = - Prefs.createBool "ignorelocks" false - "!ignore locks left over from previous run (dangerous!)" - ("When this preference is set, Unison will ignore any lock files " - ^ "that may have been left over from a previous run of Unison that " - ^ "was interrupted while reading or writing archive files; by default, " - ^ "when Unison sees these lock files it will stop and request manual" - ^ "intervention. This " - ^ "option should be set only if you are {\\em positive} that no other " - ^ "instance of Unison might be concurrently accessing the same archive " - ^ "files (e.g., because there was only one instance of unison running " - ^ "and it has just crashed or you have just killed it). It is probably " - ^ "not a good idea to set this option in a profile: it is intended for " - ^ "command-line use.") - -let locked = ref false - -let lockArchives () = - assert (!locked = false); - Globals.allRootsMap - (fun r -> lockArchiveOnRoot r ()) >>= (fun result -> - if Safelist.exists (fun x -> x <> None) result - && not (Prefs.read ignorelocks) then begin - Globals.allRootsIter2 - (fun r st -> - match st with - None -> unlockArchiveOnRoot r () - | Some _ -> Lwt.return ()) - result >>= (fun () -> - let whatToDo = Safelist.filterMap (fun st -> st) result in - raise - (Util.Fatal - (String.concat "\n" - (["Warning: the archives are locked. "; - "If no other instance of " ^ Uutil.myName ^ " is running, \ - the locks should be removed."] - @ whatToDo @ - ["Please delete lock files as appropriate and try again."])))) - end else begin - locked := true; - Lwt.return () - end) - -let unlockArchives () = - if !locked then begin - Globals.allRootsIter (fun r -> unlockArchiveOnRoot r ()) >>= (fun () -> - locked := false; - Lwt.return ()) - end else - Lwt.return () - -(*************************************************************************) -(* CRASH RECOVERY *) -(*************************************************************************) - -(* We avoid getting into an unsafe situation if the synchronizer is - interrupted during the writing of the archive files by adopting a - simple joint commit protocol. - - The invariant that we maintain at all times is: - if all hosts have a temp archive, - then these temp archives contain coherent information - if NOT all hosts have a temp archive, - then the regular archives contain coherent information - - When we WRITE archives (markUpdated), we maintain this invariant - as follows: - - first, write all archives to a temporary filename - - then copy all the temp files to the corresponding regular archive - files - - finally, delete all the temp files - - Before we LOAD archives (findUpdates), we perform a crash recovery - procedure, in case there was a crash during any of the above operations. - - if all hosts have a temporary archive, we copy these to the - regular archive names - - otherwise, if some hosts have temporary archives, we delete them -*) - -let archivesExistOnRoot: Common.root -> unit -> (bool * bool) Lwt.t = - Remote.registerRootCmd - "archivesExist" - (fun (fspath,rootsName) -> - let (oldname,_) = archiveName fspath MainArch in - let oldexists = - Sys.file_exists (Fspath.toString (Os.fileInUnisonDir oldname)) in - let (newname,_) = archiveName fspath NewArch in - let newexists = - 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) - -let doArchiveCrashRecovery () = - (* Check which hosts have copies of the old/new archive *) - Globals.allRootsMap (fun r -> archivesExistOnRoot r ()) >>= (fun exl -> - let oldnamesExist,newnamesExist = - Safelist.split exl - in - - (* Do something with the new archives, if there are any *) - begin if forall newnamesExist then begin - (* All new versions were written: use them *) - Util.warn - (Printf.sprintf - "Warning: %s may have terminated abnormally last time.\n\ - A new archive exists on all hosts: I'll use them.\n" - Uutil.myName); - Globals.allRootsIter (fun r -> postCommitArchiveOnRoot r ()) >>= (fun () -> - Globals.allRootsIter (fun r -> removeArchiveOnRoot r NewArch)) - end else if exists newnamesExist then begin - Util.warn - (Printf.sprintf - "Warning: %s may have terminated abnormally last time.\n\ - A new archive exists on some hosts only; it will be ignored.\n" - Uutil.myName); - Globals.allRootsIter (fun r -> removeArchiveOnRoot r NewArch) - end else - Lwt.return () - end >>= (fun () -> - - (* Now verify that there are old archives on all hosts *) - if forall oldnamesExist then begin - (* We're happy *) - foundArchives := true; - Lwt.return () - end else if exists oldnamesExist then - Globals.allRootsMap - (fun r -> archiveNameOnRoot r MainArch) >>= (fun names -> - let whatToDo = - Safelist.map - (fun (name,host,exists) -> - Printf.sprintf " Archive %s on host %s %s" - name - host - (if exists then "should be DELETED" else "is MISSING")) - names in - raise - (Util.Fatal - (String.concat "\n" - (["Warning: inconsistent state. "; - "The archive file is missing on some hosts."; - "For safety, the remaining copies should be deleted."] - @ whatToDo @ - ["Please delete archive files as appropriate and try again."])))) - else begin - foundArchives := false; - let expectedRoots = - String.concat "\n\t" (Safelist.map root2string (Globals.rootsList ())) in - Util.warn - ("No archive files were found for these roots, whose canonical names are:\n\t" - ^ expectedRoots ^ "\nThis can happen either\n" - ^ "because this is the first time you have synchronized these roots, \n" - ^ "or because you have upgraded Unison to a new version with a different\n" - ^ "archive format. \n\n" - ^ "Update detection may take a while on this run if the replicas are \n" - ^ "large.\n\n" - ^ "Unison will assume that the 'last synchronized state' of both replicas\n" - ^ "was completely empty. This means that any files that are different\n" - ^ "will be reported as conflicts, and any files that exist only on one\n" - ^ "replica will be judged as new and propagated to the other replica.\n" - ^ "If the two replicas are identical, then no changes will be reported.\n\n" - ^ "If you see this message repeatedly, it may be because one of your machines\n" - ^ "is getting its address from DHCP, which is causing its host name to change\n" - ^ "between synchronizations. See the documentation for the UNISONLOCALHOSTNAME\n" - ^ "environment variable for advice on how to correct this.\n" - ^ "\n" - ^ "Donations to the Unison project are gratefully accepted: \n" - ^ "http://www.cis.upenn.edu/~bcpierce/unison\n" - ^ "\n" - (* ^ "\nThe expected archive names were:\n" ^ expectedNames *) ); - Lwt.return () - end)) - -(************************************************************************* - Update a part of an archive - *************************************************************************) - -(* perform [action] on the relative path [rest] in the archive. If it - returns [(ar, result)], then update archive with [ar] at [rest] and - return [result]. *) -let rec updatePathInArchive archive fspath - (here: Path.local) (rest: Path.t) - (action: archive -> Fspath.t -> Path.local -> archive * 'c): - archive * 'c - = - debugverbose - (fun() -> - Printf.eprintf "updatePathInArchive %s %s [%s] [%s]\n" - (archive2string archive) (Fspath.toString fspath) - (Path.toString here) (Path.toString rest)); - match Path.deconstruct rest with - None -> - action archive fspath here - | Some(name, rest') -> - let (desc, name', child, otherChildren) = - match archive with - ArchiveDir (desc, children) -> - begin try - let (name', child) = NameMap.findi name children in - (desc, name', child, NameMap.remove name children) - with Not_found -> - (desc, name, NoArchive, children) - end - | _ -> - (Props.dummy, name, NoArchive, NameMap.empty) in - match - updatePathInArchive child fspath (Path.child here name') rest' action - with - NoArchive, res -> - if otherChildren = NameMap.empty && desc == Props.dummy then - NoArchive, res - else - ArchiveDir (desc, otherChildren), res - | child, res -> - ArchiveDir (desc, NameMap.add name' child otherChildren), res - -(*************************************************************************) -(* Extract of a part of a archive *) -(*************************************************************************) - -(* Get the archive found at [rest] of [archive] *) -let rec getPathInArchive archive here rest = - match Path.deconstruct rest with - None -> - (here, archive) - | Some (name, rest') -> - let (name', child) = - match archive with - ArchiveDir (desc, children) -> - begin try - NameMap.findi name children - with Not_found -> - (name, NoArchive) - end - | _ -> - (name, NoArchive) - in - getPathInArchive child (Path.child here name') rest' - -let translatePathLocal fspath path = - let root = thisRootsGlobalName fspath in - let (localPath, _) = getPathInArchive (getArchive root) Path.empty path in - localPath - -let translatePath = - Remote.registerRootCmd "translatePath" - (fun (fspath, path) -> Lwt.return (translatePathLocal fspath path)) - -let isDir fspath path = - let fullFspath = Fspath.concat fspath path in - try - (Fspath.stat fullFspath).Unix.LargeFile.st_kind = Unix.S_DIR - with Unix.Unix_error _ -> false - -(*********************************************************************** - MOUNT POINTS -************************************************************************) - -let mountpoints = - Prefs.createStringList "mountpoint" - "!abort if this path does not exist" - ("Including the preference \\texttt{-mountpoint PATH} causes Unison to " - ^ "double-check, at the end of update detection, that \\texttt{PATH} exists " - ^ "and abort if it does not. This is useful when Unison is used to synchronize " - ^ "removable media. This preference can be given more than once. " - ^ "See \\sectionref{mountpoints}{Mount Points}.") - -let abortIfAnyMountpointsAreMissing fspath = - Safelist.iter - (fun s -> - let path = Path.fromString s in - if not (Os.exists fspath path) then - raise (Util.Fatal - (Printf.sprintf "Path %s / %s is designated as a mountpoint, but points to nothing on host %s\n" - (Fspath.toString fspath) (Path.toString path) Os.myCanonicalHostName))) - (Prefs.read mountpoints) - - -(*********************************************************************** - UPDATE DETECTION -************************************************************************) - -(* Generate a tree of changes. Also, update the archive in case some - timestamps have been changed without the files being actually updated. *) - -let fastcheck = - Prefs.createString "fastcheck" "default" - "!do fast update detection (true/false/default)" - ( "When this preference is set to \\verb|true|, \ - Unison will use the modification time and length of a file as a - `pseudo inode number' \ - when scanning replicas for updates, \ - instead of reading the full contents of every file. Under \ - Windows, this may cause Unison to miss propagating an update \ - if the modification time and length of the \ - file are both unchanged by the update. However, Unison will never \ - {\\em overwrite} such an update with a change from the other \ - replica, since it always does a safe check for updates just \ - before propagating a change. Thus, it is reasonable to use \ - this switch under Windows most of the time and occasionally \ - run Unison once with {\\tt fastcheck} set to \ - \\verb|false|, if you are \ - worried that Unison may have overlooked an update. The default \ - value of the preference is \\verb|auto|, which causes Unison to \ - use fast checking on Unix replicas (where it is safe) and slow \ - checking on Windows replicas. For backward compatibility, \ - \\verb|yes|, \\verb|no|, and \\verb|default| can be used in place \ - of \\verb|true|, \\verb|false|, and \\verb|auto|. See \ - \\sectionref{fastcheck}{Fast Checking} for more information.") - -let useFastChecking () = - (Prefs.read fastcheck = "yes") - || (Prefs.read fastcheck = "true") - || (Prefs.read fastcheck = "default" && Util.osType = `Unix) - || (Prefs.read fastcheck = "auto" && Util.osType = `Unix) - -let immutable = Pred.create "immutable" ~advanced:true - ("This preference specifies paths for directories whose \ - immediate children are all immutable files --- i.e., once a file has been \ - created, its contents never changes. When scanning for updates, \ - Unison does not check whether these files have been modified; \ - this can speed update detection significantly (in particular, for mail \ - directories).") - -let immutablenot = Pred.create "immutablenot" ~advanced:true - ("This preference overrides {\\tt immutable}.") - -(** Status display **) - -(* BCP (3/09) We used to try to be smart about showing status messages - at regular intervals, but people seem to find this confusing. - Let's replace all this with something simpler -- just show directories as - they are scanned... (but I'll leave the code in for now, in case we find - we want to restore the old behavior). *) -(* - let bigFileLength = 10 * 1024 - let bigFileLengthFS = Uutil.Filesize.ofInt bigFileLength - let smallFileLength = 1024 - let fileLength = ref 0 - let t0 = ref 0. - - (* Note that we do *not* want to do any status displays from the server - side, since this will cause the server to block until the client has - finished its own update detection and can receive and acknowledge - the status display message -- thus effectively serializing the client - and server! *) - let showStatusAddLength info = - if not !Trace.runningasserver then begin - let len1 = Props.length info.Fileinfo.desc in - let len2 = Osx.ressLength info.Fileinfo.osX.Osx.ressInfo in - if len1 >= bigFileLengthFS || len2 >= bigFileLengthFS then - fileLength := bigFileLength - else - fileLength := - min bigFileLength - (!fileLength + Uutil.Filesize.toInt len1 + Uutil.Filesize.toInt len2) - end - - let showStatus path = - if not !Trace.runningasserver then begin - fileLength := !fileLength + smallFileLength; - if !fileLength >= bigFileLength then begin - fileLength := 0; - let t = Unix.gettimeofday () in - if t -. !t0 > 0.05 then begin - Trace.statusDetail ("scanning... got to " ^ Path.toString path); - t0 := t - end - end - end -*) - -let showStatus path = () -let showStatusAddLength info = () - -let showStatusDir path = - if not !Trace.runningasserver then begin - Trace.statusDetail ("scanning... " ^ Path.toString path); - end - -(* ------- *) - -let symlinkInfo = - Common.Previous (`SYMLINK, Props.dummy, Os.fullfingerprint_dummy, Osx.ressDummy) - -let absentInfo = Common.New - -let oldInfoOf archive = - match archive with - ArchiveDir (oldDesc, _) -> - Common.Previous (`DIRECTORY, oldDesc, Os.fullfingerprint_dummy, Osx.ressDummy) - | ArchiveFile (oldDesc, dig, _, ress) -> - Common.Previous (`FILE, oldDesc, dig, ress) - | ArchiveSymlink _ -> - symlinkInfo - | NoArchive -> - absentInfo - -(* Check whether a file's permissions have not changed *) -let isPropUnchanged info archiveDesc = - Props.similar info.Fileinfo.desc archiveDesc - -(* Handle file permission change *) -let checkPropChange info archive archDesc = - if isPropUnchanged info archDesc then begin - debugverbose (fun() -> Util.msg " Unchanged file\n"); - NoUpdates - end else begin - debug (fun() -> Util.msg " File permissions updated\n"); - Updates (File (info.Fileinfo.desc, ContentsSame), - oldInfoOf archive) - end - -(* HACK: we disable fastcheck for Excel (and MPP) files on Windows, as Excel - sometimes modifies a file without updating the time stamp. *) -let excelFile path = - let s = Path.toString path in - Util.endswith s ".xls" - || Util.endswith s ".mpp" - -(* Check whether a file has changed has changed, by comparing its digest and - properties against [archDesc], [archDig], and [archStamp]. - Returns a pair (optArch, ui) where [optArch] is *not* None when the file remains - unchanged but time might be changed. [optArch] is used by [buildUpdate] - series functions to compute the _old_ archive with updated time stamp - (thus, there will no false update the next time) *) -let checkContentsChange - currfspath path info archive archDesc archDig archStamp archRess fastCheck - : archive option * Common.updateItem - = - debug (fun () -> - Util.msg "checkContentsChange: "; - begin - match archStamp with - Fileinfo.InodeStamp inode -> - (Util.msg "archStamp is inode (%d)" inode; - Util.msg " / info.inode (%d)" info.Fileinfo.inode) - | Fileinfo.CtimeStamp stamp -> - (Util.msg "archStamp is ctime (%f)" stamp; - Util.msg " / info.ctime (%f)" info.Fileinfo.ctime) - end; - Util.msg " / times: %f = %f... %b" - (Props.time archDesc) (Props.time info.Fileinfo.desc) - (Props.same_time info.Fileinfo.desc archDesc); - Util.msg " / lengths: %s - %s" - (Uutil.Filesize.toString (Props.length archDesc)) - (Uutil.Filesize.toString (Props.length info.Fileinfo.desc)); - Util.msg "\n"); - let dataClearlyUnchanged = - fastCheck - && - Props.same_time info.Fileinfo.desc archDesc - && - Props.length info.Fileinfo.desc = Props.length archDesc - && - not (excelFile path) - && - match archStamp with - Fileinfo.InodeStamp inode -> - info.Fileinfo.inode = inode - | Fileinfo.CtimeStamp ctime -> - (* BCP [Apr 07]: This doesn't work -- ctimes are unreliable - under windows. :-( - info.Fileinfo.ctime = ctime *) - true in - let ressClearlyUnchanged = - fastCheck - && - Osx.ressUnchanged archRess info.Fileinfo.osX.Osx.ressInfo - None dataClearlyUnchanged in - if dataClearlyUnchanged && ressClearlyUnchanged then begin - Xferhint.insertEntry (currfspath, path) archDig; - None, checkPropChange info archive archDesc - end else begin - debugverbose (fun() -> Util.msg " Double-check possibly updated file\n"); - showStatusAddLength info; - let (info, newDigest) = - Os.safeFingerprint currfspath path info - (if dataClearlyUnchanged then Some archDig else None) in - Xferhint.insertEntry (currfspath, path) newDigest; - debug (fun() -> Util.msg " archive digest = %s current digest = %s\n" - (Os.fullfingerprint_to_string archDig) - (Os.fullfingerprint_to_string newDigest)); - if archDig = newDigest then begin - let newprops = Props.setTime archDesc (Props.time info.Fileinfo.desc) in - let newarch = - ArchiveFile - - (newprops, archDig, Fileinfo.stamp info, Fileinfo.ressStamp info) in - debugverbose (fun() -> - Util.msg " Contents match: update archive with new time...%f\n" - (Props.time newprops)); - Some newarch, checkPropChange info archive archDesc - end else begin - debug (fun() -> Util.msg " Updated file\n"); - None, - Updates (File (info.Fileinfo.desc, - ContentsUpdated (newDigest, Fileinfo.stamp info, - Fileinfo.ressStamp info)), - oldInfoOf archive) - end - end - - -(* getChildren = childrenOf + repetition check - - Find the children of fspath+path, and return them, sorted, and - partitioned into those with case conflicts, those with illegal - cross platform filenames, and those without problems. - - Note that case conflicts and illegal filenames can only occur under Unix, - when syncing with a Windows file system. *) -let badWindowsFilenameRx = - (* FIX: This should catch all device names (like aux, con, ...). I don't - know what all the possible device names are. *) - Rx.case_insensitive - (Rx.rx "\\.*|aux|con|lpt1|prn|(.*[\000-\031\\/<>:\"|].*)") - -let isBadWindowsFilename s = - (* FIX: should also check for a max filename length, not sure how much *) - Rx.match_string badWindowsFilenameRx (Name.toString s) -let badFilename s = - (* Don't check unless we are syncing with Windows *) - Prefs.read Globals.someHostIsRunningWindows && - isBadWindowsFilename s - -let getChildren fspath path = - let children = - (* We sort them in reverse order, as findDuplicate will reverse - the list again *) - Safelist.sort (fun nm1 nm2 -> - (Name.compare nm1 nm2)) - (Os.childrenOf fspath path) in - (* If Unison overall is running in case-insensitive mode but the - local filesystem is case sensitive, then we need to check that - two local files do not have the same name modulo case... *) - (* We do it all the time, as this may happen anyway due to race - conditions... *) - let childStatus nm count = - if count > 1 then - `Dup - else if badFilename nm then - `Bad - else - `Ok - in - let rec findDuplicates' res nm count l = - match l with - [] -> - (nm, childStatus nm count) :: res - | nm' :: rem -> - if Name.eq nm nm' then - findDuplicates' res nm (count + 1) rem - else - findDuplicates' ((nm, childStatus nm count) :: res) nm' 1 rem - and findDuplicates l = - match l with - [] -> [] - | nm :: rem -> findDuplicates' [] nm 1 rem - in - findDuplicates children - -(* from a list of (name, archive) pairs {usually the items in the same - directory}, build two lists: the first a named list of the _old_ - archives, with their timestamps updated for the files whose contents - remain unchanged, the second a named list of updates; also returns - whether the directory is now empty *) -let rec buildUpdateChildren - fspath path (archChi: archive NameMap.t) fastCheck - : archive NameMap.t option * (Name.t * Common.updateItem) list * bool - = - showStatusDir path; - let t = Trace.startTimerQuietly - (Printf.sprintf "checking %s" (Path.toString path)) in - let skip = - Pred.test immutable (Path.toString path) && - not (Pred.test immutablenot (Path.toString path)) - in - let curChildren = ref (getChildren fspath path) in - let emptied = not (NameMap.is_empty archChi) && !curChildren = [] in - let updates = ref [] in - let archUpdated = ref false in - let handleChild nm archive status = - let path' = Path.child path nm in - if Globals.shouldIgnore path' then begin - debugignore (fun()->Util.msg "buildUpdateChildren: ignoring path %s\n" - (Path.toString path')); - archive - end else begin - showStatus path'; - match status with - `Ok | `Abs -> - if skip && archive <> NoArchive && status <> `Abs then begin - begin match archive with - ArchiveFile (archDesc, archDig, archStamp, archRess) -> - Xferhint.insertEntry (fspath, path') archDig - | _ -> - () - end; - archive - end else begin - let (arch,uiChild) = - buildUpdateRec archive fspath path' fastCheck in - if uiChild <> NoUpdates then - updates := (nm, uiChild) :: !updates; - match arch with - None -> archive - | Some arch -> archUpdated := true; arch - end - | `Dup -> - let uiChild = - Error - ("Two or more files on a case-sensitive system have names \ - identical except for case. They cannot be synchronized to a \ - case-insensitive file system. (" ^ - Path.toString path' ^ ")") - in - updates := (nm, uiChild) :: !updates; - archive - | `Bad -> - let uiChild = - Error ("The name of this Unix file is not allowed in Windows (" - ^ Path.toString path' ^ ")") - in - updates := (nm, uiChild) :: !updates; - archive - end - in - let rec matchChild nm archive = - match !curChildren with - [] -> - (nm, handleChild nm archive `Abs) - | (nm', st) :: rem -> - let c = Name.compare nm nm' in - if c < 0 then - (nm, handleChild nm archive `Abs) - else begin - curChildren := rem; - if c = 0 then begin - if nm <> nm' then archUpdated := true; - (nm', handleChild nm' archive st) - end else begin - let arch = handleChild nm' NoArchive st in - assert (arch = NoArchive); - matchChild nm archive - end - end - in - let newChi = NameMap.mapii matchChild archChi in - Safelist.iter - (fun (nm, st) -> - let arch = handleChild nm NoArchive st in - assert (arch = NoArchive)) - !curChildren; - Trace.showTimer t; - (* The Recon module relies on the updates to be sorted *) - ((if !archUpdated then Some newChi else None), - Safelist.rev !updates, emptied) - -and buildUpdateRec archive currfspath path fastCheck = - try - debug (fun() -> - Util.msg "buildUpdate: %s\n" - (Fspath.concatToString currfspath path)); - let info = Fileinfo.get true currfspath path in - match (info.Fileinfo.typ, archive) with - (`ABSENT, NoArchive) -> - debug (fun() -> Util.msg " buildUpdate -> Absent and no archive\n"); - None, NoUpdates - | (`ABSENT, _) -> - debug (fun() -> Util.msg " buildUpdate -> Deleted\n"); - None, Updates (Absent, oldInfoOf archive) - (* --- *) - | (`FILE, ArchiveFile (archDesc, archDig, archStamp, archRess)) -> - checkContentsChange - currfspath path info archive - archDesc archDig archStamp archRess fastCheck - | (`FILE, _) -> - debug (fun() -> Util.msg " buildUpdate -> Updated file\n"); - None, - begin - showStatusAddLength info; - let (info, dig) = Os.safeFingerprint currfspath path info None in - Xferhint.insertEntry (currfspath, path) dig; - Updates (File (info.Fileinfo.desc, - ContentsUpdated (dig, Fileinfo.stamp info, - Fileinfo.ressStamp info)), - oldInfoOf archive) - end - (* --- *) - | (`SYMLINK, ArchiveSymlink prevl) -> - let l = Os.readLink currfspath path in - debug (fun() -> - if l = prevl then - Util.msg " buildUpdate -> Symlink %s (unchanged)\n" l - else - Util.msg " buildUpdate -> Symlink %s (previously: %s)\n" l prevl); - (None, - if l = prevl then NoUpdates else - Updates (Symlink l, oldInfoOf archive)) - | (`SYMLINK, _) -> - let l = Os.readLink currfspath path in - debug (fun() -> Util.msg " buildUpdate -> New symlink %s\n" l); - None, Updates (Symlink l, oldInfoOf archive) - (* --- *) - | (`DIRECTORY, ArchiveDir (archDesc, prevChildren)) -> - debugverbose (fun() -> Util.msg " buildUpdate -> Directory\n"); - let (permchange, desc) = - if isPropUnchanged info archDesc then - (PropsSame, archDesc) - else - (PropsUpdated, info.Fileinfo.desc) in - let (newChildren, childUpdates, emptied) = - buildUpdateChildren currfspath path prevChildren fastCheck in - (begin match newChildren with - Some ch -> Some (ArchiveDir (archDesc, ch)) - | None -> None - end, - if childUpdates <> [] || permchange = PropsUpdated then - Updates (Dir (desc, childUpdates, permchange, emptied), - oldInfoOf archive) - else - NoUpdates) - | (`DIRECTORY, _) -> - debug (fun() -> Util.msg " buildUpdate -> New directory\n"); - let (newChildren, childUpdates, _) = - buildUpdateChildren currfspath path NameMap.empty fastCheck in - (* BCPFIX: This is a bit of a hack and does not really work, since - it means that we calculate the size of a directory just once and - then never update our idea of how big it is. The size should - really be recalculated when things change. *) - let newdesc = - Props.setLength info.Fileinfo.desc - (Safelist.fold_left - (fun s (_,ui) -> Uutil.Filesize.add s (uiLength ui)) - Uutil.Filesize.zero childUpdates) in - (None, - Updates (Dir (newdesc, childUpdates, PropsUpdated, false), - oldInfoOf archive)) - with - Util.Transient(s) -> None, Error(s) - -(* Compute the updates for [path] against archive. Also returns an - archive, which is the old archive with time stamps updated - appropriately (i.e., for those files whose contents remain - unchanged). *) -let rec buildUpdate archive fspath fullpath here path = - match Path.deconstruct path with - None -> - showStatus path; - let (arch, ui) = - buildUpdateRec archive fspath here (useFastChecking()) in - (begin match arch with - None -> archive - | Some arch -> arch - end, - ui) - | Some(name, path') -> - if not (isDir fspath here) then - let error = - if Path.isEmpty here then - Printf.sprintf - "path %s is not valid because the root of one of the replicas \ - is not a directory" - (Path.toString fullpath) - else - Printf.sprintf - "path %s is not valid because %s is not a directory in one of \ - the replicas" - (Path.toString fullpath) (Path.toString here) - in - (* FIX: We have to fail here (and in other error cases below) - rather than report an error for this path, which would be - more user friendly. Indeed, the archive is otherwise - modified in inconsistent way when the failure occurs only - on one replica (see at the end of this function). - A better solution should be not to put the archives in a - different state, but this is a lot more work. *) - raise (Util.Transient error) -(* (archive, Error error) *) - else - let children = getChildren fspath here in - let (name', status) = - try - Safelist.find (fun (name', _) -> Name.eq name name') children - with Not_found -> - (name, if badFilename name then `Bad else `Ok) - in - match status with - `Bad -> - raise (Util.Transient - ("The path " ^ Path.toString fullpath ^ - " is not allowed in Windows")) - | `Dup -> - raise (Util.Transient - ("The path " ^ Path.toString fullpath ^ - " is ambiguous (i.e., the name of this path or one of its " - ^ "ancestors is the same, modulo capitalization, as another " - ^ "path in a case-sensitive filesystem, and you are " - ^ "synchronizing this filesystem with a case-insensitive " - ^ "filesystem. ")) - | `Ok -> - let (desc, child, otherChildren) = - match archive with - ArchiveDir (desc, children) -> - begin try - let child = NameMap.find name children in - (desc, child, NameMap.remove name children) - with Not_found -> - (desc, NoArchive, children) - end - | _ -> - (Props.dummy, NoArchive, NameMap.empty) - in - let (arch, updates) = - buildUpdate child fspath fullpath (Path.child here name') path' - in - (* We need to put a directory in the archive here for path - translation. This is fine because we check that there - really is a directory on both replica. - Note that we may also put NoArchive deep inside an - archive... - *) - (ArchiveDir (desc, NameMap.add name' arch otherChildren), - updates) - -(* for the given path, find the archive and compute the list of update - items; as a side effect, update the local archive w.r.t. time-stamps for - unchanged files *) -let findLocal fspath pathList: Common.updateItem list = - debug (fun() -> Util.msg "findLocal %s\n" (Fspath.toString fspath)); - addHashToTempNames fspath; - (* Maybe we should remember the device number where the root lives at - the beginning of update detection, so that we can check, below, that - the device has not changed. This check allows us to abort in case - the root is on a removable device and this device gets removed during - update detection, causing all the files to appear to have been - deleted. --BCP 2006 *) - let (arcName,thisRoot) = archiveName fspath MainArch in - let archive = getArchive thisRoot in - let (archive, updates) = - Safelist.fold_right - (fun path (arch, upd) -> - if Globals.shouldIgnore path then - (arch, NoUpdates :: upd) - else - let (arch', ui) = - buildUpdate arch fspath path Path.empty path - in - arch', ui :: upd) - pathList (archive, []) - in - setArchiveLocal thisRoot archive; - abortIfAnyMountpointsAreMissing fspath; - updates - -let findOnRoot = - Remote.registerRootCmd - "find" - (fun (fspath, pathList) -> - Lwt.return (findLocal fspath pathList)) - -let findUpdatesOnPaths pathList : Common.updateItem list Common.oneperpath = - Lwt_unix.run - (loadArchives true >>= (fun ok -> - begin if ok then Lwt.return () else begin - lockArchives () >>= (fun () -> - Remote.Thread.unwindProtect - (fun () -> - doArchiveCrashRecovery () >>= (fun () -> - loadArchives false)) - (fun _ -> - unlockArchives ()) >>= (fun _ -> - unlockArchives ())) - end end >>= (fun () -> - let t = Trace.startTimer "Collecting changes" in - Globals.allRootsMapWithWaitingAction (fun r -> - debug (fun() -> Util.msg "findOnRoot %s\n" (root2string r)); - findOnRoot r pathList) - (fun (host, _) -> - begin match host with - Remote(_) -> Trace.statusDetail "Waiting for changes from server" - | _ -> () - end) - >>= (fun updates -> - Trace.showTimer t; - let result = Safelist.transpose updates in - Trace.status ""; - Lwt.return (ONEPERPATH(result)))))) - -let findUpdates () : Common.updateItem list Common.oneperpath = - (* TODO: We should filter the paths to remove duplicates (including prefixes) - and ignored paths *) -(* FIX: The following line can be deleted -- it's just for debugging *) -debug (fun() -> Util.msg "Running bogus external program\n"); -let _ = External.runExternalProgram "dir" in -debug (fun() -> Util.msg "Finished running bogus external program\n"); - findUpdatesOnPaths (Prefs.read Globals.paths) - - -(*****************************************************************************) -(* Committing updates to disk *) -(*****************************************************************************) - -(* To prepare for committing, write to Scratch Archive *) -let prepareCommitLocal (fspath, magic) = - let (newName, root) = archiveName fspath ScratchArch in - let archive = getArchive root in - (** - :ZheDebug: - Format.set_formatter_out_channel stdout; - Format.printf "prepareCommitLocal: %s\n" (thisRootsGlobalName fspath); - showArchive archive; - Format.print_flush(); - **) - let archiveHash = checkArchive true Path.empty archive 0 in - storeArchiveLocal - (Os.fileInUnisonDir newName) root archive archiveHash magic; - Lwt.return (Some archiveHash) - -let prepareCommitOnRoot - = Remote.registerRootCmd "prepareCommit" prepareCommitLocal - -(* To really commit, first prepare (write to scratch arch.), then make sure - the checksum on all archives are equal, finally flip scratch to main. In - the event of checksum mismatch, dump archives on all roots and fail *) -let commitUpdates () = - Lwt_unix.run - (debug (fun() -> Util.msg "Updating archives\n"); - lockArchives () >>= (fun () -> - Remote.Thread.unwindProtect - (fun () -> - let magic = - Format.sprintf "%.f.%d" (Unix.gettimeofday ()) (Unix.getpid ()) - in - Globals.allRootsMap (fun r -> prepareCommitOnRoot r magic) - >>= (fun checksums -> - if archivesIdentical checksums then begin - (* Move scratch archives to new *) - Globals.allRootsIter (fun r -> commitArchiveOnRoot r ()) - >>= (fun () -> - (* Copy new to main *) - Globals.allRootsIter (fun r -> postCommitArchiveOnRoot r ()) - >>= (fun () -> - (* Clean up *) - Globals.allRootsIter - (fun r -> removeArchiveOnRoot r NewArch))) - end else begin - unlockArchives () >>= (fun () -> - Util.msg "Dumping archives to ~/unison.dump on both hosts\n"; - Globals.allRootsIter (fun r -> dumpArchiveOnRoot r ()) - >>= (fun () -> - Util.msg "Finished dumping archives\n"; - raise (Util.Fatal ( - "Internal error: New archives are not identical.\n" - ^ "Retaining original archives. " - ^ "Please run Unison again to bring them up to date.\n" - (* - ^ "If you get this message, please \n " - ^ " a) notify unison-help at cis.upenn.edu\n" - ^ " b) send us the contents of the file unison.dump \n" - ^ " from both hosts (or just do a 'diff'\n" - ^ " on these files and tell us what the differences\n" - ^ " look like)\n" *) - )))) - end)) - (fun _ -> unlockArchives ()) >>= (fun () -> - unlockArchives ()))) - -(*****************************************************************************) -(* MARKING UPDATES *) -(*****************************************************************************) - -(* the result of patching [archive] using [ui] *) -let rec updateArchiveRec ui archive = - match ui with - NoUpdates | Error _ -> - archive - | Updates (uc, _) -> - match uc with - Absent -> - NoArchive - | File (desc, ContentsSame) -> - begin match archive with - ArchiveFile (_, dig, stamp, ress) -> - ArchiveFile (desc, dig, stamp, ress) - | _ -> - assert false - end - | File (desc, ContentsUpdated (dig, stamp, ress)) -> - ArchiveFile (desc, dig, stamp, ress) - | Symlink l -> - ArchiveSymlink l - | Dir (desc, children, _, _) -> - begin match archive with - ArchiveDir (_, arcCh) -> - let ch = - Safelist.fold_right - (fun (nm, uiChild) ch -> - let ch' = NameMap.remove nm ch in - let child = - try NameMap.find nm ch with Not_found -> NoArchive in - match updateArchiveRec uiChild child with - NoArchive -> ch' - | arch -> NameMap.add nm arch ch') - children arcCh in - ArchiveDir (desc, ch) - | _ -> - ArchiveDir - (desc, - Safelist.fold_right - (fun (nm, uiChild) ch -> - match updateArchiveRec uiChild NoArchive with - NoArchive -> ch - | arch -> NameMap.add nm arch ch) - children NameMap.empty) - end - -(* Remove ignored files and properties that are not synchronized *) -let rec stripArchive path arch = - if Globals.shouldIgnore path then NoArchive else - match arch with - ArchiveDir (desc, children) -> - ArchiveDir - (Props.strip desc, - NameMap.fold - (fun nm ar ch -> - match stripArchive (Path.child path nm) ar with - NoArchive -> ch - | ar' -> NameMap.add nm ar' ch) - children NameMap.empty) - | ArchiveFile (desc, dig, stamp, ress) -> - ArchiveFile (Props.strip desc, dig, stamp, ress) - | ArchiveSymlink _ | NoArchive -> - arch - -let updateArchiveLocal fspath path ui id = - debug (fun() -> - Util.msg "updateArchiveLocal %s %s\n" - (Fspath.toString fspath) (Path.toString path)); - let root = thisRootsGlobalName fspath in - let archive = getArchive root in - let (localPath, subArch) = getPathInArchive archive Path.empty path in - let newArch = updateArchiveRec ui (stripArchive path subArch) in - let commit () = - let _ = Stasher.stashCurrentVersion fspath localPath None in - let archive = getArchive root in - let archive, () = - updatePathInArchive archive fspath Path.empty path - (fun _ _ _ -> newArch, ()) in - setArchiveLocal root archive in - setCommitAction root id commit; - debug (fun() -> - Util.msg "updateArchiveLocal --> %s\n" (Path.toString localPath)); - (localPath, newArch) - -let updateArchiveOnRoot = - Remote.registerRootCmd - "updateArchive" - (fun (fspath, (path, ui, id)) -> - Lwt.return (updateArchiveLocal fspath path ui id)) - -let updateArchive root path ui id = - updateArchiveOnRoot root (path, ui, id) - -(* This function is called for files changed only in identical ways. - It only updates the archives and perhaps makes backups. *) -let markEqualLocal fspath paths = - let root = thisRootsGlobalName fspath in - let archive = ref (getArchive root) in - Tree.iteri paths Path.empty Path.child - (fun path uc -> - debug (fun() -> - Util.msg "markEqualLocal %s %s\n" - (Fspath.toString fspath) (Path.toString path)); - let arch, (subArch, localPath) = - updatePathInArchive !archive fspath Path.empty path - (fun archive _ localPath -> - let arch = updateArchiveRec (Updates (uc, New)) archive in - arch, (arch, localPath)) - in - Stasher.stashCurrentVersion fspath localPath None; - archive := arch); - setArchiveLocal root !archive - -let markEqualOnRoot = - Remote.registerRootCmd - "markEqual" - (fun (fspath, paths) -> markEqualLocal fspath paths; Lwt.return ()) - -let markEqual equals = - debug (fun()-> Util.msg "Marking %d paths equal\n" (Tree.size equals)); - if not (Tree.is_empty equals) then begin - Lwt_unix.run - (Globals.allRootsIter2 - markEqualOnRoot - [Tree.map (fun n -> n) (fun (uc1,uc2) -> uc1) equals; - Tree.map (fun n -> n) (fun (uc1,uc2) -> uc2) equals]) - end - -let rec replaceArchiveRec fspath path arch paranoid deleteBadTempFiles = - match arch with - ArchiveDir (desc, children) -> - ArchiveDir (desc, - NameMap.mapi - (fun nm a -> - replaceArchiveRec - fspath (Path.child path nm) a paranoid deleteBadTempFiles) - children) - | ArchiveFile (desc, dig, stamp, ress) -> - if paranoid then begin - (* Paranoid check: recompute the file's digest to match it with - the archive's *) - let info = Fileinfo.get false fspath path in - let dig' = Os.fingerprint fspath path info in - let ress' = Osx.stamp info.Fileinfo.osX in - if dig' <> dig then begin - let savepath = Path.addSuffixToFinalName path "-bad" in - (* if deleteBadTempFiles then Os.delete fspath path; *) - if deleteBadTempFiles then - Os.rename "save temp" fspath path fspath savepath; - raise (Util.Transient (Printf.sprintf - "The file %s was incorrectly transferred (fingerprint mismatch in %s)%s" - (Path.toString path) - (Os.reasonForFingerprintMismatch dig dig') - (if deleteBadTempFiles - then " -- temp file saved as" ^ Path.toString savepath - else ""))); - end; - ArchiveFile (Props.override info.Fileinfo.desc desc, - dig, Fileinfo.stamp info, ress') - end else begin - ArchiveFile (desc, dig, stamp, ress) - end - | ArchiveSymlink l -> - ArchiveSymlink l - | NoArchive -> - arch - -let replaceArchiveLocal fspath pathTo location arch id paranoid deleteBadTempFiles = - debug (fun() -> Util.msg - "replaceArchiveLocal %s %s\n" - (Fspath.toString fspath) - (Path.toString pathTo) - ); - let root = thisRootsGlobalName fspath in - let localPath = translatePathLocal fspath pathTo in - let (workingDir, tempPathTo) = - match location with - None -> (fspath, localPath) - | Some loc -> loc - in - let newArch = - replaceArchiveRec workingDir tempPathTo arch paranoid deleteBadTempFiles in - let commit () = - debug (fun() -> Util.msg "replaceArchiveLocal: committing\n"); - let _ = Stasher.stashCurrentVersion fspath localPath (Some tempPathTo) in - let archive = getArchive root in - let archive, () = - updatePathInArchive archive fspath Path.empty pathTo - (fun _ _ _ -> newArch, ()) - in - setArchiveLocal root archive - in - setCommitAction root id commit; - localPath - -let replaceArchiveOnRoot = - Remote.registerRootCmd - "replaceArchive" - (fun (fspath, (pathTo, location, arch, id, paranoid, deleteBadTempFiles)) -> - Lwt.return (replaceArchiveLocal fspath pathTo location arch - id paranoid deleteBadTempFiles)) - -let replaceArchive root pathTo location archive id paranoid deleteBadTempFiles = - replaceArchiveOnRoot root - (pathTo, location, archive, id, paranoid, deleteBadTempFiles) - -(* Update the archive to reflect - - the last observed state of the file on disk (ui) - - the permission bits that have been propagated from the other - replica, if any (permOpt) *) -let doUpdateProps arch propOpt ui = - let newArch = - match ui with - Updates (File (desc, ContentsSame), _) -> - begin match arch with - ArchiveFile (_, dig, stamp, ress) -> - ArchiveFile (desc, dig, stamp, ress) - | _ -> - assert false - end - | Updates (File (desc, ContentsUpdated (dig, stamp, ress)), _) -> - ArchiveFile(desc, dig, stamp, ress) - | Updates (Dir (desc, _, _, _), _) -> - begin match arch with - ArchiveDir (_, children) -> ArchiveDir (desc, children) - | _ -> ArchiveDir (desc, NameMap.empty) - end - | NoUpdates -> - arch - | Updates _ | Error _ -> - assert false - in - match propOpt with - Some desc' -> - begin match newArch with - ArchiveFile (desc, dig, stamp, ress) -> - ArchiveFile (Props.override desc desc', dig, stamp, ress) - | ArchiveDir (desc, children) -> - ArchiveDir (Props.override desc desc', children) - | _ -> - assert false - end - | None -> newArch - -let updatePropsLocal fspath path propOpt ui id = - debug (fun() -> - Util.msg "updatePropsLocal %s %s\n" - (Fspath.toString fspath) (Path.toString path)); - let root = thisRootsGlobalName fspath in - let commit () = - let archive = getArchive root in - let archive, () = - updatePathInArchive archive fspath Path.empty path - (fun arch _ _ -> doUpdateProps arch propOpt ui, ()) in - setArchiveLocal root archive in - setCommitAction root id commit; - let localPath = translatePathLocal fspath path in - localPath - -let updatePropsOnRoot = - Remote.registerRootCmd - "updateProps" - (fun (fspath, (path, propOpt, ui, id)) -> - Lwt.return (updatePropsLocal fspath path propOpt ui id)) - -let updateProps root path propOpt ui id = - updatePropsOnRoot root (path, propOpt, ui, id) - -(*************************************************************************) -(* Make sure no change has happened *) -(*************************************************************************) - -let checkNoUpdatesLocal fspath pathInArchive ui = - debug (fun() -> - Util.msg "checkNoUpdatesLocal %s %s\n" - (Fspath.toString fspath) (Path.toString pathInArchive)); - let archive = getArchive (thisRootsGlobalName fspath) in - let (localPath, archive) = - getPathInArchive archive Path.empty pathInArchive in - (* Update the original archive to reflect what we believe is the current - state of the replica... *) - let archive = updateArchiveRec ui archive in - (* ...and check that this is a good description of what's out in the world *) - let (_, uiNew) = buildUpdateRec archive fspath localPath false in - if uiNew <> NoUpdates then - raise (Util.Transient ( - "Destination updated during synchronization\n" - ^ (if useFastChecking() then - " (if this happens repeatedly on a file that has not been changed, \n" - ^ " try running once with 'fastcheck' set to false)" - else ""))) - -let checkNoUpdatesOnRoot = - Remote.registerRootCmd - "checkNoUpdates" - (fun (fspath, (pathInArchive, ui)) -> - Lwt.return (checkNoUpdatesLocal fspath pathInArchive ui)) - -let checkNoUpdates root pathInArchive ui = - checkNoUpdatesOnRoot root (pathInArchive, ui) Copied: branches/2.32/src/update.ml (from rev 320, trunk/src/update.ml) =================================================================== --- branches/2.32/src/update.ml (rev 0) +++ branches/2.32/src/update.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,1946 @@ +(* Unison file synchronizer: src/update.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +open Common +let (>>=) = Lwt.(>>=) + +let debug = Trace.debug "update" +let debugverbose = Trace.debug "update+" +let debugalias = Trace.debug "rootalias" +let debugignore = Trace.debug "ignore" + +(*****************************************************************************) +(* ARCHIVE DATATYPE *) +(*****************************************************************************) + +(* Remember to increment archiveFormat each time the representation of the + archive changes: old archives will then automatically be discarded. (We + do not use the unison version number for this because usually the archive + representation does not change between unison versions.) *) +(*FIX: Use similar_correct in props.ml next time the + format is modified (see file props.ml for the new function) *) +(*FIX: use Case.normalize next time the format is modified *) +(*FIX: also change Fileinfo.stamp to drop the info.ctime component, next time the + format is modified *) +(*FIX: also make Jerome's suggested change about file times (see his mesg in + unison-pending email folder). *) +let archiveFormat = 22 + +module NameMap = MyMap.Make (Name) + +type archive = + ArchiveDir of Props.t * archive NameMap.t + | ArchiveFile of Props.t * Os.fullfingerprint * Fileinfo.stamp * Osx.ressStamp + | ArchiveSymlink of string + | NoArchive + +(* For directories, only the permissions part of the file description (desc) + is used for synchronization at the moment. *) + +let archive2string = function + ArchiveDir(_) -> "ArchiveDir" + | ArchiveFile(_) -> "ArchiveFile" + | ArchiveSymlink(_) -> "ArchiveSymlink" + | NoArchive -> "NoArchive" + +(*****************************************************************************) +(* ARCHIVE NAMING *) +(*****************************************************************************) + +(* DETERMINING THE ARCHIVE NAME *) + +(* The canonical name of a root consists of its canonical host name and + canonical fspath. + + The canonical name of a set of roots consists of the canonical names of + the roots in sorted order. + + There is one archive for each root to be synchronized. The canonical + name of the archive is the canonical name of the root plus the canonical + name of the set of all roots to be synchronized. Because this is a long + string we store the archive in a file whose name is the hash of the + canonical archive name. + + For example, suppose we are synchronizing roots A and B, with canonical + names A' and B', where A' < B'. Then the canonical archive name for root + A is A' + A' + B', and the canonical archive name for root B is B' + A' + + B'. + + Currently, we determine A' + B' during startup and store this in the + ref cell rootsName, below. This rootsName is passed as an argument to + functions that need to determine a canonical archive name. Note, since + we have a client/server architecture, there are TWO rootsName ref cells + (one in the client's address space, one in the server's). It is vital + therefore that the rootsName be determined on the client and passed to + the server. This is not good and we should get rid of the ref cell in + the future; we have implemented it this way at first for historical + reasons. *) + +let rootsName : string Prefs.t = + Prefs.createString "rootsName" "" "*Canonical root names" "" + +let getRootsName () = Prefs.read rootsName + +let foundArchives = ref true + +(*****************************************************************************) +(* COMMON DEFINITIONS *) +(*****************************************************************************) + +let rootAliases : string list Prefs.t = + Prefs.createStringList "rootalias" + "!register alias for canonical root names" + ("When calculating the name of the archive files for a given pair of roots," + ^ " Unison replaces any roots matching the left-hand side of any rootalias" + ^ " rule by the corresponding right-hand side.") + +(* [root2stringOrAlias root] returns the string form of [root], taking into + account the preference [rootAliases], whose items are of the form ` -> + ' *) +let root2stringOrAlias (root: Common.root): string = + let r = Common.root2string root in + let aliases : (string * string) list = + Safelist.map + (fun s -> match Util.splitIntoWordsByString s " -> " with + [n;n'] -> (Util.trimWhitespace n, Util.trimWhitespace n') + | _ -> raise (Util.Fatal (Printf.sprintf + "rootalias %s should be two strings separated by ' -> '" s))) + (Prefs.read rootAliases) in + let r' = try Safelist.assoc r aliases with Not_found -> r in + if r<>r' then debugalias (fun()-> + Util.msg "Canonical root name %s is aliased to %s\n" r r'); + r' + +(* (Called from the UI startup sequence...) `normalize' root names, + sort them, get their string form, and put into the preference [rootsname] + as a comma-separated string *) +let storeRootsName () = + let n = + String.concat ", " + (Safelist.sort compare + (Safelist.map root2stringOrAlias + (Safelist.map + (function + (Common.Local,f) -> + (Common.Remote Os.myCanonicalHostName,f) + | r -> + r) + (Globals.rootsInCanonicalOrder())))) in + Prefs.set rootsName n + +(* How many characters of the filename should be used for the unique id of + the archive? On Unix systems, we use the full fingerprint (32 bytes). + On windows systems, filenames longer than 8 bytes can cause problems, so + we chop off all but the first 6 from the fingerprint. *) +let significantDigits = + match Util.osType with + `Win32 -> 6 + | `Unix -> 32 + +let thisRootsGlobalName (fspath: Fspath.t): string = + root2stringOrAlias (Common.Remote Os.myCanonicalHostName, fspath) + +(* ----- *) + +(* The status of an archive *) +type archiveVersion = MainArch | NewArch | ScratchArch | Lock + +let showArchiveName = + Prefs.createBool "showarchive" false + "!show 'true names' (for rootalias) of roots and archive" + ("When this preference is set, Unison will print out the 'true names'" + ^ "of the roots, in the same form as is expected by the {\\tt rootalias}" + ^ "preference.") + +let _ = Prefs.alias showArchiveName "showArchiveName" + +let archiveHash fspath = + (* Conjoin the canonical name of the current host and the canonical + presentation of the current fspath with the list of names/fspaths of + all the roots and the current archive format *) + let thisRoot = thisRootsGlobalName fspath in + let r = Prefs.read rootsName in + let n = Printf.sprintf "%s;%s;%d" thisRoot r archiveFormat in + let d = Fingerprint.toString (Fingerprint.string n) in + debugverbose (fun()-> Util.msg "Archive name is %s; hashcode is %s\n" n d); + if Prefs.read showArchiveName then + Util.msg "Archive name is %s; hashcode is %s\n" n d; + (String.sub d 0 significantDigits) + +(* We include the hash part of the archive name in the names of temp files + created by this run of Unison. The reason for this is that, during + update detection, we are going to silently delete any old temp files that + we find along the way, and we want to prevent ourselves from deleting + temp files belonging to other instances of Unison that may be running + in parallel, e.g. synchronizing with a different host. *) +let addHashToTempNames fspath = Os.includeInTempNames (archiveHash fspath) + +(* [archiveName fspath] returns a pair (arcName, thisRootsGlobalName) *) +let archiveName fspath (v: archiveVersion): string * string = + let n = archiveHash fspath in + let temp = match v with + MainArch -> "ar" | NewArch -> "tm" | ScratchArch -> "sc" | Lock -> "lk" + in + (Printf.sprintf "%s%s" temp n, + thisRootsGlobalName fspath) + + +(*****************************************************************************) +(* SANITY CHECKS *) +(*****************************************************************************) + +(* [checkArchive] checks the sanity of an archive, and returns its + hash-value. 'Sanity' means (1) no repeated name under any path, and (2) + 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 = + match arch with + ArchiveDir (desc, children) -> + begin match NameMap.validate children with + `Ok -> + () + | `Duplicate nm -> + raise + (Util.Fatal (Printf.sprintf + "Corrupted archive: \ + the file %s occurs twice in path %s" + (Name.toString nm) (Path.toString path))); + | `Invalid -> + raise + (Util.Fatal (Printf.sprintf + "Corrupted archive: the files are not \ + correctely ordered in directory %s" + (Path.toString path))); + end; + NameMap.fold + (fun n a h -> + Uutil.hash2 (Name.hash n) + (checkArchive false (Path.child path n) a h)) + children (Props.hash desc h) + | ArchiveFile (desc, dig, _, ress) -> + Uutil.hash2 (Hashtbl.hash dig) (Props.hash desc h) + | ArchiveSymlink content -> + Uutil.hash2 (Hashtbl.hash content) h + | NoArchive -> + 135 + +(* [archivesIdentical l] returns true if all elements in [l] are the + same and distinct from None *) +let archivesIdentical l = + match l with + h::r -> h <> None && Safelist.for_all (fun h' -> h = h') r + | _ -> true + +(*****************************************************************************) +(* LOADING AND SAVING ARCHIVES *) +(*****************************************************************************) + +(* [formatString] and [verboseArchiveName thisRoot] are the verbose forms of + archiveFormat and root names. They appear in the header of the archive + files *) +let formatString = Printf.sprintf "Unison archive format %d" archiveFormat + +let verboseArchiveName thisRoot = + Printf.sprintf "Archive for root %s synchronizing roots %s" + thisRoot (Prefs.read rootsName) + +(* Load in the archive in [fspath]; check that archiveFormat (first line) + and roots (second line) match skip the third line (time stamp), and read + in the archive *) +let loadArchiveLocal (fspath: Fspath.t) (thisRoot: string) : + (archive * int * string) option = + let f = Fspath.toString fspath in + debug (fun() -> Util.msg "Loading archive from %s\n" f); + Util.convertUnixErrorsToFatal "loading archive" (fun () -> + if Sys.file_exists f then + let c = open_in_bin f in + let header = input_line c in + (* Sanity check on archive format *) + if header<>formatString then begin + Util.warn + (Printf.sprintf + "Archive format mismatch: found\n '%s'\n\ + but expected\n '%s'.\n\ + I will delete the old archive and start from scratch.\n" + header formatString); + None + end else + let roots = input_line c in + (* Sanity check on roots. *) + if roots <> verboseArchiveName thisRoot then begin + Util.warn + (Printf.sprintf + "Archive mismatch: found\n '%s'\n\ + but expected\n '%s'.\n\ + I will delete the old archive and start from scratch.\n" + roots (verboseArchiveName thisRoot)); + None + end else + (* Throw away the timestamp line *) + let _ = input_line c in + (* Load the datastructure *) + try + let ((archive, hash, magic) : archive * int * string) = + Marshal.from_channel c in + close_in c; + Some (archive, hash, magic) + with Failure s -> raise (Util.Fatal (Printf.sprintf + "Archive file seems damaged (%s): \ + throw away archives on both machines and try again" s)) + else + (debug (fun() -> Util.msg "Archive %s not found\n" f); + None)) + +(* Inverse to loadArchiveLocal *) +let storeArchiveLocal fspath thisRoot archive hash magic = + let f = Fspath.toString fspath in + debug (fun() -> Util.msg "Saving archive in %s\n" f); + Util.convertUnixErrorsToFatal "saving archive" (fun () -> + let c = + open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_binary] 0o600 f + in + output_string c formatString; + 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()))); + Marshal.to_channel c (archive, hash, magic) [Marshal.No_sharing]; + close_out c) + +(* Remove the archieve under the root path [fspath] with archiveVersion [v] *) +let removeArchiveLocal ((fspath: Fspath.t), (v: archiveVersion)): unit Lwt.t = + Lwt.return + (let (name,_) = archiveName fspath v in + let f = Fspath.toString (Os.fileInUnisonDir name) in + debug (fun() -> Util.msg "Removing archive %s\n" f); + Util.convertUnixErrorsToFatal "removing archive" (fun () -> + if Sys.file_exists f then Sys.remove f)) + +(* [removeArchiveOnRoot root v] invokes [removeArchive fspath v] on the + server, where [fspath] is the path to root on the server *) +let removeArchiveOnRoot: Common.root -> archiveVersion -> unit Lwt.t = + Remote.registerRootCmd "removeArchive" removeArchiveLocal + +(* [commitArchive (fspath, ())] commits the archive for [fspath] by changing + the filenames from ScratchArch-ones to a NewArch-ones *) +let commitArchiveLocal ((fspath: Fspath.t), ()) + : unit Lwt.t = + Lwt.return + (let (fromname,_) = archiveName fspath ScratchArch in + let (toname,_) = archiveName fspath NewArch in + let ffrom = Fspath.toString (Os.fileInUnisonDir fromname) in + let fto = Fspath.toString (Os.fileInUnisonDir toname) in + Util.convertUnixErrorsToFatal + "committing" + (fun () -> Unix.rename ffrom fto)) + +(* [commitArchiveOnRoot root v] invokes [commitArchive fspath v] on the + server, where [fspath] is the path to root on the server *) +let commitArchiveOnRoot: Common.root -> unit -> unit Lwt.t = + Remote.registerRootCmd "commitArchive" commitArchiveLocal + +let archiveInfoCache = Hashtbl.create 7 +(* [postCommitArchive (fspath, v)] finishes the committing protocol by + copying files from NewArch-files to MainArch-files *) +let postCommitArchiveLocal (fspath,()) + : unit Lwt.t = + Lwt.return + (let (fromname,_) = archiveName fspath NewArch in + let (toname, thisRoot) = archiveName fspath MainArch in + let ffrom = Fspath.toString (Os.fileInUnisonDir fromname) in + let fto = Fspath.toString (Os.fileInUnisonDir toname) in + debug (fun() -> Util.msg "Copying archive %s to %s\n" ffrom fto); + Util.convertUnixErrorsToFatal "copying archive" (fun () -> + let outFd = + open_out_gen + [Open_wronly; Open_creat; Open_trunc; Open_binary] 0o600 fto in + Unix.chmod fto 0o600; (* In case the file already existed *) + let inFd = open_in_gen [Open_rdonly; Open_binary] 0o444 ffrom in + Uutil.readWrite inFd outFd (fun _ -> ()); + close_in inFd; + close_out outFd; + let arcFspath = Os.fileInUnisonDir toname in + let info = Fileinfo.get false arcFspath Path.empty in + Hashtbl.replace archiveInfoCache thisRoot info)) + +(* [postCommitArchiveOnRoot root v] invokes [postCommitArchive fspath v] on + the server, where [fspath] is the path to root on the server *) +let postCommitArchiveOnRoot: Common.root -> unit -> unit Lwt.t = + Remote.registerRootCmd "postCommitArchive" postCommitArchiveLocal + + +(*************************************************************************) +(* Archive cache *) +(*************************************************************************) + +(* archiveCache: map(rootGlobalName, archive) *) +let archiveCache = Hashtbl.create 7 + +(* commitAction: map(rootGlobalName * transactionId, action: unit -> unit) *) +let commitActions = Hashtbl.create 7 + +(* Retrieve an archive from the cache *) +let getArchive (thisRoot: string): archive = + Hashtbl.find archiveCache thisRoot + +(* Update the cache. *) +let setArchiveLocal (thisRoot: string) (archive: archive) = + (* Also this: *) + debug (fun () -> Printf.eprintf "Setting archive for %s\n" thisRoot); + Hashtbl.replace archiveCache thisRoot archive + +let fileUnchanged oldInfo newInfo = + oldInfo.Fileinfo.typ = `FILE && newInfo.Fileinfo.typ = `FILE + && + Props.same_time oldInfo.Fileinfo.desc newInfo.Fileinfo.desc + && + match Fileinfo.stamp oldInfo, Fileinfo.stamp newInfo with + Fileinfo.InodeStamp in1, Fileinfo.InodeStamp in2 -> in1 = in2 + | Fileinfo.CtimeStamp t1, Fileinfo.CtimeStamp t2 -> t1 = t2 + | _ -> false + +let archiveUnchanged fspath newInfo = + let (arcName, thisRoot) = archiveName fspath MainArch in + try + fileUnchanged (Hashtbl.find archiveInfoCache thisRoot) newInfo + with Not_found -> + false + +(************************************************************************* + DUMPING ARCHIVES + *************************************************************************) + +let rec showArchive = function + ArchiveDir (props, children) -> + Format.printf "Directory, %s@\n @[" (Props.syncedPartsToString props); + NameMap.iter (fun n c -> + Format.printf "%s -> @\n " (Name.toString n); + showArchive c) + children; + Format.printf "@]" + | ArchiveFile (props, fingerprint, _, _) -> + Format.printf "File, %s %s@\n" + (Props.syncedPartsToString props) + (Os.fullfingerprint_to_string fingerprint) + | ArchiveSymlink(s) -> + Format.printf "Symbolic link: %s@\n" s + | NoArchive -> + Format.printf "No archive@\n" + +let dumpArchiveLocal (fspath,()) = + let (name, root) = archiveName fspath MainArch in + let archive = getArchive root in + let f = Util.fileInHomeDir "unison.dump" in + debug (fun () -> Printf.eprintf "Dumping archive into `%s'\n" f); + let ch = open_out_gen [Open_wronly; Open_trunc; Open_creat] 0o600 f in + let (outfn,flushfn) = Format.get_formatter_output_functions () in + Format.set_formatter_out_channel ch; + Format.printf "Contents of archive for %s\n" root; + Format.printf "Written at %s\n\n" (Util.time2string (Util.time())); + showArchive archive; + Format.print_flush(); + Format.set_formatter_output_functions outfn flushfn; + flush ch; + close_out ch; + Lwt.return () + +let dumpArchiveOnRoot : Common.root -> unit -> unit Lwt.t = + Remote.registerRootCmd "dumpArchive" dumpArchiveLocal + +(*************************************************************************) +(* Loading archives *) +(*************************************************************************) + +(* Load (main) root archive and cache it on the given server *) +let loadArchiveOnRoot: Common.root -> bool -> (int * string) option Lwt.t = + Remote.registerRootCmd + "loadArchive" + (fun (fspath, optimistic) -> + let (arcName,thisRoot) = archiveName fspath MainArch in + let arcFspath = Os.fileInUnisonDir arcName in + if optimistic then begin + let (newArcName, _) = archiveName fspath NewArch in + if + (* If the archive is not in a stable state, we need to + perform archive recovery. So, the optimistic loading + fails. *) + Sys.file_exists (Fspath.toString (Os.fileInUnisonDir newArcName)) + || + let (lockFilename, _) = archiveName fspath Lock in + let lockFile = Fspath.toString (Os.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 info = Fileinfo.get false arcFspath Path.empty in + if archiveUnchanged fspath info then + (* The archive is unchanged. So, we don't need to do + anything. *) + Lwt.return (Some (0, "")) + else begin + match loadArchiveLocal arcFspath thisRoot with + Some (arch, hash, magic) -> + let info' = Fileinfo.get false arcFspath Path.empty in + if fileUnchanged info info' then begin + setArchiveLocal thisRoot arch; + Hashtbl.replace archiveInfoCache thisRoot info; + Lwt.return (Some (hash, magic)) + end else + (* The archive was modified during loading. We fail. *) + Lwt.return None + | None -> + (* No archive found *) + Lwt.return None + end + end else begin + match loadArchiveLocal arcFspath thisRoot with + Some (arch, hash, magic) -> + setArchiveLocal thisRoot arch; + let info = Fileinfo.get false arcFspath Path.empty in + Hashtbl.replace archiveInfoCache thisRoot info; + Lwt.return (Some (hash, magic)) + | None -> + (* No archive found *) + setArchiveLocal thisRoot NoArchive; + Hashtbl.remove archiveInfoCache thisRoot; + Lwt.return (Some (0, "")) + end) + +let dumpArchives = + Prefs.createBool "dumparchives" false + "*dump contents of archives just after loading" + ("When this preference is set, Unison will create a file unison.dump " + ^ "on each host, containing a text summary of the archive, immediately " + ^ "after loading it.") + +(* For all roots (local or remote), load the archive and cache *) +let loadArchives (optimistic: bool) : bool Lwt.t = + Globals.allRootsMap (fun r -> loadArchiveOnRoot r optimistic) + >>= (fun checksums -> + let identicals = archivesIdentical checksums in + if not (optimistic || identicals) then + raise (Util.Fatal( + "Internal error: On-disk archives are not identical.\n" + ^ "\n" + ^ "This can happen when both machines have the same hostname.\n" + ^ "\n" + ^ "If this is not the case and you get this message repeatedly, please:\n" + ^ " a) Send a bug report to unison-users at yahoogroups.com (you may need" + ^ " to join the group before you will be allowed to post).\n" + ^ " b) Move the archive files on each machine to some other directory\n" + ^ " (in case they may be useful for debugging).\n" + ^ " The archive files on this machine are in the directory\n" + ^ (Printf.sprintf " %s\n" (Fspath.toString Os.unisonDir)) + ^ " and have names of the form\n" + ^ " arXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX\n" + ^ " where the X's are a hexidecimal number .\n" + ^ " c) Run unison again to synchronize from scratch.\n")); + if Prefs.read dumpArchives then + Globals.allRootsMap (fun r -> dumpArchiveOnRoot r ()) + >>= (fun _ -> Lwt.return identicals) + else Lwt.return identicals) + +(* commitActions(thisRoot, id) <- action *) +let setCommitAction (thisRoot: string) (id: int) (action: unit -> unit): unit = + let key = (thisRoot, id) in + Hashtbl.add commitActions key action + +(* perform and remove the action associated with (thisRoot, id) *) +let softCommitLocal (thisRoot: string) (id: int) = + debug (fun () -> + Util.msg "Committing %d\n" id); + let key = (thisRoot, id) in + Hashtbl.find commitActions key (); + Hashtbl.remove commitActions key + +(* invoke softCommitLocal on a given root (which is possibly remote) *) +let softCommitOnRoot: Common.root -> int -> unit Lwt.t = + Remote.registerRootCmd + "softCommit" + (fun (fspath, id) -> + Lwt.return (softCommitLocal (thisRootsGlobalName fspath) id)) + +(* Commit the archive on all roots. The archive must have been updated on + all roots before that. I.e., carry out the action corresponding to [id] + on all the roots *) +let softCommit (id: int): unit Lwt.t = + Util.convertUnixErrorsToFatal "softCommit" (*XXX*) + (fun () -> + Globals.allRootsIter + (fun r -> softCommitOnRoot r id)) + +(* [rollBackLocal thisRoot id] removes the action associated with (thisRoot, + id) *) +let rollBackLocal thisRoot id = + let key = (thisRoot, id) in + try Hashtbl.remove commitActions key with Not_found -> () + +let rollBackOnRoot: Common.root -> int -> unit Lwt.t = + Remote.registerRootCmd + "rollBack" + (fun (fspath, id) -> + Lwt.return (rollBackLocal (thisRootsGlobalName fspath) id)) + +(* Rollback the archive on all roots. *) +(* I.e., remove the action associated with [id] on all roots *) +let rollBack id = + Util.convertUnixErrorsToFatal "rollBack" (*XXX*) + (fun () -> + Globals.allRootsIter + (fun r -> rollBackOnRoot r id)) + +let ids = ref 0 +let new_id () = incr ids; !ids + +type transaction = int + +(* [transaction f]: transactional execution + * [f] should take in a unique id, which it can use to `setCommitAction', + * and returns a thread. + * When the thread finishes execution, the committing action associated with + * [id] is invoked. + *) +let transaction (f: int -> unit Lwt.t): unit Lwt.t = + let id = new_id () in + Lwt.catch + (fun () -> + f id >>= (fun () -> + softCommit id)) + (fun exn -> + match exn with + Util.Transient _ -> + rollBack id >>= (fun () -> + Lwt.fail exn) + | _ -> + Lwt.fail exn) + +(*****************************************************************************) +(* Archive locking *) +(*****************************************************************************) + +let lockArchiveLocal fspath = + let (lockFilename, _) = archiveName fspath Lock in + let lockFile = Fspath.toString (Os.fileInUnisonDir lockFilename) in + if Lock.acquire lockFile then + None + else + Some (Printf.sprintf "The file %s on host %s should be deleted" + lockFile Os.myCanonicalHostName) + +let lockArchiveOnRoot: Common.root -> unit -> string option Lwt.t = + Remote.registerRootCmd + "lockArchive" (fun (fspath, ()) -> Lwt.return (lockArchiveLocal fspath)) + +let unlockArchiveLocal fspath = + Lock.release + (Fspath.toString (Os.fileInUnisonDir (fst (archiveName fspath Lock)))) + +let unlockArchiveOnRoot: Common.root -> unit -> unit Lwt.t = + Remote.registerRootCmd + "unlockArchive" + (fun (fspath, ()) -> Lwt.return (unlockArchiveLocal fspath)) + +let ignorelocks = + Prefs.createBool "ignorelocks" false + "!ignore locks left over from previous run (dangerous!)" + ("When this preference is set, Unison will ignore any lock files " + ^ "that may have been left over from a previous run of Unison that " + ^ "was interrupted while reading or writing archive files; by default, " + ^ "when Unison sees these lock files it will stop and request manual " + ^ "intervention. This " + ^ "option should be set only if you are {\\em positive} that no other " + ^ "instance of Unison might be concurrently accessing the same archive " + ^ "files (e.g., because there was only one instance of unison running " + ^ "and it has just crashed or you have just killed it). It is probably " + ^ "not a good idea to set this option in a profile: it is intended for " + ^ "command-line use.") + +let locked = ref false + +let lockArchives () = + assert (!locked = false); + Globals.allRootsMap + (fun r -> lockArchiveOnRoot r ()) >>= (fun result -> + if Safelist.exists (fun x -> x <> None) result + && not (Prefs.read ignorelocks) then begin + Globals.allRootsIter2 + (fun r st -> + match st with + None -> unlockArchiveOnRoot r () + | Some _ -> Lwt.return ()) + result >>= (fun () -> + let whatToDo = Safelist.filterMap (fun st -> st) result in + raise + (Util.Fatal + (String.concat "\n" + (["Warning: the archives are locked. "; + "If no other instance of " ^ Uutil.myName ^ " is running, \ + the locks should be removed."] + @ whatToDo @ + ["Please delete lock files as appropriate and try again."])))) + end else begin + locked := true; + Lwt.return () + end) + +let unlockArchives () = + if !locked then begin + Globals.allRootsIter (fun r -> unlockArchiveOnRoot r ()) >>= (fun () -> + locked := false; + Lwt.return ()) + end else + Lwt.return () + +(*************************************************************************) +(* CRASH RECOVERY *) +(*************************************************************************) + +(* We avoid getting into an unsafe situation if the synchronizer is + interrupted during the writing of the archive files by adopting a + simple joint commit protocol. + + The invariant that we maintain at all times is: + if all hosts have a temp archive, + then these temp archives contain coherent information + if NOT all hosts have a temp archive, + then the regular archives contain coherent information + + When we WRITE archives (markUpdated), we maintain this invariant + as follows: + - first, write all archives to a temporary filename + - then copy all the temp files to the corresponding regular archive + files + - finally, delete all the temp files + + Before we LOAD archives (findUpdates), we perform a crash recovery + procedure, in case there was a crash during any of the above operations. + - if all hosts have a temporary archive, we copy these to the + regular archive names + - otherwise, if some hosts have temporary archives, we delete them +*) + +let archivesExistOnRoot: Common.root -> unit -> (bool * bool) Lwt.t = + Remote.registerRootCmd + "archivesExist" + (fun (fspath,rootsName) -> + let (oldname,_) = archiveName fspath MainArch in + let oldexists = + Sys.file_exists (Fspath.toString (Os.fileInUnisonDir oldname)) in + let (newname,_) = archiveName fspath NewArch in + let newexists = + 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) + +let doArchiveCrashRecovery () = + (* Check which hosts have copies of the old/new archive *) + Globals.allRootsMap (fun r -> archivesExistOnRoot r ()) >>= (fun exl -> + let oldnamesExist,newnamesExist = + Safelist.split exl + in + + (* Do something with the new archives, if there are any *) + begin if forall newnamesExist then begin + (* All new versions were written: use them *) + Util.warn + (Printf.sprintf + "Warning: %s may have terminated abnormally last time.\n\ + A new archive exists on all hosts: I'll use them.\n" + Uutil.myName); + Globals.allRootsIter (fun r -> postCommitArchiveOnRoot r ()) >>= (fun () -> + Globals.allRootsIter (fun r -> removeArchiveOnRoot r NewArch)) + end else if exists newnamesExist then begin + Util.warn + (Printf.sprintf + "Warning: %s may have terminated abnormally last time.\n\ + A new archive exists on some hosts only; it will be ignored.\n" + Uutil.myName); + Globals.allRootsIter (fun r -> removeArchiveOnRoot r NewArch) + end else + Lwt.return () + end >>= (fun () -> + + (* Now verify that there are old archives on all hosts *) + if forall oldnamesExist then begin + (* We're happy *) + foundArchives := true; + Lwt.return () + end else if exists oldnamesExist then + Globals.allRootsMap + (fun r -> archiveNameOnRoot r MainArch) >>= (fun names -> + let whatToDo = + Safelist.map + (fun (name,host,exists) -> + Printf.sprintf " Archive %s on host %s %s" + name + host + (if exists then "should be DELETED" else "is MISSING")) + names in + raise + (Util.Fatal + (String.concat "\n" + (["Warning: inconsistent state. "; + "The archive file is missing on some hosts."; + "For safety, the remaining copies should be deleted."] + @ whatToDo @ + ["Please delete archive files as appropriate and try again."])))) + else begin + foundArchives := false; + let expectedRoots = + String.concat "\n\t" (Safelist.map root2string (Globals.rootsList ())) in + Util.warn + ("No archive files were found for these roots, whose canonical names are:\n\t" + ^ expectedRoots ^ "\nThis can happen either\n" + ^ "because this is the first time you have synchronized these roots, \n" + ^ "or because you have upgraded Unison to a new version with a different\n" + ^ "archive format. \n\n" + ^ "Update detection may take a while on this run if the replicas are \n" + ^ "large.\n\n" + ^ "Unison will assume that the 'last synchronized state' of both replicas\n" + ^ "was completely empty. This means that any files that are different\n" + ^ "will be reported as conflicts, and any files that exist only on one\n" + ^ "replica will be judged as new and propagated to the other replica.\n" + ^ "If the two replicas are identical, then no changes will be reported.\n\n" + ^ "If you see this message repeatedly, it may be because one of your machines\n" + ^ "is getting its address from DHCP, which is causing its host name to change\n" + ^ "between synchronizations. See the documentation for the UNISONLOCALHOSTNAME\n" + ^ "environment variable for advice on how to correct this.\n" + ^ "\n" + ^ "Donations to the Unison project are gratefully accepted: \n" + ^ "http://www.cis.upenn.edu/~bcpierce/unison\n" + ^ "\n" + (* ^ "\nThe expected archive names were:\n" ^ expectedNames *) ); + Lwt.return () + end)) + +(************************************************************************* + Update a part of an archive + *************************************************************************) + +(* perform [action] on the relative path [rest] in the archive. If it + returns [(ar, result)], then update archive with [ar] at [rest] and + return [result]. *) +let rec updatePathInArchive archive fspath + (here: Path.local) (rest: Path.t) + (action: archive -> Fspath.t -> Path.local -> archive * 'c): + archive * 'c + = + debugverbose + (fun() -> + Printf.eprintf "updatePathInArchive %s %s [%s] [%s]\n" + (archive2string archive) (Fspath.toString fspath) + (Path.toString here) (Path.toString rest)); + match Path.deconstruct rest with + None -> + action archive fspath here + | Some(name, rest') -> + let (desc, name', child, otherChildren) = + match archive with + ArchiveDir (desc, children) -> + begin try + let (name', child) = NameMap.findi name children in + (desc, name', child, NameMap.remove name children) + with Not_found -> + (desc, name, NoArchive, children) + end + | _ -> + (Props.dummy, name, NoArchive, NameMap.empty) in + match + updatePathInArchive child fspath (Path.child here name') rest' action + with + NoArchive, res -> + if otherChildren = NameMap.empty && desc == Props.dummy then + NoArchive, res + else + ArchiveDir (desc, otherChildren), res + | child, res -> + ArchiveDir (desc, NameMap.add name' child otherChildren), res + +(*************************************************************************) +(* Extract of a part of a archive *) +(*************************************************************************) + +(* Get the archive found at [rest] of [archive] *) +let rec getPathInArchive archive here rest = + match Path.deconstruct rest with + None -> + (here, archive) + | Some (name, rest') -> + let (name', child) = + match archive with + ArchiveDir (desc, children) -> + begin try + NameMap.findi name children + with Not_found -> + (name, NoArchive) + end + | _ -> + (name, NoArchive) + in + getPathInArchive child (Path.child here name') rest' + +let translatePathLocal fspath path = + let root = thisRootsGlobalName fspath in + let (localPath, _) = getPathInArchive (getArchive root) Path.empty path in + localPath + +let translatePath = + Remote.registerRootCmd "translatePath" + (fun (fspath, path) -> Lwt.return (translatePathLocal fspath path)) + +let isDir fspath path = + let fullFspath = Fspath.concat fspath path in + try + (Fspath.stat fullFspath).Unix.LargeFile.st_kind = Unix.S_DIR + with Unix.Unix_error _ -> false + +(*********************************************************************** + MOUNT POINTS +************************************************************************) + +let mountpoints = + Prefs.createStringList "mountpoint" + "!abort if this path does not exist" + ("Including the preference \\texttt{-mountpoint PATH} causes Unison to " + ^ "double-check, at the end of update detection, that \\texttt{PATH} exists " + ^ "and abort if it does not. This is useful when Unison is used to synchronize " + ^ "removable media. This preference can be given more than once. " + ^ "See \\sectionref{mountpoints}{Mount Points}.") + +let abortIfAnyMountpointsAreMissing fspath = + Safelist.iter + (fun s -> + let path = Path.fromString s in + if not (Os.exists fspath path) then + raise (Util.Fatal + (Printf.sprintf "Path %s / %s is designated as a mountpoint, but points to nothing on host %s\n" + (Fspath.toString fspath) (Path.toString path) Os.myCanonicalHostName))) + (Prefs.read mountpoints) + + +(*********************************************************************** + UPDATE DETECTION +************************************************************************) + +(* Generate a tree of changes. Also, update the archive in case some + timestamps have been changed without the files being actually updated. *) + +let fastcheck = + Prefs.createString "fastcheck" "default" + "!do fast update detection (true/false/default)" + ( "When this preference is set to \\verb|true|, \ + Unison will use the modification time and length of a file as a + `pseudo inode number' \ + when scanning replicas for updates, \ + instead of reading the full contents of every file. Under \ + Windows, this may cause Unison to miss propagating an update \ + if the modification time and length of the \ + file are both unchanged by the update. However, Unison will never \ + {\\em overwrite} such an update with a change from the other \ + replica, since it always does a safe check for updates just \ + before propagating a change. Thus, it is reasonable to use \ + this switch under Windows most of the time and occasionally \ + run Unison once with {\\tt fastcheck} set to \ + \\verb|false|, if you are \ + worried that Unison may have overlooked an update. The default \ + value of the preference is \\verb|auto|, which causes Unison to \ + use fast checking on Unix replicas (where it is safe) and slow \ + checking on Windows replicas. For backward compatibility, \ + \\verb|yes|, \\verb|no|, and \\verb|default| can be used in place \ + of \\verb|true|, \\verb|false|, and \\verb|auto|. See \ + \\sectionref{fastcheck}{Fast Checking} for more information.") + +let useFastChecking () = + (Prefs.read fastcheck = "yes") + || (Prefs.read fastcheck = "true") + || (Prefs.read fastcheck = "default" && Util.osType = `Unix) + || (Prefs.read fastcheck = "auto" && Util.osType = `Unix) + +let immutable = Pred.create "immutable" ~advanced:true + ("This preference specifies paths for directories whose \ + immediate children are all immutable files --- i.e., once a file has been \ + created, its contents never changes. When scanning for updates, \ + Unison does not check whether these files have been modified; \ + this can speed update detection significantly (in particular, for mail \ + directories).") + +let immutablenot = Pred.create "immutablenot" ~advanced:true + ("This preference overrides {\\tt immutable}.") + +(** Status display **) + +(* BCP (3/09) We used to try to be smart about showing status messages + at regular intervals, but people seem to find this confusing. + Let's replace all this with something simpler -- just show directories as + they are scanned... (but I'll leave the code in for now, in case we find + we want to restore the old behavior). *) +(* + let bigFileLength = 10 * 1024 + let bigFileLengthFS = Uutil.Filesize.ofInt bigFileLength + let smallFileLength = 1024 + let fileLength = ref 0 + let t0 = ref 0. + + (* Note that we do *not* want to do any status displays from the server + side, since this will cause the server to block until the client has + finished its own update detection and can receive and acknowledge + the status display message -- thus effectively serializing the client + and server! *) + let showStatusAddLength info = + if not !Trace.runningasserver then begin + let len1 = Props.length info.Fileinfo.desc in + let len2 = Osx.ressLength info.Fileinfo.osX.Osx.ressInfo in + if len1 >= bigFileLengthFS || len2 >= bigFileLengthFS then + fileLength := bigFileLength + else + fileLength := + min bigFileLength + (!fileLength + Uutil.Filesize.toInt len1 + Uutil.Filesize.toInt len2) + end + + let showStatus path = + if not !Trace.runningasserver then begin + fileLength := !fileLength + smallFileLength; + if !fileLength >= bigFileLength then begin + fileLength := 0; + let t = Unix.gettimeofday () in + if t -. !t0 > 0.05 then begin + Trace.statusDetail ("scanning... got to " ^ Path.toString path); + t0 := t + end + end + end +*) + +let showStatus path = () +let showStatusAddLength info = () + +let showStatusDir path = + if not !Trace.runningasserver then begin + Trace.statusDetail ("scanning... " ^ Path.toString path); + end + +(* ------- *) + +let symlinkInfo = + Common.Previous (`SYMLINK, Props.dummy, Os.fullfingerprint_dummy, Osx.ressDummy) + +let absentInfo = Common.New + +let oldInfoOf archive = + match archive with + ArchiveDir (oldDesc, _) -> + Common.Previous (`DIRECTORY, oldDesc, Os.fullfingerprint_dummy, Osx.ressDummy) + | ArchiveFile (oldDesc, dig, _, ress) -> + Common.Previous (`FILE, oldDesc, dig, ress) + | ArchiveSymlink _ -> + symlinkInfo + | NoArchive -> + absentInfo + +(* Check whether a file's permissions have not changed *) +let isPropUnchanged info archiveDesc = + Props.similar info.Fileinfo.desc archiveDesc + +(* Handle file permission change *) +let checkPropChange info archive archDesc = + if isPropUnchanged info archDesc then begin + debugverbose (fun() -> Util.msg " Unchanged file\n"); + NoUpdates + end else begin + debug (fun() -> Util.msg " File permissions updated\n"); + Updates (File (info.Fileinfo.desc, ContentsSame), + oldInfoOf archive) + end + +(* HACK: we disable fastcheck for Excel (and MPP) files on Windows, as Excel + sometimes modifies a file without updating the time stamp. *) +let excelFile path = + let s = Path.toString path in + Util.endswith s ".xls" + || Util.endswith s ".mpp" + +(* Check whether a file has changed has changed, by comparing its digest and + properties against [archDesc], [archDig], and [archStamp]. + Returns a pair (optArch, ui) where [optArch] is *not* None when the file remains + unchanged but time might be changed. [optArch] is used by [buildUpdate] + series functions to compute the _old_ archive with updated time stamp + (thus, there will no false update the next time) *) +let checkContentsChange + currfspath path info archive archDesc archDig archStamp archRess fastCheck + : archive option * Common.updateItem + = + debug (fun () -> + Util.msg "checkContentsChange: "; + begin + match archStamp with + Fileinfo.InodeStamp inode -> + (Util.msg "archStamp is inode (%d)" inode; + Util.msg " / info.inode (%d)" info.Fileinfo.inode) + | Fileinfo.CtimeStamp stamp -> + (Util.msg "archStamp is ctime (%f)" stamp; + Util.msg " / info.ctime (%f)" info.Fileinfo.ctime) + end; + Util.msg " / times: %f = %f... %b" + (Props.time archDesc) (Props.time info.Fileinfo.desc) + (Props.same_time info.Fileinfo.desc archDesc); + Util.msg " / lengths: %s - %s" + (Uutil.Filesize.toString (Props.length archDesc)) + (Uutil.Filesize.toString (Props.length info.Fileinfo.desc)); + Util.msg "\n"); + let dataClearlyUnchanged = + fastCheck + && + Props.same_time info.Fileinfo.desc archDesc + && + Props.length info.Fileinfo.desc = Props.length archDesc + && + not (excelFile path) + && + match archStamp with + Fileinfo.InodeStamp inode -> + info.Fileinfo.inode = inode + | Fileinfo.CtimeStamp ctime -> + (* BCP [Apr 07]: This doesn't work -- ctimes are unreliable + under windows. :-( + info.Fileinfo.ctime = ctime *) + true in + let ressClearlyUnchanged = + fastCheck + && + Osx.ressUnchanged archRess info.Fileinfo.osX.Osx.ressInfo + None dataClearlyUnchanged in + if dataClearlyUnchanged && ressClearlyUnchanged then begin + Xferhint.insertEntry (currfspath, path) archDig; + None, checkPropChange info archive archDesc + end else begin + debugverbose (fun() -> Util.msg " Double-check possibly updated file\n"); + showStatusAddLength info; + let (info, newDigest) = + Os.safeFingerprint currfspath path info + (if dataClearlyUnchanged then Some archDig else None) in + Xferhint.insertEntry (currfspath, path) newDigest; + debug (fun() -> Util.msg " archive digest = %s current digest = %s\n" + (Os.fullfingerprint_to_string archDig) + (Os.fullfingerprint_to_string newDigest)); + if archDig = newDigest then begin + let newprops = Props.setTime archDesc (Props.time info.Fileinfo.desc) in + let newarch = + ArchiveFile + + (newprops, archDig, Fileinfo.stamp info, Fileinfo.ressStamp info) in + debugverbose (fun() -> + Util.msg " Contents match: update archive with new time...%f\n" + (Props.time newprops)); + Some newarch, checkPropChange info archive archDesc + end else begin + debug (fun() -> Util.msg " Updated file\n"); + None, + Updates (File (info.Fileinfo.desc, + ContentsUpdated (newDigest, Fileinfo.stamp info, + Fileinfo.ressStamp info)), + oldInfoOf archive) + end + end + + +(* getChildren = childrenOf + repetition check + + Find the children of fspath+path, and return them, sorted, and + partitioned into those with case conflicts, those with illegal + cross platform filenames, and those without problems. + + Note that case conflicts and illegal filenames can only occur under Unix, + when syncing with a Windows file system. *) +let badWindowsFilenameRx = + (* FIX: This should catch all device names (like aux, con, ...). I don't + know what all the possible device names are. *) + Rx.case_insensitive + (Rx.rx "\\.*|aux|con|lpt1|prn|(.*[\000-\031\\/<>:\"|].*)") + +let isBadWindowsFilename s = + (* FIX: should also check for a max filename length, not sure how much *) + Rx.match_string badWindowsFilenameRx (Name.toString s) +let badFilename s = + (* Don't check unless we are syncing with Windows *) + Prefs.read Globals.someHostIsRunningWindows && + isBadWindowsFilename s + +let getChildren fspath path = + let children = + (* We sort them in reverse order, as findDuplicate will reverse + the list again *) + Safelist.sort (fun nm1 nm2 -> - (Name.compare nm1 nm2)) + (Os.childrenOf fspath path) in + (* If Unison overall is running in case-insensitive mode but the + local filesystem is case sensitive, then we need to check that + two local files do not have the same name modulo case... *) + (* We do it all the time, as this may happen anyway due to race + conditions... *) + let childStatus nm count = + if count > 1 then + `Dup + else if badFilename nm then + `Bad + else + `Ok + in + let rec findDuplicates' res nm count l = + match l with + [] -> + (nm, childStatus nm count) :: res + | nm' :: rem -> + if Name.eq nm nm' then + findDuplicates' res nm (count + 1) rem + else + findDuplicates' ((nm, childStatus nm count) :: res) nm' 1 rem + and findDuplicates l = + match l with + [] -> [] + | nm :: rem -> findDuplicates' [] nm 1 rem + in + findDuplicates children + +(* from a list of (name, archive) pairs {usually the items in the same + directory}, build two lists: the first a named list of the _old_ + archives, with their timestamps updated for the files whose contents + remain unchanged, the second a named list of updates; also returns + whether the directory is now empty *) +let rec buildUpdateChildren + fspath path (archChi: archive NameMap.t) fastCheck + : archive NameMap.t option * (Name.t * Common.updateItem) list * bool + = + showStatusDir path; + let t = Trace.startTimerQuietly + (Printf.sprintf "checking %s" (Path.toString path)) in + let skip = + Pred.test immutable (Path.toString path) && + not (Pred.test immutablenot (Path.toString path)) + in + let curChildren = ref (getChildren fspath path) in + let emptied = not (NameMap.is_empty archChi) && !curChildren = [] in + let updates = ref [] in + let archUpdated = ref false in + let handleChild nm archive status = + let path' = Path.child path nm in + if Globals.shouldIgnore path' then begin + debugignore (fun()->Util.msg "buildUpdateChildren: ignoring path %s\n" + (Path.toString path')); + archive + end else begin + showStatus path'; + match status with + `Ok | `Abs -> + if skip && archive <> NoArchive && status <> `Abs then begin + begin match archive with + ArchiveFile (archDesc, archDig, archStamp, archRess) -> + Xferhint.insertEntry (fspath, path') archDig + | _ -> + () + end; + archive + end else begin + let (arch,uiChild) = + buildUpdateRec archive fspath path' fastCheck in + if uiChild <> NoUpdates then + updates := (nm, uiChild) :: !updates; + match arch with + None -> archive + | Some arch -> archUpdated := true; arch + end + | `Dup -> + let uiChild = + Error + ("Two or more files on a case-sensitive system have names \ + identical except for case. They cannot be synchronized to a \ + case-insensitive file system. (" ^ + Path.toString path' ^ ")") + in + updates := (nm, uiChild) :: !updates; + archive + | `Bad -> + let uiChild = + Error ("The name of this Unix file is not allowed in Windows (" + ^ Path.toString path' ^ ")") + in + updates := (nm, uiChild) :: !updates; + archive + end + in + let rec matchChild nm archive = + match !curChildren with + [] -> + (nm, handleChild nm archive `Abs) + | (nm', st) :: rem -> + let c = Name.compare nm nm' in + if c < 0 then + (nm, handleChild nm archive `Abs) + else begin + curChildren := rem; + if c = 0 then begin + if nm <> nm' then archUpdated := true; + (nm', handleChild nm' archive st) + end else begin + let arch = handleChild nm' NoArchive st in + assert (arch = NoArchive); + matchChild nm archive + end + end + in + let newChi = NameMap.mapii matchChild archChi in + Safelist.iter + (fun (nm, st) -> + let arch = handleChild nm NoArchive st in + assert (arch = NoArchive)) + !curChildren; + Trace.showTimer t; + (* The Recon module relies on the updates to be sorted *) + ((if !archUpdated then Some newChi else None), + Safelist.rev !updates, emptied) + +and buildUpdateRec archive currfspath path fastCheck = + try + debug (fun() -> + Util.msg "buildUpdate: %s\n" + (Fspath.concatToString currfspath path)); + let info = Fileinfo.get true currfspath path in + match (info.Fileinfo.typ, archive) with + (`ABSENT, NoArchive) -> + debug (fun() -> Util.msg " buildUpdate -> Absent and no archive\n"); + None, NoUpdates + | (`ABSENT, _) -> + debug (fun() -> Util.msg " buildUpdate -> Deleted\n"); + None, Updates (Absent, oldInfoOf archive) + (* --- *) + | (`FILE, ArchiveFile (archDesc, archDig, archStamp, archRess)) -> + checkContentsChange + currfspath path info archive + archDesc archDig archStamp archRess fastCheck + | (`FILE, _) -> + debug (fun() -> Util.msg " buildUpdate -> Updated file\n"); + None, + begin + showStatusAddLength info; + let (info, dig) = Os.safeFingerprint currfspath path info None in + Xferhint.insertEntry (currfspath, path) dig; + Updates (File (info.Fileinfo.desc, + ContentsUpdated (dig, Fileinfo.stamp info, + Fileinfo.ressStamp info)), + oldInfoOf archive) + end + (* --- *) + | (`SYMLINK, ArchiveSymlink prevl) -> + let l = Os.readLink currfspath path in + debug (fun() -> + if l = prevl then + Util.msg " buildUpdate -> Symlink %s (unchanged)\n" l + else + Util.msg " buildUpdate -> Symlink %s (previously: %s)\n" l prevl); + (None, + if l = prevl then NoUpdates else + Updates (Symlink l, oldInfoOf archive)) + | (`SYMLINK, _) -> + let l = Os.readLink currfspath path in + debug (fun() -> Util.msg " buildUpdate -> New symlink %s\n" l); + None, Updates (Symlink l, oldInfoOf archive) + (* --- *) + | (`DIRECTORY, ArchiveDir (archDesc, prevChildren)) -> + debugverbose (fun() -> Util.msg " buildUpdate -> Directory\n"); + let (permchange, desc) = + if isPropUnchanged info archDesc then + (PropsSame, archDesc) + else + (PropsUpdated, info.Fileinfo.desc) in + let (newChildren, childUpdates, emptied) = + buildUpdateChildren currfspath path prevChildren fastCheck in + (begin match newChildren with + Some ch -> Some (ArchiveDir (archDesc, ch)) + | None -> None + end, + if childUpdates <> [] || permchange = PropsUpdated then + Updates (Dir (desc, childUpdates, permchange, emptied), + oldInfoOf archive) + else + NoUpdates) + | (`DIRECTORY, _) -> + debug (fun() -> Util.msg " buildUpdate -> New directory\n"); + let (newChildren, childUpdates, _) = + buildUpdateChildren currfspath path NameMap.empty fastCheck in + (* BCPFIX: This is a bit of a hack and does not really work, since + it means that we calculate the size of a directory just once and + then never update our idea of how big it is. The size should + really be recalculated when things change. *) + let newdesc = + Props.setLength info.Fileinfo.desc + (Safelist.fold_left + (fun s (_,ui) -> Uutil.Filesize.add s (uiLength ui)) + Uutil.Filesize.zero childUpdates) in + (None, + Updates (Dir (newdesc, childUpdates, PropsUpdated, false), + oldInfoOf archive)) + with + Util.Transient(s) -> None, Error(s) + +(* Compute the updates for [path] against archive. Also returns an + archive, which is the old archive with time stamps updated + appropriately (i.e., for those files whose contents remain + unchanged). *) +let rec buildUpdate archive fspath fullpath here path = + match Path.deconstruct path with + None -> + showStatus path; + let (arch, ui) = + buildUpdateRec archive fspath here (useFastChecking()) in + (begin match arch with + None -> archive + | Some arch -> arch + end, + ui) + | Some(name, path') -> + if not (isDir fspath here) then + let error = + if Path.isEmpty here then + Printf.sprintf + "path %s is not valid because the root of one of the replicas \ + is not a directory" + (Path.toString fullpath) + else + Printf.sprintf + "path %s is not valid because %s is not a directory in one of \ + the replicas" + (Path.toString fullpath) (Path.toString here) + in + (* FIX: We have to fail here (and in other error cases below) + rather than report an error for this path, which would be + more user friendly. Indeed, the archive is otherwise + modified in inconsistent way when the failure occurs only + on one replica (see at the end of this function). + A better solution should be not to put the archives in a + different state, but this is a lot more work. *) + raise (Util.Transient error) +(* (archive, Error error) *) + else + let children = getChildren fspath here in + let (name', status) = + try + Safelist.find (fun (name', _) -> Name.eq name name') children + with Not_found -> + (name, if badFilename name then `Bad else `Ok) + in + match status with + `Bad -> + raise (Util.Transient + ("The path " ^ Path.toString fullpath ^ + " is not allowed in Windows")) + | `Dup -> + raise (Util.Transient + ("The path " ^ Path.toString fullpath ^ + " is ambiguous (i.e., the name of this path or one of its " + ^ "ancestors is the same, modulo capitalization, as another " + ^ "path in a case-sensitive filesystem, and you are " + ^ "synchronizing this filesystem with a case-insensitive " + ^ "filesystem. ")) + | `Ok -> + let (desc, child, otherChildren) = + match archive with + ArchiveDir (desc, children) -> + begin try + let child = NameMap.find name children in + (desc, child, NameMap.remove name children) + with Not_found -> + (desc, NoArchive, children) + end + | _ -> + (Props.dummy, NoArchive, NameMap.empty) + in + let (arch, updates) = + buildUpdate child fspath fullpath (Path.child here name') path' + in + (* We need to put a directory in the archive here for path + translation. This is fine because we check that there + really is a directory on both replica. + Note that we may also put NoArchive deep inside an + archive... + *) + (ArchiveDir (desc, NameMap.add name' arch otherChildren), + updates) + +(* for the given path, find the archive and compute the list of update + items; as a side effect, update the local archive w.r.t. time-stamps for + unchanged files *) +let findLocal fspath pathList: Common.updateItem list = + debug (fun() -> Util.msg "findLocal %s\n" (Fspath.toString fspath)); + addHashToTempNames fspath; + (* Maybe we should remember the device number where the root lives at + the beginning of update detection, so that we can check, below, that + the device has not changed. This check allows us to abort in case + the root is on a removable device and this device gets removed during + update detection, causing all the files to appear to have been + deleted. --BCP 2006 *) + let (arcName,thisRoot) = archiveName fspath MainArch in + let archive = getArchive thisRoot in + let (archive, updates) = + Safelist.fold_right + (fun path (arch, upd) -> + if Globals.shouldIgnore path then + (arch, NoUpdates :: upd) + else + let (arch', ui) = + buildUpdate arch fspath path Path.empty path + in + arch', ui :: upd) + pathList (archive, []) + in + setArchiveLocal thisRoot archive; + abortIfAnyMountpointsAreMissing fspath; + updates + +let findOnRoot = + Remote.registerRootCmd + "find" + (fun (fspath, pathList) -> + Lwt.return (findLocal fspath pathList)) + +let findUpdatesOnPaths pathList : Common.updateItem list Common.oneperpath = + Lwt_unix.run + (loadArchives true >>= (fun ok -> + begin if ok then Lwt.return () else begin + lockArchives () >>= (fun () -> + Remote.Thread.unwindProtect + (fun () -> + doArchiveCrashRecovery () >>= (fun () -> + loadArchives false)) + (fun _ -> + unlockArchives ()) >>= (fun _ -> + unlockArchives ())) + end end >>= (fun () -> + let t = Trace.startTimer "Collecting changes" in + Globals.allRootsMapWithWaitingAction (fun r -> + debug (fun() -> Util.msg "findOnRoot %s\n" (root2string r)); + findOnRoot r pathList) + (fun (host, _) -> + begin match host with + Remote(_) -> Trace.statusDetail "Waiting for changes from server" + | _ -> () + end) + >>= (fun updates -> + Trace.showTimer t; + let result = Safelist.transpose updates in + Trace.status ""; + Lwt.return (ONEPERPATH(result)))))) + +let findUpdates () : Common.updateItem list Common.oneperpath = + (* TODO: We should filter the paths to remove duplicates (including prefixes) + and ignored paths *) +(* FIX: The following line can be deleted -- it's just for debugging *) +debug (fun() -> Util.msg "Running bogus external program\n"); +let _ = External.runExternalProgram "dir" in +debug (fun() -> Util.msg "Finished running bogus external program\n"); + findUpdatesOnPaths (Prefs.read Globals.paths) + + +(*****************************************************************************) +(* Committing updates to disk *) +(*****************************************************************************) + +(* To prepare for committing, write to Scratch Archive *) +let prepareCommitLocal (fspath, magic) = + let (newName, root) = archiveName fspath ScratchArch in + let archive = getArchive root in + (** + :ZheDebug: + Format.set_formatter_out_channel stdout; + Format.printf "prepareCommitLocal: %s\n" (thisRootsGlobalName fspath); + showArchive archive; + Format.print_flush(); + **) + let archiveHash = checkArchive true Path.empty archive 0 in + storeArchiveLocal + (Os.fileInUnisonDir newName) root archive archiveHash magic; + Lwt.return (Some archiveHash) + +let prepareCommitOnRoot + = Remote.registerRootCmd "prepareCommit" prepareCommitLocal + +(* To really commit, first prepare (write to scratch arch.), then make sure + the checksum on all archives are equal, finally flip scratch to main. In + the event of checksum mismatch, dump archives on all roots and fail *) +let commitUpdates () = + Lwt_unix.run + (debug (fun() -> Util.msg "Updating archives\n"); + lockArchives () >>= (fun () -> + Remote.Thread.unwindProtect + (fun () -> + let magic = + Format.sprintf "%.f.%d" (Unix.gettimeofday ()) (Unix.getpid ()) + in + Globals.allRootsMap (fun r -> prepareCommitOnRoot r magic) + >>= (fun checksums -> + if archivesIdentical checksums then begin + (* Move scratch archives to new *) + Globals.allRootsIter (fun r -> commitArchiveOnRoot r ()) + >>= (fun () -> + (* Copy new to main *) + Globals.allRootsIter (fun r -> postCommitArchiveOnRoot r ()) + >>= (fun () -> + (* Clean up *) + Globals.allRootsIter + (fun r -> removeArchiveOnRoot r NewArch))) + end else begin + unlockArchives () >>= (fun () -> + Util.msg "Dumping archives to ~/unison.dump on both hosts\n"; + Globals.allRootsIter (fun r -> dumpArchiveOnRoot r ()) + >>= (fun () -> + Util.msg "Finished dumping archives\n"; + raise (Util.Fatal ( + "Internal error: New archives are not identical.\n" + ^ "Retaining original archives. " + ^ "Please run Unison again to bring them up to date.\n" + (* + ^ "If you get this message, please \n " + ^ " a) notify unison-help at cis.upenn.edu\n" + ^ " b) send us the contents of the file unison.dump \n" + ^ " from both hosts (or just do a 'diff'\n" + ^ " on these files and tell us what the differences\n" + ^ " look like)\n" *) + )))) + end)) + (fun _ -> unlockArchives ()) >>= (fun () -> + unlockArchives ()))) + +(*****************************************************************************) +(* MARKING UPDATES *) +(*****************************************************************************) + +(* the result of patching [archive] using [ui] *) +let rec updateArchiveRec ui archive = + match ui with + NoUpdates | Error _ -> + archive + | Updates (uc, _) -> + match uc with + Absent -> + NoArchive + | File (desc, ContentsSame) -> + begin match archive with + ArchiveFile (_, dig, stamp, ress) -> + ArchiveFile (desc, dig, stamp, ress) + | _ -> + assert false + end + | File (desc, ContentsUpdated (dig, stamp, ress)) -> + ArchiveFile (desc, dig, stamp, ress) + | Symlink l -> + ArchiveSymlink l + | Dir (desc, children, _, _) -> + begin match archive with + ArchiveDir (_, arcCh) -> + let ch = + Safelist.fold_right + (fun (nm, uiChild) ch -> + let ch' = NameMap.remove nm ch in + let child = + try NameMap.find nm ch with Not_found -> NoArchive in + match updateArchiveRec uiChild child with + NoArchive -> ch' + | arch -> NameMap.add nm arch ch') + children arcCh in + ArchiveDir (desc, ch) + | _ -> + ArchiveDir + (desc, + Safelist.fold_right + (fun (nm, uiChild) ch -> + match updateArchiveRec uiChild NoArchive with + NoArchive -> ch + | arch -> NameMap.add nm arch ch) + children NameMap.empty) + end + +(* Remove ignored files and properties that are not synchronized *) +let rec stripArchive path arch = + if Globals.shouldIgnore path then NoArchive else + match arch with + ArchiveDir (desc, children) -> + ArchiveDir + (Props.strip desc, + NameMap.fold + (fun nm ar ch -> + match stripArchive (Path.child path nm) ar with + NoArchive -> ch + | ar' -> NameMap.add nm ar' ch) + children NameMap.empty) + | ArchiveFile (desc, dig, stamp, ress) -> + ArchiveFile (Props.strip desc, dig, stamp, ress) + | ArchiveSymlink _ | NoArchive -> + arch + +let updateArchiveLocal fspath path ui id = + debug (fun() -> + Util.msg "updateArchiveLocal %s %s\n" + (Fspath.toString fspath) (Path.toString path)); + let root = thisRootsGlobalName fspath in + let archive = getArchive root in + let (localPath, subArch) = getPathInArchive archive Path.empty path in + let newArch = updateArchiveRec ui (stripArchive path subArch) in + let commit () = + let _ = Stasher.stashCurrentVersion fspath localPath None in + let archive = getArchive root in + let archive, () = + updatePathInArchive archive fspath Path.empty path + (fun _ _ _ -> newArch, ()) in + setArchiveLocal root archive in + setCommitAction root id commit; + debug (fun() -> + Util.msg "updateArchiveLocal --> %s\n" (Path.toString localPath)); + (localPath, newArch) + +let updateArchiveOnRoot = + Remote.registerRootCmd + "updateArchive" + (fun (fspath, (path, ui, id)) -> + Lwt.return (updateArchiveLocal fspath path ui id)) + +let updateArchive root path ui id = + updateArchiveOnRoot root (path, ui, id) + +(* This function is called for files changed only in identical ways. + It only updates the archives and perhaps makes backups. *) +let markEqualLocal fspath paths = + let root = thisRootsGlobalName fspath in + let archive = ref (getArchive root) in + Tree.iteri paths Path.empty Path.child + (fun path uc -> + debug (fun() -> + Util.msg "markEqualLocal %s %s\n" + (Fspath.toString fspath) (Path.toString path)); + let arch, (subArch, localPath) = + updatePathInArchive !archive fspath Path.empty path + (fun archive _ localPath -> + let arch = updateArchiveRec (Updates (uc, New)) archive in + arch, (arch, localPath)) + in + Stasher.stashCurrentVersion fspath localPath None; + archive := arch); + setArchiveLocal root !archive + +let markEqualOnRoot = + Remote.registerRootCmd + "markEqual" + (fun (fspath, paths) -> markEqualLocal fspath paths; Lwt.return ()) + +let markEqual equals = + debug (fun()-> Util.msg "Marking %d paths equal\n" (Tree.size equals)); + if not (Tree.is_empty equals) then begin + Lwt_unix.run + (Globals.allRootsIter2 + markEqualOnRoot + [Tree.map (fun n -> n) (fun (uc1,uc2) -> uc1) equals; + Tree.map (fun n -> n) (fun (uc1,uc2) -> uc2) equals]) + end + +let rec replaceArchiveRec fspath path arch paranoid deleteBadTempFiles = + match arch with + ArchiveDir (desc, children) -> + ArchiveDir (desc, + NameMap.mapi + (fun nm a -> + replaceArchiveRec + fspath (Path.child path nm) a paranoid deleteBadTempFiles) + children) + | ArchiveFile (desc, dig, stamp, ress) -> + if paranoid then begin + (* Paranoid check: recompute the file's digest to match it with + the archive's *) + let info = Fileinfo.get false fspath path in + let dig' = Os.fingerprint fspath path info in + let ress' = Osx.stamp info.Fileinfo.osX in + if dig' <> dig then begin + let savepath = Path.addSuffixToFinalName path "-bad" in + (* if deleteBadTempFiles then Os.delete fspath path; *) + if deleteBadTempFiles then + Os.rename "save temp" fspath path fspath savepath; + raise (Util.Transient (Printf.sprintf + "The file %s was incorrectly transferred (fingerprint mismatch in %s)%s" + (Path.toString path) + (Os.reasonForFingerprintMismatch dig dig') + (if deleteBadTempFiles + then " -- temp file saved as" ^ Path.toString savepath + else ""))); + end; + ArchiveFile (Props.override info.Fileinfo.desc desc, + dig, Fileinfo.stamp info, ress') + end else begin + ArchiveFile (desc, dig, stamp, ress) + end + | ArchiveSymlink l -> + ArchiveSymlink l + | NoArchive -> + arch + +let replaceArchiveLocal fspath pathTo location arch id paranoid deleteBadTempFiles = + debug (fun() -> Util.msg + "replaceArchiveLocal %s %s\n" + (Fspath.toString fspath) + (Path.toString pathTo) + ); + let root = thisRootsGlobalName fspath in + let localPath = translatePathLocal fspath pathTo in + let (workingDir, tempPathTo) = + match location with + None -> (fspath, localPath) + | Some loc -> loc + in + let newArch = + replaceArchiveRec workingDir tempPathTo arch paranoid deleteBadTempFiles in + let commit () = + debug (fun() -> Util.msg "replaceArchiveLocal: committing\n"); + let _ = Stasher.stashCurrentVersion fspath localPath (Some tempPathTo) in + let archive = getArchive root in + let archive, () = + updatePathInArchive archive fspath Path.empty pathTo + (fun _ _ _ -> newArch, ()) + in + setArchiveLocal root archive + in + setCommitAction root id commit; + localPath + +let replaceArchiveOnRoot = + Remote.registerRootCmd + "replaceArchive" + (fun (fspath, (pathTo, location, arch, id, paranoid, deleteBadTempFiles)) -> + Lwt.return (replaceArchiveLocal fspath pathTo location arch + id paranoid deleteBadTempFiles)) + +let replaceArchive root pathTo location archive id paranoid deleteBadTempFiles = + replaceArchiveOnRoot root + (pathTo, location, archive, id, paranoid, deleteBadTempFiles) + +(* Update the archive to reflect + - the last observed state of the file on disk (ui) + - the permission bits that have been propagated from the other + replica, if any (permOpt) *) +let doUpdateProps arch propOpt ui = + let newArch = + match ui with + Updates (File (desc, ContentsSame), _) -> + begin match arch with + ArchiveFile (_, dig, stamp, ress) -> + ArchiveFile (desc, dig, stamp, ress) + | _ -> + assert false + end + | Updates (File (desc, ContentsUpdated (dig, stamp, ress)), _) -> + ArchiveFile(desc, dig, stamp, ress) + | Updates (Dir (desc, _, _, _), _) -> + begin match arch with + ArchiveDir (_, children) -> ArchiveDir (desc, children) + | _ -> ArchiveDir (desc, NameMap.empty) + end + | NoUpdates -> + arch + | Updates _ | Error _ -> + assert false + in + match propOpt with + Some desc' -> + begin match newArch with + ArchiveFile (desc, dig, stamp, ress) -> + ArchiveFile (Props.override desc desc', dig, stamp, ress) + | ArchiveDir (desc, children) -> + ArchiveDir (Props.override desc desc', children) + | _ -> + assert false + end + | None -> newArch + +let updatePropsLocal fspath path propOpt ui id = + debug (fun() -> + Util.msg "updatePropsLocal %s %s\n" + (Fspath.toString fspath) (Path.toString path)); + let root = thisRootsGlobalName fspath in + let commit () = + let archive = getArchive root in + let archive, () = + updatePathInArchive archive fspath Path.empty path + (fun arch _ _ -> doUpdateProps arch propOpt ui, ()) in + setArchiveLocal root archive in + setCommitAction root id commit; + let localPath = translatePathLocal fspath path in + localPath + +let updatePropsOnRoot = + Remote.registerRootCmd + "updateProps" + (fun (fspath, (path, propOpt, ui, id)) -> + Lwt.return (updatePropsLocal fspath path propOpt ui id)) + +let updateProps root path propOpt ui id = + updatePropsOnRoot root (path, propOpt, ui, id) + +(*************************************************************************) +(* Make sure no change has happened *) +(*************************************************************************) + +let checkNoUpdatesLocal fspath pathInArchive ui = + debug (fun() -> + Util.msg "checkNoUpdatesLocal %s %s\n" + (Fspath.toString fspath) (Path.toString pathInArchive)); + let archive = getArchive (thisRootsGlobalName fspath) in + let (localPath, archive) = + getPathInArchive archive Path.empty pathInArchive in + (* Update the original archive to reflect what we believe is the current + state of the replica... *) + let archive = updateArchiveRec ui archive in + (* ...and check that this is a good description of what's out in the world *) + let (_, uiNew) = buildUpdateRec archive fspath localPath false in + if uiNew <> NoUpdates then + raise (Util.Transient ( + "Destination updated during synchronization\n" + ^ (if useFastChecking() then + " (if this happens repeatedly on a file that has not been changed, \n" + ^ " try running once with 'fastcheck' set to false)" + else ""))) + +let checkNoUpdatesOnRoot = + Remote.registerRootCmd + "checkNoUpdates" + (fun (fspath, (pathInArchive, ui)) -> + Lwt.return (checkNoUpdatesLocal fspath pathInArchive ui)) + +let checkNoUpdates root pathInArchive ui = + checkNoUpdatesOnRoot root (pathInArchive, ui) Deleted: branches/2.32/src/update.mli =================================================================== --- trunk/src/update.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/update.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,77 +0,0 @@ -(* Unison file synchronizer: src/update.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -module NameMap : Map.S with type key = Name.t - -type archive = - ArchiveDir of Props.t * archive NameMap.t - | ArchiveFile of Props.t * Os.fullfingerprint * Fileinfo.stamp * Osx.ressStamp - | ArchiveSymlink of string - | NoArchive - -(* Calculate a canonical name for the set of roots to be synchronized. This - will be used in constructing the archive name for each root. Note, all - the roots in this canonical name will contain hostnames, even local - roots, so the roots are re-sorted. *) -val storeRootsName : unit -> unit - -(* Retrieve the actual names of the roots *) -val getRootsName : unit -> string - -val findOnRoot : - Common.root -> Path.t list -> Common.updateItem list Lwt.t - -(* Structures describing dirty files/dirs (1 per path given in the -path preference) *) -val findUpdates : - unit -> Common.updateItem list Common.oneperpath - -(* Take a tree of equal update contents and update the archive accordingly. *) -val markEqual : - (Name.t, Common.updateContent * Common.updateContent) Tree.t -> unit - -(* Commit in memory the last archive updates, or rollback if an exception is - raised. A commit function must have been specified on both sides before - finishing the transaction. *) -type transaction -val transaction : (transaction -> unit Lwt.t) -> unit Lwt.t - -(* Update a part of an archive *) -val updateArchive : - Common.root -> Path.t -> Common.updateItem -> transaction -> - (Path.local * archive) Lwt.t -(* Replace a part of an archive by another archive *) -val replaceArchive : - Common.root -> Path.t -> (Fspath.t * Path.local) option -> - archive -> transaction -> bool -> bool -> Path.local Lwt.t -(* Update only some permissions *) -val updateProps : - Common.root -> Path.t -> Props.t option -> Common.updateItem -> - transaction -> Path.local Lwt.t - -(* Check that no updates has taken place in a given place of the filesystem *) -val checkNoUpdates : - Common.root -> Path.t -> Common.updateItem -> unit Lwt.t - -(* Save to disk the archive updates *) -val commitUpdates : unit -> unit - -(* In the user interface, it's helpful to know whether unison was started - with no archives. (Then we can display file status as 'unknown' rather - than 'new', which seems friendlier for new users.) This flag gets set - false by the crash recovery code when it determines that no archives were - present. *) -val foundArchives : bool ref - -(* Unlock the archives, if they are locked. *) -val unlockArchives : unit -> unit Lwt.t - -(* Translate a global path into a local path using the archive *) -val translatePath : Common.root -> Path.t -> Path.local Lwt.t -val translatePathLocal : Fspath.t -> Path.t -> Path.local - -(* Are we checking fast, or carefully? *) -val useFastChecking : unit -> bool - -(* Print the archive to the current formatter (see Format) *) -val showArchive: archive -> unit - Copied: branches/2.32/src/update.mli (from rev 320, trunk/src/update.mli) =================================================================== --- branches/2.32/src/update.mli (rev 0) +++ branches/2.32/src/update.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,77 @@ +(* Unison file synchronizer: src/update.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +module NameMap : Map.S with type key = Name.t + +type archive = + ArchiveDir of Props.t * archive NameMap.t + | ArchiveFile of Props.t * Os.fullfingerprint * Fileinfo.stamp * Osx.ressStamp + | ArchiveSymlink of string + | NoArchive + +(* Calculate a canonical name for the set of roots to be synchronized. This + will be used in constructing the archive name for each root. Note, all + the roots in this canonical name will contain hostnames, even local + roots, so the roots are re-sorted. *) +val storeRootsName : unit -> unit + +(* Retrieve the actual names of the roots *) +val getRootsName : unit -> string + +val findOnRoot : + Common.root -> Path.t list -> Common.updateItem list Lwt.t + +(* Structures describing dirty files/dirs (1 per path given in the -path preference) *) +val findUpdates : + unit -> Common.updateItem list Common.oneperpath + +(* Take a tree of equal update contents and update the archive accordingly. *) +val markEqual : + (Name.t, Common.updateContent * Common.updateContent) Tree.t -> unit + +(* Commit in memory the last archive updates, or rollback if an exception is + raised. A commit function must have been specified on both sides before + finishing the transaction. *) +type transaction +val transaction : (transaction -> unit Lwt.t) -> unit Lwt.t + +(* Update a part of an archive *) +val updateArchive : + Common.root -> Path.t -> Common.updateItem -> transaction -> + (Path.local * archive) Lwt.t +(* Replace a part of an archive by another archive *) +val replaceArchive : + Common.root -> Path.t -> (Fspath.t * Path.local) option -> + archive -> transaction -> bool -> bool -> Path.local Lwt.t +(* Update only some permissions *) +val updateProps : + Common.root -> Path.t -> Props.t option -> Common.updateItem -> + transaction -> Path.local Lwt.t + +(* Check that no updates has taken place in a given place of the filesystem *) +val checkNoUpdates : + Common.root -> Path.t -> Common.updateItem -> unit Lwt.t + +(* Save to disk the archive updates *) +val commitUpdates : unit -> unit + +(* In the user interface, it's helpful to know whether unison was started + with no archives. (Then we can display file status as 'unknown' rather + than 'new', which seems friendlier for new users.) This flag gets set + false by the crash recovery code when it determines that no archives were + present. *) +val foundArchives : bool ref + +(* Unlock the archives, if they are locked. *) +val unlockArchives : unit -> unit Lwt.t + +(* Translate a global path into a local path using the archive *) +val translatePath : Common.root -> Path.t -> Path.local Lwt.t +val translatePathLocal : Fspath.t -> Path.t -> Path.local + +(* Are we checking fast, or carefully? *) +val useFastChecking : unit -> bool + +(* Print the archive to the current formatter (see Format) *) +val showArchive: archive -> unit + Deleted: branches/2.32/src/uutil.ml =================================================================== --- trunk/src/uutil.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/uutil.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,128 +0,0 @@ -(* Unison file synchronizer: src/uutil.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(*****************************************************************************) -(* Unison name and version *) -(*****************************************************************************) - -let myName = ProjectInfo.myName - -let myVersion = ProjectInfo.myVersion - -let myMajorVersion = ProjectInfo.myMajorVersion - -let myNameAndVersion = myName ^ " " ^ myVersion - -(*****************************************************************************) -(* HASHING *) -(*****************************************************************************) - -let hash2 x y = (17 * x + 257 * y) land 0x3FFFFFFF - -(*****************************************************************************) -(* File sizes *) -(*****************************************************************************) - -module type FILESIZE = sig - type t - val zero : t - val dummy : t - val add : t -> t -> t - val sub : t -> t -> t - val toFloat : t -> float - val toString : t -> string - val ofInt : int -> t - val ofInt64 : int64 -> t - val toInt : t -> int - val toInt64 : t -> int64 - val fromStats : Unix.LargeFile.stats -> t - val hash : t -> int - val percentageOfTotalSize : t -> t -> float -end - -module Filesize : FILESIZE = struct - type t = int64 - let zero = Int64.zero - let dummy = Int64.minus_one - let add = Int64.add - let sub = Int64.sub - let toFloat = Int64.to_float - let toString = Int64.to_string - let ofInt x = Int64.of_int x - let ofInt64 x = x - let toInt x = Int64.to_int x - let toInt64 x = x - let fromStats st = st.Unix.LargeFile.st_size - let hash x = - hash2 (Int64.to_int x) (Int64.to_int (Int64.shift_right_logical x 31)) - let percentageOfTotalSize current total = - let total = toFloat total in - if total = 0. then 100.0 else - toFloat current *. 100.0 /. total -end - -(*****************************************************************************) -(* File tranfer progress display *) -(*****************************************************************************) - -module File = - struct - type t = int - let dummy = -1 - let ofLine l = l - let toLine l = assert (l <> dummy); l - let toString l = if l=dummy then "" else string_of_int l - end - -let progressPrinter = ref (fun _ _ _ -> ()) -let setProgressPrinter p = progressPrinter := p -let showProgress i bytes ch = - if i <> File.dummy then !progressPrinter i bytes ch - -(*****************************************************************************) -(* Copy bytes from one file_desc to another *) -(*****************************************************************************) - -let bufsize = 16384 -let bufsizeFS = Filesize.ofInt bufsize -let buf = String.create bufsize - -let readWrite source target notify = - let len = ref 0 in - let rec read () = - let n = input source buf 0 bufsize in - if n > 0 then begin - output target buf 0 n; - len := !len + n; - if !len > 100 * 1024 then begin - notify !len; - len := 0 - end; - read () - end else if !len > 0 then - notify !len - in - Util.convertUnixErrorsToTransient "readWrite" read - -let readWriteBounded source target len notify = - let l = ref 0 in - let rec read len = - if len > Filesize.zero then begin - let n = - input source buf 0 - (if len > bufsizeFS then bufsize else Filesize.toInt len) - in - if n > 0 then begin - let _ = output target buf 0 n in - l := !l + n; - if !l > 100 * 1024 then begin - notify !l; - l := 0 - end; - read (Filesize.sub len (Filesize.ofInt n)) - end else if !l > 0 then - notify !l - end else if !l > 0 then - notify !l - in - Util.convertUnixErrorsToTransient "readWriteBounded" (fun () -> read len) Copied: branches/2.32/src/uutil.ml (from rev 320, trunk/src/uutil.ml) =================================================================== --- branches/2.32/src/uutil.ml (rev 0) +++ branches/2.32/src/uutil.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,143 @@ +(* Unison file synchronizer: src/uutil.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +(*****************************************************************************) +(* Unison name and version *) +(*****************************************************************************) + +let myName = ProjectInfo.myName + +let myVersion = ProjectInfo.myVersion + +let myMajorVersion = ProjectInfo.myMajorVersion + +let myNameAndVersion = myName ^ " " ^ myVersion + +(*****************************************************************************) +(* HASHING *) +(*****************************************************************************) + +let hash2 x y = (17 * x + 257 * y) land 0x3FFFFFFF + +(*****************************************************************************) +(* File sizes *) +(*****************************************************************************) + +module type FILESIZE = sig + type t + val zero : t + val dummy : t + val add : t -> t -> t + val sub : t -> t -> t + val toFloat : t -> float + val toString : t -> string + val ofInt : int -> t + val ofInt64 : int64 -> t + val toInt : t -> int + val toInt64 : t -> int64 + val fromStats : Unix.LargeFile.stats -> t + val hash : t -> int + val percentageOfTotalSize : t -> t -> float +end + +module Filesize : FILESIZE = struct + type t = int64 + let zero = Int64.zero + let dummy = Int64.minus_one + let add = Int64.add + let sub = Int64.sub + let toFloat = Int64.to_float + let toString = Int64.to_string + let ofInt x = Int64.of_int x + let ofInt64 x = x + let toInt x = Int64.to_int x + let toInt64 x = x + let fromStats st = st.Unix.LargeFile.st_size + let hash x = + hash2 (Int64.to_int x) (Int64.to_int (Int64.shift_right_logical x 31)) + let percentageOfTotalSize current total = + let total = toFloat total in + if total = 0. then 100.0 else + toFloat current *. 100.0 /. total +end + +(*****************************************************************************) +(* File tranfer progress display *) +(*****************************************************************************) + +module File = + struct + type t = int + let dummy = -1 + let ofLine l = l + let toLine l = assert (l <> dummy); l + let toString l = if l=dummy then "" else string_of_int l + end + +let progressPrinter = ref (fun _ _ _ -> ()) +let setProgressPrinter p = progressPrinter := p +let showProgress i bytes ch = + if i <> File.dummy then !progressPrinter i bytes ch + +(*****************************************************************************) +(* Copy bytes from one file_desc to another *) +(*****************************************************************************) + +let bufsize = 16384 +let bufsizeFS = Filesize.ofInt bufsize +let buf = String.create bufsize + +let readWrite source target notify = + let len = ref 0 in + let rec read () = + let n = input source buf 0 bufsize in + if n > 0 then begin + output target buf 0 n; + len := !len + n; + if !len > 100 * 1024 then begin + notify !len; + len := 0 + end; + read () + end else if !len > 0 then + notify !len + in + Util.convertUnixErrorsToTransient "readWrite" read + +let readWriteBounded source target len notify = + let l = ref 0 in + let rec read len = + if len > Filesize.zero then begin + let n = + input source buf 0 + (if len > bufsizeFS then bufsize else Filesize.toInt len) + in + if n > 0 then begin + let _ = output target buf 0 n in + l := !l + n; + if !l > 100 * 1024 then begin + notify !l; + l := 0 + end; + read (Filesize.sub len (Filesize.ofInt n)) + end else if !l > 0 then + notify !l + end else if !l > 0 then + notify !l + in + Util.convertUnixErrorsToTransient "readWriteBounded" (fun () -> read len) Deleted: branches/2.32/src/uutil.mli =================================================================== --- trunk/src/uutil.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/uutil.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,65 +0,0 @@ -(* Unison file synchronizer: src/uutil.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* This module collects a number of low-level, Unison-specific utility - functions. It is kept separate from the Util module so that that module - can be re-used by other programs. *) - -(* Identification *) -val myMajorVersion : string -val myVersion : string -val myName : string -val myNameAndVersion : string - -(* Hashing *) -val hash2 : int -> int -> int - -module type FILESIZE = sig - type t - val zero : t - val dummy : t - val add : t -> t -> t - val sub : t -> t -> t - val toFloat : t -> float - val toString : t -> string - val ofInt : int -> t - val ofInt64 : int64 -> t - val toInt : t -> int - val toInt64 : t -> int64 - val fromStats : Unix.LargeFile.stats -> t - val hash : t -> int - val percentageOfTotalSize : t -> t -> float -end - -module Filesize : FILESIZE - -(* The UI may (if it likes) supply a function to be used to show progress of *) -(* file transfers. *) -module File : - sig - type t - val ofLine : int -> t - val toLine : t -> int - val toString : t -> string - val dummy : t - end -val setProgressPrinter : - (File.t -> Filesize.t -> string -> unit) -> unit -val showProgress : File.t -> Filesize.t -> string -> unit - -(* Utility function to transfer bytes from one file descriptor to another - until EOF *) -val readWrite : - in_channel (* source *) - -> out_channel (* target *) - -> (int -> unit) (* progress notification *) - -> unit - -(* Utility function to transfer a given number of bytes from one file - descriptor to another *) -val readWriteBounded : - in_channel (* source *) - -> out_channel (* target *) - -> Filesize.t - -> (int -> unit) (* progress notification *) - -> unit Copied: branches/2.32/src/uutil.mli (from rev 320, trunk/src/uutil.mli) =================================================================== --- branches/2.32/src/uutil.mli (rev 0) +++ branches/2.32/src/uutil.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,65 @@ +(* Unison file synchronizer: src/uutil.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +(* This module collects a number of low-level, Unison-specific utility + functions. It is kept separate from the Util module so that that module + can be re-used by other programs. *) + +(* Identification *) +val myMajorVersion : string +val myVersion : string +val myName : string +val myNameAndVersion : string + +(* Hashing *) +val hash2 : int -> int -> int + +module type FILESIZE = sig + type t + val zero : t + val dummy : t + val add : t -> t -> t + val sub : t -> t -> t + val toFloat : t -> float + val toString : t -> string + val ofInt : int -> t + val ofInt64 : int64 -> t + val toInt : t -> int + val toInt64 : t -> int64 + val fromStats : Unix.LargeFile.stats -> t + val hash : t -> int + val percentageOfTotalSize : t -> t -> float +end + +module Filesize : FILESIZE + +(* The UI may (if it likes) supply a function to be used to show progress of *) +(* file transfers. *) +module File : + sig + type t + val ofLine : int -> t + val toLine : t -> int + val toString : t -> string + val dummy : t + end +val setProgressPrinter : + (File.t -> Filesize.t -> string -> unit) -> unit +val showProgress : File.t -> Filesize.t -> string -> unit + +(* Utility function to transfer bytes from one file descriptor to another + until EOF *) +val readWrite : + in_channel (* source *) + -> out_channel (* target *) + -> (int -> unit) (* progress notification *) + -> unit + +(* Utility function to transfer a given number of bytes from one file + descriptor to another *) +val readWriteBounded : + in_channel (* source *) + -> out_channel (* target *) + -> Filesize.t + -> (int -> unit) (* progress notification *) + -> unit Deleted: branches/2.32/src/xferhint.ml =================================================================== --- trunk/src/xferhint.ml 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/xferhint.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -1,100 +0,0 @@ -(* Unison file synchronizer: src/xferhint.ml *) -(* Copyright 1999-2008 (see COPYING for details) *) - -let debug = Trace.debug "xferhint" - -let xferbycopying = - Prefs.createBool "xferbycopying" true - "!optimize transfers using local copies" - ("When this preference is set, Unison will try to avoid transferring " - ^ "file contents across the network by recognizing when a file with the " - ^ "required contents already exists in the target replica. This usually " - ^ "allows file moves to be propagated very quickly. The default value is" - ^ "\\texttt{true}. ") - -module PathMap = - Hashtbl.Make - (struct - type t = Fspath.t * Path.local - let hash (fspath, path) = - (Hashtbl.hash (Fspath.toString fspath) + 13217 * Path.hash path) - land - 0x3FFFFFFF - let equal = (=) - end) -module FPMap = - Hashtbl.Make - (struct - type t = Os.fullfingerprint - let hash = Hashtbl.hash - let equal = (=) - end) - -(* map(path, fingerprint) *) -let path2fingerprintMap = PathMap.create 101 -(* map(fingerprint, path) *) -let fingerprint2pathMap = FPMap.create 101 - -(* Now we don't clear it out anymore -let initLocal () = - debug (fun () -> Util.msg "initLocal\n"); - path2fingerprintMap := PathMap.empty; - fingerprint2pathMap := FPMap.empty -*) - -let lookup fp = - assert (Prefs.read xferbycopying); - debug (fun () -> - Util.msg "lookup: fp = %s\n" (Os.fullfingerprint_to_string fp)); - try - Some (FPMap.find fingerprint2pathMap fp) - with Not_found -> - None - -let insertEntry p fp = - if Prefs.read xferbycopying then begin - debug (fun () -> - let (fspath, path) = p in - Util.msg "insertEntry: fspath=%s, path=%s, fp=%s\n" - (Fspath.toString fspath) - (Path.toString path) (Os.fullfingerprint_to_string fp)); - (* Neither of these should be able to raise Not_found *) - PathMap.replace path2fingerprintMap p fp; - FPMap.replace fingerprint2pathMap fp p - end - -let deleteEntry p = - if Prefs.read xferbycopying then begin - debug (fun () -> - let (fspath, path) = p in - Util.msg "deleteEntry: fspath=%s, path=%s\n" - (Fspath.toString fspath) (Path.toString path)); - try - let fp = PathMap.find path2fingerprintMap p in - PathMap.remove path2fingerprintMap p; - let p' = FPMap.find fingerprint2pathMap fp in - (* Maybe we should do this unconditionally *) - if p' = p then FPMap.remove fingerprint2pathMap fp - with Not_found -> - () - end - -let renameEntry pOrig pNew = - if Prefs.read xferbycopying then begin - debug (fun () -> - let (fspathOrig, pathOrig) = pOrig in - let (fspathNew, pathNew) = pNew in - Util.msg "renameEntry: fsOrig=%s, pOrig=%s, fsNew=%s, pNew=%s\n" - (Fspath.toString fspathOrig) (Path.toString pathOrig) - (Fspath.toString fspathNew) (Path.toString pathNew)); - try - let fp = PathMap.find path2fingerprintMap pOrig in - PathMap.remove path2fingerprintMap pOrig; - PathMap.replace path2fingerprintMap pNew fp; - FPMap.replace fingerprint2pathMap fp pNew - with Not_found -> - () - end - -let _ = - Os.initializeXferFunctions deleteEntry renameEntry Copied: branches/2.32/src/xferhint.ml (from rev 320, trunk/src/xferhint.ml) =================================================================== --- branches/2.32/src/xferhint.ml (rev 0) +++ branches/2.32/src/xferhint.ml 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,115 @@ +(* Unison file synchronizer: src/xferhint.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + + +let debug = Trace.debug "xferhint" + +let xferbycopying = + Prefs.createBool "xferbycopying" true + "!optimize transfers using local copies" + ("When this preference is set, Unison will try to avoid transferring " + ^ "file contents across the network by recognizing when a file with the " + ^ "required contents already exists in the target replica. This usually " + ^ "allows file moves to be propagated very quickly. The default value is" + ^ "\\texttt{true}. ") + +module PathMap = + Hashtbl.Make + (struct + type t = Fspath.t * Path.local + let hash (fspath, path) = + (Hashtbl.hash (Fspath.toString fspath) + 13217 * Path.hash path) + land + 0x3FFFFFFF + let equal = (=) + end) +module FPMap = + Hashtbl.Make + (struct + type t = Os.fullfingerprint + let hash = Hashtbl.hash + let equal = (=) + end) + +(* map(path, fingerprint) *) +let path2fingerprintMap = PathMap.create 101 +(* map(fingerprint, path) *) +let fingerprint2pathMap = FPMap.create 101 + +(* Now we don't clear it out anymore +let initLocal () = + debug (fun () -> Util.msg "initLocal\n"); + path2fingerprintMap := PathMap.empty; + fingerprint2pathMap := FPMap.empty +*) + +let lookup fp = + assert (Prefs.read xferbycopying); + debug (fun () -> + Util.msg "lookup: fp = %s\n" (Os.fullfingerprint_to_string fp)); + try + Some (FPMap.find fingerprint2pathMap fp) + with Not_found -> + None + +let insertEntry p fp = + if Prefs.read xferbycopying then begin + debug (fun () -> + let (fspath, path) = p in + Util.msg "insertEntry: fspath=%s, path=%s, fp=%s\n" + (Fspath.toString fspath) + (Path.toString path) (Os.fullfingerprint_to_string fp)); + (* Neither of these should be able to raise Not_found *) + PathMap.replace path2fingerprintMap p fp; + FPMap.replace fingerprint2pathMap fp p + end + +let deleteEntry p = + if Prefs.read xferbycopying then begin + debug (fun () -> + let (fspath, path) = p in + Util.msg "deleteEntry: fspath=%s, path=%s\n" + (Fspath.toString fspath) (Path.toString path)); + try + let fp = PathMap.find path2fingerprintMap p in + PathMap.remove path2fingerprintMap p; + let p' = FPMap.find fingerprint2pathMap fp in + (* Maybe we should do this unconditionally *) + if p' = p then FPMap.remove fingerprint2pathMap fp + with Not_found -> + () + end + +let renameEntry pOrig pNew = + if Prefs.read xferbycopying then begin + debug (fun () -> + let (fspathOrig, pathOrig) = pOrig in + let (fspathNew, pathNew) = pNew in + Util.msg "renameEntry: fsOrig=%s, pOrig=%s, fsNew=%s, pNew=%s\n" + (Fspath.toString fspathOrig) (Path.toString pathOrig) + (Fspath.toString fspathNew) (Path.toString pathNew)); + try + let fp = PathMap.find path2fingerprintMap pOrig in + PathMap.remove path2fingerprintMap pOrig; + PathMap.replace path2fingerprintMap pNew fp; + FPMap.replace fingerprint2pathMap fp pNew + with Not_found -> + () + end + +let _ = + Os.initializeXferFunctions deleteEntry renameEntry Deleted: branches/2.32/src/xferhint.mli =================================================================== --- trunk/src/xferhint.mli 2009-04-29 14:36:48 UTC (rev 319) +++ branches/2.32/src/xferhint.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -1,18 +0,0 @@ -(* Unison file synchronizer: src/xferhint.mli *) -(* Copyright 1999-2008 (see COPYING for details) *) - -(* This module maintains a cache that can be used to map - an Os.fingerprint to a (Fspath.t * Path.t) naming a file that *may* - (if we are lucky) have this fingerprint. The cache is not guaranteed - to be reliable -- the things it returns are only hints, and must be - double-checked before they are used (to optimize file transfers). *) - -val xferbycopying: bool Prefs.t - -(* Suggest a file that's likely to have a given fingerprint *) -val lookup: Os.fullfingerprint -> (Fspath.t * Path.local) option - -(* Add, delete, and rename entries *) -val insertEntry: Fspath.t * Path.local -> Os.fullfingerprint -> unit -val deleteEntry: Fspath.t * Path.local -> unit -val renameEntry: Fspath.t * Path.local -> Fspath.t * Path.local -> unit Copied: branches/2.32/src/xferhint.mli (from rev 320, trunk/src/xferhint.mli) =================================================================== --- branches/2.32/src/xferhint.mli (rev 0) +++ branches/2.32/src/xferhint.mli 2009-05-02 02:31:27 UTC (rev 322) @@ -0,0 +1,18 @@ +(* Unison file synchronizer: src/xferhint.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +(* This module maintains a cache that can be used to map + an Os.fingerprint to a (Fspath.t * Path.t) naming a file that *may* + (if we are lucky) have this fingerprint. The cache is not guaranteed + to be reliable -- the things it returns are only hints, and must be + double-checked before they are used (to optimize file transfers). *) + +val xferbycopying: bool Prefs.t + +(* Suggest a file that's likely to have a given fingerprint *) +val lookup: Os.fullfingerprint -> (Fspath.t * Path.local) option + +(* Add, delete, and rename entries *) +val insertEntry: Fspath.t * Path.local -> Os.fullfingerprint -> unit +val deleteEntry: Fspath.t * Path.local -> unit +val renameEntry: Fspath.t * Path.local -> Fspath.t * Path.local -> unit From bcpierce at seas.upenn.edu Fri May 1 22:47:42 2009 From: bcpierce at seas.upenn.edu (Benjamin C. Pierce) Date: Fri, 1 May 2009 22:47:42 -0400 Subject: [Unison-hackers] [unison-svn] r323 - in branches/2.32: doc src Message-ID: <200905020247.n422lgol007306@yaws.seas.upenn.edu> Author: bcpierce Date: 2009-05-01 22:47:40 -0400 (Fri, 01 May 2009) New Revision: 323 Modified: branches/2.32/doc/unison-manual.tex branches/2.32/src/NEWS branches/2.32/src/RECENTNEWS branches/2.32/src/mkProjectInfo.ml branches/2.32/src/strings.ml Log: * Fix copyright date in manual Modified: branches/2.32/doc/unison-manual.tex =================================================================== --- branches/2.32/doc/unison-manual.tex 2009-05-02 02:31:27 UTC (rev 322) +++ branches/2.32/doc/unison-manual.tex 2009-05-02 02:47:40 UTC (rev 323) @@ -51,7 +51,7 @@ \LARGE% Version \unisonversion \\[4ex] % % \today % - \large Copyright 1998-2008, Benjamin C. Pierce + \large Copyright 1998-2009, Benjamin C. Pierce \end{center}% \fi% % Modified: branches/2.32/src/NEWS =================================================================== --- branches/2.32/src/NEWS 2009-05-02 02:31:27 UTC (rev 322) +++ branches/2.32/src/NEWS 2009-05-02 02:47:40 UTC (rev 323) @@ -1,13 +1,129 @@ -Changes in Version 2.32.1 +Changes in Version 2.32.9 + Changes since 2.31: + * Small user interface changes + + Small change to text UI "scanning..." messages, to print just + directories (hopefully making it clearer that individual + files are not necessarily being fingerprinted). + * Minor fixes and improvements: + + Ignore one hour differences when deciding whether a file may + have been updated. This avoids slow update detection after + daylight saving time changes under Windows. This makes Unison + slightly more likely to miss an update, but it should be safe + enough. + + Fix a small bug that was affecting mainly windows users. We + need to commit the archives at the end of the sync even if + there are 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. (Changed the + text UI only. It's less clear where to change the GUI.) + + Don't delete the temp file when a transfer fails due to a + fingerprint mismatch (so that we can have a look and see + why!) We've also added more debugging code togive more + informative error messages when we encounter the dreaded and + longstanding "assert failed during file transfer" bug + + Changes since 2.27: + * If Unison is interrupted during a directory transfer, it will now + leave the partially transferred directory intact in a temporary + location. (This maintains the invariant that new files/directories + are transferred either completely or not at all.) The next time + Unison is run, it will continue filling in this temporary + directory, skipping transferring files that it finds are already + there. + * We've added experimental support for invoking an external file + transfer tool for whole-file copies instead of Unison's built-in + transfer protocol. Three new preferences have been added: + + copyprog is a string giving the name (and command-line + switches, if needed) of an external program that can be used + to copy large files efficiently. By default, rsync is + invoked, but other tools such as scp can be used instead by + changing the value of this preference. (Although this is not + its primary purpose, rsync is actually a pretty fast way of + copying files that don't already exist on the receiving + host.) For files that do already exist on (but that have been + changed in one replica), Unison will always use its built-in + implementation of the rsync algorithm. + + Added a "copyprogrest" preference, so that we can give + different command lines for invoking the external copy + utility depending on whether a partially transferred file + already exists or not. (Rsync doesn't seem to care about + this, but other utilities may.) + + copythreshold is an integer (-1 by default), indicating above + what filesize (in megabytes) Unison should use the external + copying utility specified by copyprog. Specifying 0 will + cause ALL copies to use the external program; a negative + number will prevent any files from using it. (Default is -1.) + Thanks to Alan Schmitt for a huge amount of hacking and to an + anonymous sponsor for suggesting and underwriting this extension. + * Small improvements: + + Added a new preference, dontchmod. By default, Unison uses + the chmod system call to set the permission bits of files + after it has copied them. But in some circumstances (and + under some operating systems), the chmod call always fails. + Setting this preference completely prevents Unison from ever + calling chmod. + + Don't ignore files that look like backup files if the + backuplocation preference is set to central + + Shortened the names of several preferences. The old names are + also still supported, for backwards compatibility, but they + do not appear in the documentation. + + Lots of little documentation tidying. (In particular, + preferences are separated into Basic and Advanced! This + should hopefully make Unison a little more approachable for + new users. + + Unison can sometimes fail to transfer a file, giving the + unhelpful message "Destination updated during + synchronization" even though the file has not been changed. + This can be caused by programs that change either the file's + contents or the file's extended attributes without changing + its modification time. It's not clear what is the best fix + for this - it is not Unison's fault, but it makes Unison's + behavior puzzling - but at least Unison can be more helpful + about suggesting a workaround (running once with fastcheck + set to false). The failure message has been changed to give + this advice. + + Further improvements to the OS X GUI (thanks to Alan Schmitt + and Craig Federighi). + * Very preliminary support for triggering Unison from an external + filesystem-watching utility. The current implementation is very + simple, not efficient, and almost completely untested--not ready + for real users. But if someone wants to help improve it (e.g., by + writing a filesystem watcher for your favorite OS), please make + yourself known! + On the Unison side, the new behavior is very simple: + + use the text UI + + start Unison with the command-line flag "-repeat FOO", where + FOO is name of a file where Unison should look for + notifications of changes + + when it starts up, Unison will read the whole contents of + this file (on both hosts), which should be a + newline-separated list of paths (relative to the root of the + synchronization) and synchronize just these paths, as if it + had been started with the "-path=xxx" option for each one of + them + + when it finishes, it will sleep for a few seconds and then + examine the watchfile again; if anything has been added, it + will read the new paths, synchronize them, and go back to + sleep + + that's it! + To use this to drive Unison "incrementally," just start it in this + mode and start up a tool (on each host) to watch for new changes + to the filesystem and append the appropriate paths to the + watchfile. Hopefully such tools should not be too hard to write. + * Bug fixes: + + Fixed a bug that was causing new files to be created with + permissions 0x600 instead of using a reasonable default (like + 0x644), if the 'perms' flag was set to 0. (Bug reported by + Ben Crowell.) + + Follow maxthreads preference when transferring directories. + Changes since 2.17: * Major rewrite and cleanup of the whole Mac OS X graphical user interface by Craig Federighi. Thanks, Craig!!! * Small fix to ctime (non-)handling in update detection under windows with fastcheck. - - Changes since 2.17: * Several small fixes to the GTK2 UI to make it work better under Windows [thanks to Karl M for these]. * The backup functionality has been completely rewritten. The @@ -433,13 +549,10 @@ * Fixed potential deadlock when synchronizing between Windows and Unix * Small improvements: - + If neither the - tt USERPROFILE nor the - tt HOME environment variables are set, then Unison will put - its temporary commit log (called - tt DANGER.README) into the directory named by the - tt UNISON environment variable, if any; otherwise it will use - tt C:. + + If neither the USERPROFILE nor the HOME environment variables + are set, then Unison will put its temporary commit log + (called DANGER.README) into the directory named by the UNISON + environment variable, if any; otherwise it will use C:. + alternative set of values for fastcheck: yes = true; no = false; default = auto. + -silent implies -contactquietly @@ -486,9 +599,8 @@ + Paths that are not synchronized because of conflicts or errors during update detection are now noted in the log file. + [END] messages in log now use a briefer format - + Changed the text UI startup sequence so that - tt ./unison -ui text will use the default profile instead of - failing. + + Changed the text UI startup sequence so that ./unison -ui + text will use the default profile instead of failing. + Made some improvements to the error messages. + Added some debugging messages to remote.ml. Modified: branches/2.32/src/RECENTNEWS =================================================================== --- branches/2.32/src/RECENTNEWS 2009-05-02 02:31:27 UTC (rev 322) +++ branches/2.32/src/RECENTNEWS 2009-05-02 02:47:40 UTC (rev 323) @@ -1,3 +1,7 @@ +CHANGES FROM VERSION 2.32.9 + +* Fix copyright date in manual +------------------------------- CHANGES FROM VERSION 2.32.7 * Move descriptions of recent changes to documentation. Modified: branches/2.32/src/mkProjectInfo.ml =================================================================== --- branches/2.32/src/mkProjectInfo.ml 2009-05-02 02:31:27 UTC (rev 322) +++ branches/2.32/src/mkProjectInfo.ml 2009-05-02 02:47:40 UTC (rev 323) @@ -105,3 +105,4 @@ + Modified: branches/2.32/src/strings.ml =================================================================== --- branches/2.32/src/strings.ml 2009-05-02 02:31:27 UTC (rev 322) +++ branches/2.32/src/strings.ml 2009-05-02 02:47:40 UTC (rev 323) @@ -4,7 +4,7 @@ let docs = ("about", ("About Unison", "Unison File Synchronizer\n\ - Version 2.32.7\n\ + Version 2.32.9\n\ \n\ ")) :: @@ -2582,8 +2582,8 @@ \n\ ")) :: - ("news", ("Changes in Version 2.32.7", - "Changes in Version 2.32.7\n\ + ("news", ("Changes in Version 2.32.9", + "Changes in Version 2.32.9\n\ \n\ \032 Changes since 2.31:\n\ \032 * Small user interface changes\n\ @@ -2668,9 +2668,8 @@ \032 about suggesting a workaround (running once with fastcheck\n\ \032 set to false). The failure message has been changed to give\n\ \032 this advice.\n\ - \032 + Many improvements to the OS X GUI (thanks to Alan Schmitt and\n\ - \032 Craig Federighi), including a very nice new \"nested\n\ - \032 directory\" display style and per-file progress bars.\n\ + \032 + Further improvements to the OS X GUI (thanks to Alan Schmitt\n\ + \032 and Craig Federighi).\n\ \032 * Very preliminary support for triggering Unison from an external\n\ \032 filesystem-watching utility. The current implementation is very\n\ \032 simple, not efficient, and almost completely untested--not ready\n\ @@ -4036,7 +4035,7 @@ \n\ References\n\ \n\ - \032 1. file://localhost/Users/bcpierce/current/unison/trunk/doc/temp.html#ssh-win\n\ + \032 1. file://localhost/Users/bcpierce/current/unison/branches/2.32/doc/temp.html#ssh-win\n\ \032 2. http://pauillac.inria.fr/~maranget/hevea/index.html\n\ ")) :: From bcpierce at cis.upenn.edu Fri May 1 22:53:48 2009 From: bcpierce at cis.upenn.edu (Benjamin Pierce) Date: Fri, 1 May 2009 22:53:48 -0400 Subject: [Unison-hackers] Version 2.32 now the official beta-release Message-ID: I'll post an announcement to unison-users and unison-announce in a few days. In the meantime, this would be a good time for people that provide binaries to turn the crank... Best, - B From bcpierce at seas.upenn.edu Sat May 2 20:19:31 2009 From: bcpierce at seas.upenn.edu (Benjamin C. Pierce) Date: Sat, 2 May 2009 20:19:31 -0400 Subject: [Unison-hackers] [unison-svn] r324 - branches/2.32/src Message-ID: <200905030019.n430JVQA021326@yaws.seas.upenn.edu> Author: bcpierce Date: 2009-05-02 20:19:28 -0400 (Sat, 02 May 2009) New Revision: 324 Modified: branches/2.32/src/NEWS branches/2.32/src/RECENTNEWS branches/2.32/src/mkProjectInfo.ml branches/2.32/src/strings.ml branches/2.32/src/update.ml Log: * Backed out last month's change to progress reporting during update detection: in the text UI, it prints annoyingly many files; in the GUI, it makes the progress bar race back and forth too fast. Better the way it was. Modified: branches/2.32/src/NEWS =================================================================== --- branches/2.32/src/NEWS 2009-05-02 02:47:40 UTC (rev 323) +++ branches/2.32/src/NEWS 2009-05-03 00:19:28 UTC (rev 324) @@ -1,5 +1,5 @@ -Changes in Version 2.32.9 +Changes in Version 2.32.10 Changes since 2.31: * Small user interface changes Modified: branches/2.32/src/RECENTNEWS =================================================================== --- branches/2.32/src/RECENTNEWS 2009-05-02 02:47:40 UTC (rev 323) +++ branches/2.32/src/RECENTNEWS 2009-05-03 00:19:28 UTC (rev 324) @@ -1,3 +1,13 @@ +CHANGES FROM VERSION 2.32.10 + +* Backed out last month's change to progress reporting during update + detection: in the text UI, it prints annoyingly many files; in the + GUI, it makes the progress bar race back and forth too fast. Better + the way it was. + + + +------------------------------- CHANGES FROM VERSION 2.32.9 * Fix copyright date in manual Modified: branches/2.32/src/mkProjectInfo.ml =================================================================== --- branches/2.32/src/mkProjectInfo.ml 2009-05-02 02:47:40 UTC (rev 323) +++ branches/2.32/src/mkProjectInfo.ml 2009-05-03 00:19:28 UTC (rev 324) @@ -106,3 +106,4 @@ + Modified: branches/2.32/src/strings.ml =================================================================== --- branches/2.32/src/strings.ml 2009-05-02 02:47:40 UTC (rev 323) +++ branches/2.32/src/strings.ml 2009-05-03 00:19:28 UTC (rev 324) @@ -4,7 +4,7 @@ let docs = ("about", ("About Unison", "Unison File Synchronizer\n\ - Version 2.32.9\n\ + Version 2.32.10\n\ \n\ ")) :: @@ -2582,8 +2582,8 @@ \n\ ")) :: - ("news", ("Changes in Version 2.32.9", - "Changes in Version 2.32.9\n\ + ("news", ("Changes in Version 2.32.10", + "Changes in Version 2.32.10\n\ \n\ \032 Changes since 2.31:\n\ \032 * Small user interface changes\n\ Modified: branches/2.32/src/update.ml =================================================================== --- branches/2.32/src/update.ml 2009-05-02 02:47:40 UTC (rev 323) +++ branches/2.32/src/update.ml 2009-05-03 00:19:28 UTC (rev 324) @@ -1002,56 +1002,57 @@ (** Status display **) -(* BCP (3/09) We used to try to be smart about showing status messages - at regular intervals, but people seem to find this confusing. - Let's replace all this with something simpler -- just show directories as - they are scanned... (but I'll leave the code in for now, in case we find - we want to restore the old behavior). *) -(* - let bigFileLength = 10 * 1024 - let bigFileLengthFS = Uutil.Filesize.ofInt bigFileLength - let smallFileLength = 1024 - let fileLength = ref 0 - let t0 = ref 0. +let bigFileLength = 10 * 1024 +let bigFileLengthFS = Uutil.Filesize.ofInt bigFileLength +let smallFileLength = 1024 +let fileLength = ref 0 +let t0 = ref 0. - (* Note that we do *not* want to do any status displays from the server - side, since this will cause the server to block until the client has - finished its own update detection and can receive and acknowledge - the status display message -- thus effectively serializing the client - and server! *) - let showStatusAddLength info = - if not !Trace.runningasserver then begin - let len1 = Props.length info.Fileinfo.desc in - let len2 = Osx.ressLength info.Fileinfo.osX.Osx.ressInfo in - if len1 >= bigFileLengthFS || len2 >= bigFileLengthFS then - fileLength := bigFileLength - else - fileLength := - min bigFileLength - (!fileLength + Uutil.Filesize.toInt len1 + Uutil.Filesize.toInt len2) - end +(* Note that we do *not* want to do any status displays from the server + side, since this will cause the server to block until the client has + finished its own update detection and can receive and acknowledge + the status display message -- thus effectively serializing the client + and server! *) +let showStatusAddLength info = + if not !Trace.runningasserver then begin + let len1 = Props.length info.Fileinfo.desc in + let len2 = Osx.ressLength info.Fileinfo.osX.Osx.ressInfo in + if len1 >= bigFileLengthFS || len2 >= bigFileLengthFS then + fileLength := bigFileLength + else + fileLength := + min bigFileLength + (!fileLength + Uutil.Filesize.toInt len1 + Uutil.Filesize.toInt len2) + end - let showStatus path = - if not !Trace.runningasserver then begin - fileLength := !fileLength + smallFileLength; - if !fileLength >= bigFileLength then begin - fileLength := 0; - let t = Unix.gettimeofday () in - if t -. !t0 > 0.05 then begin - Trace.statusDetail ("scanning... got to " ^ Path.toString path); - t0 := t - end +let showStatus path = + if not !Trace.runningasserver then begin + fileLength := !fileLength + smallFileLength; + if !fileLength >= bigFileLength then begin + fileLength := 0; + let t = Unix.gettimeofday () in + if t -. !t0 > 0.05 then begin + Trace.statusDetail ("scanning... " ^ Path.toString path); + t0 := t end end -*) + end +let showStatusDir path = () + +(* BCP (4/09) The code above tries to be smart about showing status messages + at regular intervals, but people seem to find this confusing. + I tried replace all this with something simpler -- just show directories as + they are scanned -- but this seems worse: it prints far too much stuff. + So I'm going to revert to the old version. *) +(* let showStatus path = () let showStatusAddLength info = () - let showStatusDir path = if not !Trace.runningasserver then begin Trace.statusDetail ("scanning... " ^ Path.toString path); end +*) (* ------- *) From bcpierce at seas.upenn.edu Sat May 2 20:20:32 2009 From: bcpierce at seas.upenn.edu (Benjamin C. Pierce) Date: Sat, 2 May 2009 20:20:32 -0400 Subject: [Unison-hackers] [unison-svn] r325 - in branches/2.32: doc src Message-ID: <200905030020.n430KWRe021386@yaws.seas.upenn.edu> Author: bcpierce Date: 2009-05-02 20:20:31 -0400 (Sat, 02 May 2009) New Revision: 325 Modified: branches/2.32/doc/changes.tex branches/2.32/src/RECENTNEWS branches/2.32/src/mkProjectInfo.ml Log: * Fix up docs. Modified: branches/2.32/doc/changes.tex =================================================================== --- branches/2.32/doc/changes.tex 2009-05-03 00:19:28 UTC (rev 324) +++ branches/2.32/doc/changes.tex 2009-05-03 00:20:31 UTC (rev 325) @@ -1,10 +1,4 @@ \begin{changesfromversion}{2.31} -\item Small user interface changes -\begin{itemize} -\item Small change to text UI "scanning..." messages, to print just - directories (hopefully making it clearer that individual files are - not necessarily being fingerprinted). -\end{itemize} \item Minor fixes and improvements: \begin{itemize} \item Ignore one hour differences when deciding whether a file may have Modified: branches/2.32/src/RECENTNEWS =================================================================== --- branches/2.32/src/RECENTNEWS 2009-05-03 00:19:28 UTC (rev 324) +++ branches/2.32/src/RECENTNEWS 2009-05-03 00:20:31 UTC (rev 325) @@ -1,20 +1,8 @@ -CHANGES FROM VERSION 2.32.10 +CHANGES FROM VERSION 2.32.11 -* Backed out last month's change to progress reporting during update - detection: in the text UI, it prints annoyingly many files; in the - GUI, it makes the progress bar race back and forth too fast. Better - the way it was. +* Fix up docs. -------------------------------- -CHANGES FROM VERSION 2.32.9 -* Fix copyright date in manual ------------------------------- -CHANGES FROM VERSION 2.32.7 - -* Move descriptions of recent changes to documentation. - - -------------------------------- Modified: branches/2.32/src/mkProjectInfo.ml =================================================================== --- branches/2.32/src/mkProjectInfo.ml 2009-05-03 00:19:28 UTC (rev 324) +++ branches/2.32/src/mkProjectInfo.ml 2009-05-03 00:20:31 UTC (rev 325) @@ -107,3 +107,4 @@ + From bcpierce at cis.upenn.edu Sat May 2 22:55:56 2009 From: bcpierce at cis.upenn.edu (Benjamin Pierce) Date: Sat, 2 May 2009 22:55:56 -0400 Subject: [Unison-hackers] [unison-users] Re: Broken unicode handling in unison 2.27.57 In-Reply-To: <49FB37CF.5080800@gmx.net> References: <49ECAF35.1020505@gmx.net> <07446779-E134-4363-AFB6-C4168981E9EC@cis.upenn.edu> <49FAA627.1090909@gmx.net> <49FB37CF.5080800@gmx.net> Message-ID: <4CEFE5C1-C567-4612-8E1E-0F79CCD069CC@cis.upenn.edu> > Benjamin Pierce wrote: >> I'm not an expert on unicode, character set, or internationalization >> issues, so I'm afraid I can't be much use here. > > I guess I could provide the required input here. I mainly need a guide > around the Unison codebase and some OCaml features, so that I can find > out points of interest quickly without understanding the bulk of > Unison. I can try to help with this, but probably best if you post to unison- hackers instead of emailing me directly, since there are other people there that may be able to help if I'm away from mail. > Crash course for the issues at hand, not only for you, but for future > reference as well. SKip this for now if you want. > ... Very useful -- thank you for all that. >> But, as I've heard from >> other people and as you comment below, a clean solution seems to >> require >> changes in many places, which to my mind means beginning with a paper >> design that specifies what behavior is intended in all cases. > > In the long run, it might be good to have such a paper in some place > other than this mailthread, e.g. on launchpad (as a blueprint) or in > some wiki. For now, I'll simply start here. > > What we have: > > A) Windows > * case insensitive (though case preserving) > * UTF-16 file names => full unicode support > * Unicode-enabled and legacy system calls > * no Unicode normalization enforced, NFC customary > B) Linux > * case sensitive (on most mount types) > * Octet-based file names => interpretation not fixed > * encoding derived from environment (LC_CTYPE, setlocale(3)) > * no Unicode normalization enforced, NFC customary > C) OS X > * case insensitive (case sensitive variant available as well) > * Octet-based file names, encoded using UTF-8 NFD > * Unicode normalization using NFD enforced > > What do we want? I'll include the case issues along with the > normalization issues in order to draw parallels. > > 1. No unneccessary modifications between systems with the same > capabilities. Upper-/Lowercase names which are equal in terms of case > should be transported all right between case-sensitive systems. > Mixtures > of precomposed and decomposed glyphs should be transferred without > modification between systems not enforcing NFD. > > 2. Error messages for conflicting names. Synchronizing two names > differing only in case to a case insensitive system will cause an > error > to be printed. Synchronizing two names with the same normal form to a > system enforcing NFD will cause an error to be printed. > > 3. New files created to target policy. When synchronizing a new file > from an NFD macintosh to some other system, the file should be created > in its NFC form, which follows custom and makes access to the file > through the user interface easier. > > 4. Existing files keep their name. When synchronizing between two > hosts, > one of which enforces NFD and the other does not, and when there is > one > file on each system such that the normal forms of the names are equal, > then the contents of the files should be synchronized, and the file > names left as is, even if one of them is not normalized at all. The > same > should hold for case, by the way, but I'm not sure if it does. > > 5. Unmappable characters cause an error. If the target system doesn't > use Unicode, and a file to be synchronized contains some character > outside the supported charset of the target system, then an error > should > be reported. > > 6. The Graphical user interface should correctly display unicode > characters. This might involve some investigation of the underlying > libraries and the corresponding OCaml bindings. > > 7. The Text user interface should correctly display unicode > characters. > I'm not sure how much trouble it is to turn a windows command prompt > to > unicode mode from within an OCaml program. If it's too much effort, > some > kind of replacement character might be printed instead. > > 8. The filesystem should be accessed using either standard > interfaces of > the underlying platform, or some (portable or OCaml-friendly) > implementation that behaves in the same way. This means Unicode > Windows > API calls, setlocale(LC_CTYPE, "") on Linux, and probably some Cocoa > stuff for Macintosh. > > 9. Normalization should at least generate valid HFS+ names. The HFS+ > standard contains its own description of a NFD normalization > algorithm, > complete with full replacement tables. This is basically a frozen > snapshot of the Unicode NFD specification, which will guarantee that > the > set of valid file names won't change as Unicode develops. As an > absolute > minimum, emplying those conversions will result in valid names and > thus > allow the file to be stored under that name. Using some evolving NFD > implementation, like camomile probably does, has the benefit of > following a platforms policy even when it's not enforced, and thus > (according to 3. above) is preferable to a minimal normalization. In > that case, duplicate files with same normal form (as discussed in 2. > above) might occur even on the Mac side of a synchronization. This all seems reasonable, though obviously there are many issues to be considered and I don't feel I understand them deeply. One thing that I would add is that there should be a switch that completely disables all handling of unicode, etc., and produces exactly the current behavior. >>> Things that I can think of might require improvement: >>> 1. The position of the change. Is Case.normalize the correct place? >>> 2. The depndency. Is using camomile acceptable, or do we require >>> our own >>> implementation of unicode normalization? >>> 3. Use of findlib. While I guess the use of findlib for camomile >>> makes >>> the build more portable, it might be cleaner to switch the whole >>> unison build to findlib. On the other hand, if you want to keep >>> build >>> time deps to a minimum, findlib shouldn't be used at all. >>> 4. The handling of compilation alternatives. Is providing two files >>> "unicode.ml" in two different directories an acceptable way to >>> provide and link to optional code? >> >> I can only comment on 2, 3, and 4 at the moment: > > Sad, the placement of the hook is my primary concern right now. Does > the > above crash course and specification draft enable you to provide > useful > pointers as to where this behaviour should be placed? Otherwise I > guess > I'll simply have to have a closer lok as how case sensitivity is > handled, and try to duplicate parts of that. One problem here is that the case insensitivity handling was mostly coded by other people, and I have never understood the details completely. Hopefully some of them can chime in. Case.normalize does seem like an appropriate place, but there also seems to be some trickiness in the Path module, which distinguishes "global" (case-normalized) and "local" (case-insensitive iff local replica is case-insentitive) paths in the replica. Another thing to look at is how filenames are transferred across the network when new files are being created. Another is the way filenames are printed when they are being passed to external tools like merging or remote-copying programs. >> For 4, providing two alternate unicode.ml files seems reasonable. >> Another alternative that may be reasonable is to include a snapshot >> of >> the camomile distribution in the unison distribution. > > Would be feasible in terms of license, as camomile is LGPL-2. The size > of camomile, in terms of tar bundle file size, is several times that > of > unison, though, so I don't know if you want to add that to unison. The size is not such a big deal -- I mainly worry about dependencies and about complicating the build process. It seems that camomile is pretty much a standalone package, so adding it to Unison might not be bad, but perhaps it's safest from the point of view of stability to keep camomile outside of unison and make sure the unison build process works whether or not camomile is present. >> If someone (or a group of people) steps up and volunteers to design >> and >> implement a clean solution, and if partial versions need to be stored >> someplace while the project is underway, I'll be happy to discuss >> finding a home for them either in a branch of the unison repository >> or >> in a separate repository on U. Penn's svn server. > > As I said, I think I can implement the normalization stuff, but I'll > need some guide around the Unison codebase, else it will take more > time > than I have to get my bearings. Some kind of instant messaging contact > or someone present regularly on IRC would be great. > > I like Russels suggestion about Launchpad. Before I start pushing my > own > branches there, I think it would be a good idea to register Unison > as is > with launchpad. Maybe it would be better if some core developer > would do > this, so that it dosn't look like it's my project. > > It would also be good to have a clone of the subversion repository on > launchpad as a bzr branch. Theoretically, launchpad has a feature to > import subversion repositories on a regular basis, but they use some > one-way mechanism, which doesn't allow the changes from other branches > to be merged back into the subversion tree. The bzr-svn plugin does > provide this functionality. Would it be possible to place a post- > commit > hook on the subversion server, in order to push each commit to > launchpad? Or have a cron job do this? If you want, I can figure out > and > write down required commands from the bzr side of things. > > I guess it would be good to have a group called unison on > subversion, so > that the branches can be associated with that group, instead of > individual developers. I believe this should also be the foundation of > branches with write access for multiple people, but I haven't tried > that > yet. I'd be happy to be part of such a group. I'm willing to help with repository issues, but I'd prefer to wait a little till it's clear that this project is making progress before sinking a lot of time into setting things up. Would it make sense just to take a copy of the sources, put it somewhere convenient for collaboration among whoever is interested in this, let things run for a little while, and then synchronize the two replicas and set up a way of keeping them in sync? Best, - Benjamin P.S. Since the discussion is getting pretty technical, I suggest we move it to the unison-hackers list. I'll cross-post this there so you can just "reply all" and then edit headers. (You'll need to sign up for that list, but you should do that anyway, since it's where commit logs get sent.) From der.claudio at aon.at Mon May 4 10:42:51 2009 From: der.claudio at aon.at (Claudio) Date: Mon, 4 May 2009 16:42:51 +0200 Subject: [Unison-hackers] the unison [0-9]*.* bug In-Reply-To: <035A1033-238A-41CA-B9F5-F78F7020C0DB@cis.upenn.edu> References: <20090428213242.GA10329@aon.at> <035A1033-238A-41CA-B9F5-F78F7020C0DB@cis.upenn.edu> Message-ID: <20090504144251.GA6730@aon.at> Thanks, that's right. When unsetting my backup options and running unison again, it didn't leave out any files. My prior backup settings are as follows. ,--- | backuplocation = central | backupdir = /home/claudio/.unison/backup | backup = Name * | backupprefix = $VERSION. | backupsuffix = `--- There is no logical reason for assuming that any file outside the 'backupdir' is a backup file (and to ignore it though not told to do so by ignore directives). Nor is this behaviour documented. IMO that is a bug. Claudio On Tue, Apr 28, 2009 at 05:40:29PM -0400, Benjamin Pierce wrote: > Probably you have a "backup" preference set to something beginning > with the backup prefix (which is a number). Unison tries to ignore > backup files... > > - B > > On Apr 28, 2009, at 5:32 PM, Claudio wrote: > > I've encountered the behaviour that unison ignores some files even if > > there isn't a single "ignore" directive(!). For example those files > > are > > affected: > > > > 1237678487.000102.mbox:2,S > > 20._Geburtstag > > 05.HTM > > 400.html > > 04.03.tar.gz > > 2. > > 3.3 > > 4.foo > > 55.bar > > > > unison version 2.27.57 (shipped with ubuntu) > > > > So it doesnt sync my mails in ~/Maildir and a huge amount other > > documents. I found a creepy workaround: > > > > ignorenot = Name [0-9]*.* From bcpierce at cis.upenn.edu Mon May 4 11:07:30 2009 From: bcpierce at cis.upenn.edu (Benjamin Pierce) Date: Mon, 4 May 2009 11:07:30 -0400 Subject: [Unison-hackers] the unison [0-9]*.* bug In-Reply-To: <20090504144251.GA6730@aon.at> References: <20090428213242.GA10329@aon.at> <035A1033-238A-41CA-B9F5-F78F7020C0DB@cis.upenn.edu> <20090504144251.GA6730@aon.at> Message-ID: Yes. I believe it's fixed in the new beta release. - B On May 4, 2009, at 10:42 AM, Claudio wrote: > Thanks, that's right. When unsetting my backup options and running > unison again, it didn't leave out any files. > > My prior backup settings are as follows. > ,--- > | backuplocation = central > | backupdir = /home/claudio/.unison/backup > | backup = Name * > | backupprefix = $VERSION. > | backupsuffix = > `--- > > There is no logical reason for assuming that any file outside the > 'backupdir' is a backup file (and to ignore it though not told to do > so > by ignore directives). Nor is this behaviour documented. > > IMO that is a bug. > > Claudio > > On Tue, Apr 28, 2009 at 05:40:29PM -0400, Benjamin Pierce wrote: >> Probably you have a "backup" preference set to something beginning >> with the backup prefix (which is a number). Unison tries to ignore >> backup files... >> >> - B >> >> On Apr 28, 2009, at 5:32 PM, Claudio wrote: >>> I've encountered the behaviour that unison ignores some files even >>> if >>> there isn't a single "ignore" directive(!). For example those files >>> are >>> affected: >>> >>> 1237678487.000102.mbox:2,S >>> 20._Geburtstag >>> 05.HTM >>> 400.html >>> 04.03.tar.gz >>> 2. >>> 3.3 >>> 4.foo >>> 55.bar >>> >>> unison version 2.27.57 (shipped with ubuntu) >>> >>> So it doesnt sync my mails in ~/Maildir and a huge amount other >>> documents. I found a creepy workaround: >>> >>> ignorenot = Name [0-9]*.* > _______________________________________________ > Unison-hackers mailing list > Unison-hackers at lists.seas.upenn.edu > http://lists.seas.upenn.edu/mailman/listinfo/unison-hackers From Martin.vGagern at gmx.net Mon May 4 12:21:09 2009 From: Martin.vGagern at gmx.net (Martin von Gagern) Date: Mon, 04 May 2009 18:21:09 +0200 Subject: [Unison-hackers] Unison on launchpad (was: [unison-users] Broken unicode handling in unison 2.27.57) In-Reply-To: <4CEFE5C1-C567-4612-8E1E-0F79CCD069CC@cis.upenn.edu> References: <49ECAF35.1020505@gmx.net> <07446779-E134-4363-AFB6-C4168981E9EC@cis.upenn.edu> <49FAA627.1090909@gmx.net> <49FB37CF.5080800@gmx.net> <4CEFE5C1-C567-4612-8E1E-0F79CCD069CC@cis.upenn.edu> Message-ID: <49FF15F5.3090707@gmx.net> Hi! Benjamin Pierce wrote: > I'm willing to help with repository issues, but I'd prefer to wait a > little till it's clear that this project is making progress before > sinking a lot of time into setting things up. Would it make sense just > to take a copy of the sources, put it somewhere convenient for > collaboration among whoever is interested in this, let things run for a > little while, and then synchronize the two replicas and set up a way of > keeping them in sync? Russel Winder was so kind to create the unison group and project on launchpad.net, and I've uploaded a bzr-svn import of the repository. I think I'll keep that in sync manually for now, and when this works out ask you to automate the synchronization. The project page: https://launchpad.net/unison The developer team: https://launchpad.net/~unison Available bzr branches: https://code.launchpad.net/unison The build relies on svn keyword substitution to keep track of the current version number. bzr doesn't replace keywords by default, and has a different idea of revision numbers as well, as they are per branch, not per repository. I've attached a patch that deals with the situation by finding the bzr revision number corresponding to the origin svn revision, and starts counting from there. Should not cause trouble for developers using svn, as it only gets called when the keyword isn't expanded. I've also improved behaviour of the build in case the mkProjectInfo build fails. Without modification, this can lead to an empty Makefile.ProjectInfo causing an empty $(NAME) and thus an empty dependency in "buildexecutable:: $(NAME)$(EXEC_EXT)", so nothing was build, and no error was signaled. Now I'm deleting files on error, and depending on Makefile.ProjectInfo, so the build will fail. Are you willing to merge this patch into the main unison trunk, or should it exist as a separate branch on launchpad? I'd prefer a merge. > P.S. Since the discussion is getting pretty technical, I suggest we > move it to the unison-hackers list. I'll cross-post this there so you > can just "reply all" and then edit headers. (You'll need to sign up for > that list, but you should do that anyway, since it's where commit logs > get sent.) Fine with me. And those commit messages will help me keep stuff in sync, I believe. I guess I'll soon get back to you with a wishlist of stuff I want explained. Just a note for now: I found out Glib.Utf8 provides a normalize function, so I might end up using that instead of camomile. Greetings, Martin -------------- next part -------------- An embedded and charset-unspecified text was scrubbed... Name: bzrbuild-260.patch Url: http://lists.seas.upenn.edu/pipermail/unison-hackers/attachments/20090504/dc5cb84c/bzrbuild-260-0001.txt -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 261 bytes Desc: OpenPGP digital signature Url : http://lists.seas.upenn.edu/pipermail/unison-hackers/attachments/20090504/dc5cb84c/signature-0001.sig From vouillon at seas.upenn.edu Mon May 4 14:48:29 2009 From: vouillon at seas.upenn.edu (vouillon@seas.upenn.edu) Date: Mon, 4 May 2009 14:48:29 -0400 Subject: [Unison-hackers] [unison-svn] r326 - in trunk/src: . ubase Message-ID: <200905041848.n44ImTtK018660@yaws.seas.upenn.edu> Author: vouillon Date: 2009-05-04 14:48:23 -0400 (Mon, 04 May 2009) New Revision: 326 Added: trunk/src/unicode.ml trunk/src/unicode.mli trunk/src/unicode_tables.ml Modified: trunk/src/.depend trunk/src/Makefile.OCaml trunk/src/RECENTNEWS trunk/src/case.ml trunk/src/case.mli trunk/src/mkProjectInfo.ml trunk/src/name.ml trunk/src/name.mli trunk/src/path.ml trunk/src/pred.ml trunk/src/ubase/depend trunk/src/update.ml Log: * Updated list of bad Windows file names following the MSDN documentation (in particular, files with trailing dots are now rejected when synchronizing with a Windows machine) * Experimental Unicode-aware case insensitive mode. It is activated when the preference "unicode" is set to true and Unison is in case-insensitive mode. * Bumped version number to reflect the newly added preference Modified: trunk/src/.depend =================================================================== --- trunk/src/.depend 2009-05-03 00:20:31 UTC (rev 325) +++ trunk/src/.depend 2009-05-04 18:48:23 UTC (rev 326) @@ -1,37 +1,52 @@ abort.cmi: uutil.cmi +case.cmi: +checksum.cmi: +clroot.cmi: common.cmi: uutil.cmi props.cmi path.cmi osx.cmi os.cmi name.cmi fspath.cmi \ fileinfo.cmi copy.cmi: uutil.cmi props.cmi path.cmi osx.cmi os.cmi lwt/lwt.cmi fspath.cmi \ common.cmi +external.cmi: fileinfo.cmi: props.cmi path.cmi osx.cmi fspath.cmi files.cmi: uutil.cmi props.cmi path.cmi lwt/lwt_util.cmi lwt/lwt.cmi \ common.cmi +fileutil.cmi: fingerprint.cmi: uutil.cmi path.cmi fspath.cmi fspath.cmi: path.cmi name.cmi globals.cmi: ubase/prefs.cmi path.cmi lwt/lwt.cmi common.cmi +lock.cmi: +name.cmi: os.cmi: props.cmi path.cmi name.cmi fspath.cmi fileinfo.cmi osx.cmi: uutil.cmi ubase/prefs.cmi path.cmi fspath.cmi fingerprint.cmi path.cmi: name.cmi +pred.cmi: props.cmi: uutil.cmi ubase/prefs.cmi path.cmi osx.cmi fspath.cmi recon.cmi: path.cmi common.cmi remote.cmi: ubase/prefs.cmi lwt/lwt.cmi fspath.cmi common.cmi clroot.cmi sortri.cmi: common.cmi stasher.cmi: ubase/prefs.cmi path.cmi os.cmi fspath.cmi +strings.cmi: +terminal.cmi: +test.cmi: transfer.cmi: uutil.cmi lwt/lwt.cmi transport.cmi: uutil.cmi lwt/lwt.cmi common.cmi +tree.cmi: uicommon.cmi: uutil.cmi ubase/prefs.cmi path.cmi lwt/lwt.cmi common.cmi +uigtk2.cmi: uicommon.cmi uigtk.cmi: uicommon.cmi -uigtk2.cmi: uicommon.cmi +ui.cmi: uitext.cmi: uicommon.cmi +unicode.cmi: update.cmi: tree.cmi props.cmi path.cmi osx.cmi os.cmi name.cmi lwt/lwt.cmi \ fspath.cmi fileinfo.cmi common.cmi +uutil.cmi: xferhint.cmi: ubase/prefs.cmi path.cmi os.cmi fspath.cmi abort.cmo: uutil.cmi ubase/util.cmi ubase/trace.cmi ubase/safelist.cmi \ abort.cmi abort.cmx: uutil.cmx ubase/util.cmx ubase/trace.cmx ubase/safelist.cmx \ abort.cmi -case.cmo: ubase/prefs.cmi case.cmi -case.cmx: ubase/prefs.cmx case.cmi +case.cmo: ubase/util.cmi unicode.cmi ubase/rx.cmi ubase/prefs.cmi case.cmi +case.cmx: ubase/util.cmx unicode.cmx ubase/rx.cmx ubase/prefs.cmx case.cmi checksum.cmo: checksum.cmi checksum.cmx: checksum.cmi clroot.cmo: ubase/util.cmi ubase/rx.cmi ubase/prefs.cmi clroot.cmi @@ -80,10 +95,10 @@ globals.cmx: ubase/util.cmx ubase/trace.cmx ubase/safelist.cmx remote.cmx \ ubase/prefs.cmx pred.cmx path.cmx os.cmx name.cmx lwt/lwt_util.cmx \ lwt/lwt_unix.cmx lwt/lwt.cmx common.cmx clroot.cmx globals.cmi +linkgtk2.cmo: uigtk2.cmi main.cmo +linkgtk2.cmx: uigtk2.cmx main.cmx linkgtk.cmo: uigtk.cmi main.cmo linkgtk.cmx: uigtk.cmx main.cmx -linkgtk2.cmo: uigtk2.cmi main.cmo -linkgtk2.cmx: uigtk2.cmx main.cmx linktext.cmo: uitext.cmi main.cmo linktext.cmx: uitext.cmx main.cmx linktk.cmo: main.cmo @@ -94,6 +109,8 @@ ubase/safelist.cmi remote.cmi ubase/prefs.cmi os.cmi fspath.cmi main.cmx: uutil.cmx ubase/util.cmx uitext.cmx uicommon.cmx strings.cmx \ ubase/safelist.cmx remote.cmx ubase/prefs.cmx os.cmx fspath.cmx +mkProjectInfo.cmo: +mkProjectInfo.cmx: name.cmo: ubase/util.cmi case.cmi name.cmi name.cmx: ubase/util.cmx case.cmx name.cmi os.cmo: uutil.cmi ubase/util.cmi ubase/safelist.cmi props.cmi ubase/prefs.cmi \ @@ -108,6 +125,8 @@ fileutil.cmi case.cmi path.cmi path.cmx: ubase/util.cmx ubase/safelist.cmx ubase/rx.cmx pred.cmx name.cmx \ fileutil.cmx case.cmx path.cmi +pixmaps.cmo: +pixmaps.cmx: pred.cmo: ubase/util.cmi ubase/safelist.cmi ubase/rx.cmi ubase/prefs.cmi \ case.cmi pred.cmi pred.cmx: ubase/util.cmx ubase/safelist.cmx ubase/rx.cmx ubase/prefs.cmx \ @@ -178,26 +197,26 @@ props.cmx ubase/prefs.cmx path.cmx osx.cmx os.cmx name.cmx \ lwt/lwt_unix.cmx lwt/lwt.cmx globals.cmx fspath.cmx files.cmx \ fileinfo.cmx common.cmx clroot.cmx case.cmx uicommon.cmi -uigtk.cmo: uutil.cmi ubase/util.cmi update.cmi uitext.cmi uicommon.cmi \ +uigtk2.cmo: uutil.cmi ubase/util.cmi update.cmi uitext.cmi uicommon.cmi \ transport.cmi ubase/trace.cmi strings.cmi sortri.cmi ubase/safelist.cmi \ remote.cmi recon.cmi ubase/prefs.cmi pixmaps.cmo path.cmi os.cmi \ lwt/lwt_util.cmi lwt/lwt_unix.cmi lwt/lwt.cmi globals.cmi fspath.cmi \ - files.cmi common.cmi clroot.cmi uigtk.cmi -uigtk.cmx: uutil.cmx ubase/util.cmx update.cmx uitext.cmx uicommon.cmx \ + files.cmi common.cmi clroot.cmi uigtk2.cmi +uigtk2.cmx: uutil.cmx ubase/util.cmx update.cmx uitext.cmx uicommon.cmx \ transport.cmx ubase/trace.cmx strings.cmx sortri.cmx ubase/safelist.cmx \ remote.cmx recon.cmx ubase/prefs.cmx pixmaps.cmx path.cmx os.cmx \ lwt/lwt_util.cmx lwt/lwt_unix.cmx lwt/lwt.cmx globals.cmx fspath.cmx \ - files.cmx common.cmx clroot.cmx uigtk.cmi -uigtk2.cmo: uutil.cmi ubase/util.cmi update.cmi uitext.cmi uicommon.cmi \ + files.cmx common.cmx clroot.cmx uigtk2.cmi +uigtk.cmo: uutil.cmi ubase/util.cmi update.cmi uitext.cmi uicommon.cmi \ transport.cmi ubase/trace.cmi strings.cmi sortri.cmi ubase/safelist.cmi \ remote.cmi recon.cmi ubase/prefs.cmi pixmaps.cmo path.cmi os.cmi \ lwt/lwt_util.cmi lwt/lwt_unix.cmi lwt/lwt.cmi globals.cmi fspath.cmi \ - files.cmi common.cmi clroot.cmi uigtk2.cmi -uigtk2.cmx: uutil.cmx ubase/util.cmx update.cmx uitext.cmx uicommon.cmx \ + files.cmi common.cmi clroot.cmi uigtk.cmi +uigtk.cmx: uutil.cmx ubase/util.cmx update.cmx uitext.cmx uicommon.cmx \ transport.cmx ubase/trace.cmx strings.cmx sortri.cmx ubase/safelist.cmx \ remote.cmx recon.cmx ubase/prefs.cmx pixmaps.cmx path.cmx os.cmx \ lwt/lwt_util.cmx lwt/lwt_unix.cmx lwt/lwt.cmx globals.cmx fspath.cmx \ - files.cmx common.cmx clroot.cmx uigtk2.cmi + files.cmx common.cmx clroot.cmx uigtk.cmi uimacbridge.cmo: xferhint.cmi uutil.cmi ubase/util.cmi update.cmi \ uicommon.cmi transport.cmi ubase/trace.cmi terminal.cmi stasher.cmi \ ubase/safelist.cmi remote.cmi recon.cmi ubase/prefs.cmi path.cmi os.cmi \ @@ -226,18 +245,22 @@ ubase/trace.cmx ubase/safelist.cmx remote.cmx recon.cmx ubase/prefs.cmx \ path.cmx lwt/lwt_util.cmx lwt/lwt_unix.cmx lwt/lwt.cmx globals.cmx \ common.cmx uitext.cmi +unicode.cmo: unicode_tables.cmo unicode.cmi +unicode.cmx: unicode_tables.cmx unicode.cmi +unicode_tables.cmo: +unicode_tables.cmx: update.cmo: xferhint.cmi uutil.cmi ubase/util.cmi tree.cmi ubase/trace.cmi \ - stasher.cmi ubase/safelist.cmi ubase/rx.cmi remote.cmi props.cmi \ - ubase/prefs.cmi pred.cmi path.cmi osx.cmi os.cmi name.cmi ubase/myMap.cmi \ + stasher.cmi ubase/safelist.cmi remote.cmi props.cmi ubase/prefs.cmi \ + pred.cmi path.cmi osx.cmi os.cmi name.cmi ubase/myMap.cmi \ lwt/lwt_unix.cmi lwt/lwt.cmi lock.cmi globals.cmi fspath.cmi \ fingerprint.cmi fileinfo.cmi external.cmi common.cmi update.cmi update.cmx: xferhint.cmx uutil.cmx ubase/util.cmx tree.cmx ubase/trace.cmx \ - stasher.cmx ubase/safelist.cmx ubase/rx.cmx remote.cmx props.cmx \ - ubase/prefs.cmx pred.cmx path.cmx osx.cmx os.cmx name.cmx ubase/myMap.cmx \ + stasher.cmx ubase/safelist.cmx remote.cmx props.cmx ubase/prefs.cmx \ + pred.cmx path.cmx osx.cmx os.cmx name.cmx ubase/myMap.cmx \ lwt/lwt_unix.cmx lwt/lwt.cmx lock.cmx globals.cmx fspath.cmx \ fingerprint.cmx fileinfo.cmx external.cmx common.cmx update.cmi -uutil.cmo: ubase/util.cmi uutil.cmi -uutil.cmx: ubase/util.cmx uutil.cmi +uutil.cmo: ubase/util.cmi ubase/projectInfo.cmo uutil.cmi +uutil.cmx: ubase/util.cmx ubase/projectInfo.cmx uutil.cmi xferhint.cmo: ubase/util.cmi ubase/trace.cmi ubase/prefs.cmi path.cmi os.cmi \ fspath.cmi xferhint.cmi xferhint.cmx: ubase/util.cmx ubase/trace.cmx ubase/prefs.cmx path.cmx os.cmx \ @@ -256,6 +279,8 @@ ubase/prefs.cmi ubase/prefs.cmx: ubase/util.cmx ubase/uarg.cmx ubase/safelist.cmx \ ubase/prefs.cmi +ubase/projectInfo.cmo: +ubase/projectInfo.cmx: ubase/rx.cmo: ubase/rx.cmi ubase/rx.cmx: ubase/rx.cmi ubase/safelist.cmo: ubase/safelist.cmi @@ -270,7 +295,15 @@ ubase/uprintf.cmx: ubase/uprintf.cmi ubase/util.cmo: ubase/uprintf.cmi ubase/safelist.cmi ubase/util.cmi ubase/util.cmx: ubase/uprintf.cmx ubase/safelist.cmx ubase/util.cmi +lwt/lwt.cmi: lwt/lwt_unix.cmi: lwt/lwt.cmi lwt/lwt_util.cmi: lwt/lwt.cmi +lwt/pqueue.cmi: +ubase/myMap.cmi: ubase/prefs.cmi: ubase/util.cmi +ubase/rx.cmi: +ubase/safelist.cmi: ubase/trace.cmi: ubase/prefs.cmi +ubase/uarg.cmi: +ubase/uprintf.cmi: +ubase/util.cmi: Modified: trunk/src/Makefile.OCaml =================================================================== --- trunk/src/Makefile.OCaml 2009-05-03 00:20:31 UTC (rev 325) +++ trunk/src/Makefile.OCaml 2009-05-04 18:48:23 UTC (rev 326) @@ -179,7 +179,7 @@ \ lwt/pqueue.cmo lwt/lwt.cmo lwt/lwt_util.cmo lwt/lwt_unix.cmo \ \ - case.cmo pred.cmo uutil.cmo \ + unicode_tables.cmo unicode.cmo case.cmo pred.cmo uutil.cmo \ fileutil.cmo name.cmo path.cmo fspath.cmo fingerprint.cmo \ abort.cmo osx.cmo external.cmo \ props.cmo fileinfo.cmo os.cmo lock.cmo clroot.cmo common.cmo \ Modified: trunk/src/RECENTNEWS =================================================================== --- trunk/src/RECENTNEWS 2009-05-03 00:20:31 UTC (rev 325) +++ trunk/src/RECENTNEWS 2009-05-04 18:48:23 UTC (rev 326) @@ -1,3 +1,14 @@ +CHANGES FROM VERSION 2.33.-4 + +* Updated list of bad Windows file names following the MSDN + documentation (in particular, files with trailing dots are now + rejected when synchronizing with a Windows machine) +* Experimental Unicode-aware case insensitive mode. It is activated + when the preference "unicode" is set to true and Unison is in + case-insensitive mode. +* Bumped version number to reflect the newly added preference + +------------------------------- CHANGES FROM VERSION 2.32.7 * Move descriptions of recent changes to documentation. Modified: trunk/src/case.ml =================================================================== --- trunk/src/case.ml 2009-05-03 00:20:31 UTC (rev 325) +++ trunk/src/case.ml 2009-05-04 18:48:23 UTC (rev 326) @@ -34,16 +34,37 @@ ^ "useful to set the flag manually (e.g. when running Unison on a " ^ "Unix system with a FAT [Windows] volume mounted).") +let unicodeEncoding = + Prefs.createBool "unicode" false + "!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" + (* Defining this variable as a preference ensures that it will be propagated to the other host during initialization *) let someHostIsInsensitive = Prefs.createBool "someHostIsInsensitive" false "*Pseudo-preference for internal use only" "" -(* Note: this function must be fast *) -let insensitive () = Prefs.read someHostIsInsensitive +(* 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 *) +(* by storing the information in a pref so that it is propagated to the *) +(* server with the rest of the prefs. *) +let init b = + Prefs.set someHostIsInsensitive + (Prefs.read caseInsensitiveMode = "yes" || + Prefs.read caseInsensitiveMode = "true" || + (Prefs.read caseInsensitiveMode = "default" && b)) -let needNormalization s = +(****) + +(* Dots are ignored at the end of filenames under Windows. *) + +(* FIX: for the moment, simply disallow files ending with a dot. + This is more efficient, and this may well be good enough. + We should reconsider this is people start complaining... + +let hasTrailingDots s = let rec iter s pos len wasDot = if pos = len then wasDot else let c = s.[pos] in @@ -67,31 +88,87 @@ done; String.sub s' (!pos' + 1) (len - !pos' - 1) -(* Dots are ignored at the end of filenames under Windows. *) -let normalize s = +let rmTrailDots s = s (*FIX: disabled for know -- requires an archive version change if - insensitive () && -(*FIX: should only be done when one host is running under Windows... -(should be OK for now as it seems unlikely to have a file ending with - a dot and the same file with the same name but no dot at the end) Prefs.read someHostIsRunningWindows && not (Prefs.read allHostsAreRunningWindows) && -*) - needNormalization s + hasTrailingDots s then removeTrailingDots s else s *) +*) -(* 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 *) -(* by storing the information in a pref so that it is propagated to the *) -(* server with the rest of the prefs. *) -let init b = - Prefs.set someHostIsInsensitive - (Prefs.read caseInsensitiveMode = "yes" || - Prefs.read caseInsensitiveMode = "true" || - (Prefs.read caseInsensitiveMode = "default" && b)) +(****) + +(* Windows file naming conventions are descripted here: + *) +let badWindowsFilenameRx = + Rx.case_insensitive + (Rx.rx + "(.*[\000-\031<>:\"/\\|?*].*)|\ + ((con|prn|aux|nul|com[1-9]|lpt[1-9])(\\.[^.]*)?)|\ + (.*[. ])") + +let isBadWindowsFilename s = + (* FIX: should also check for a max filename length, not sure how much *) + Rx.match_string badWindowsFilenameRx s +let badFilename someHostIsRunningWindows s = + (* Don't check unless we are syncing with Windows *) + someHostIsRunningWindows && isBadWindowsFilename s + +(****) + +type mode = Sensitive | Insensitive | UnicodeInsensitive + +(* +Important invariant: + if [compare s s' = 0], + then [hash s = hash s'] and + and [Rx.match_string rx (normalizeMatchedString s) = + Rx.match_string rx (normalizeMatchedString s')] + (when [rx] has been compiled using the [caseInsensitiveMatch] mode) +*) + +let sensitiveOps = object + method mode = Sensitive + method compare s s' = compare s s' + method hash s = Hashtbl.hash s + method normalizePattern s = s + method caseInsensitiveMatch = false + method normalizeMatchedString s = s + method badFilename w s = badFilename w s +end + +let insensitiveOps = object + method mode = Insensitive + method compare s s' = Util.nocase_cmp s s' + method hash s = Hashtbl.hash (String.lowercase s) + method normalizePattern s = s + method caseInsensitiveMatch = true + method normalizeMatchedString s = s + method badFilename w s = badFilename w s +end + +let unicodeInsensitiveOps = object + method mode = UnicodeInsensitive + method compare s s' = Unicode.compare s s' + method hash s = Hashtbl.hash (Unicode.normalize s) + method normalizePattern p = Unicode.normalize p + method caseInsensitiveMatch = false + method normalizeMatchedString s = Unicode.normalize s + method badFilename w s = not (Unicode.check_utf_8 s) || badFilename w s +end + +(* Note: the dispatch must be fast *) +let ops () = + if Prefs.read someHostIsInsensitive then begin + if Prefs.read unicodeEncoding then + unicodeInsensitiveOps + else + insensitiveOps + end else + sensitiveOps Modified: trunk/src/case.mli =================================================================== --- trunk/src/case.mli 2009-05-03 00:20:31 UTC (rev 325) +++ trunk/src/case.mli 2009-05-04 18:48:23 UTC (rev 326) @@ -1,8 +1,15 @@ (* Unison file synchronizer: src/case.mli *) (* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) -val insensitive : unit -> bool +type mode -val normalize : string -> string +val ops : unit -> + < mode : mode; + compare : string -> string -> int; + hash : string -> int; + normalizePattern : string -> string; + caseInsensitiveMatch : bool; + normalizeMatchedString : string -> string; + badFilename : bool -> string -> bool > val init : bool -> unit Modified: trunk/src/mkProjectInfo.ml =================================================================== --- trunk/src/mkProjectInfo.ml 2009-05-03 00:20:31 UTC (rev 325) +++ trunk/src/mkProjectInfo.ml 2009-05-04 18:48:23 UTC (rev 326) @@ -5,8 +5,8 @@ let projectName = "unison" let majorVersion = 2 -let minorVersion = 32 -let pointVersionOrigin = 313 (* Revision that corresponds to point version 0 *) +let minorVersion = 33 +let pointVersionOrigin = 325 (* Revision that corresponds to point version 0 *) (* Documentation: This is a program to construct a version of the form Major.Minor.Point, @@ -105,3 +105,4 @@ + Modified: trunk/src/name.ml =================================================================== --- trunk/src/name.ml 2009-05-03 00:20:31 UTC (rev 325) +++ trunk/src/name.ml 2009-05-04 18:48:23 UTC (rev 326) @@ -20,11 +20,7 @@ INCREMENT "UPDATE.ARCHIVEFORMAT" *) type t = string -let compare n1 n2 = - if Case.insensitive () then - Util.nocase_cmp (Case.normalize n1) (Case.normalize n2) - else - compare n1 n2 +let compare n1 n2 = (Case.ops())#compare n1 n2 let eq a b = (0 = (compare a b)) @@ -41,5 +37,7 @@ (* We ought to consider further checks, e.g., in Windows, no colons *) s -let hash n = - Hashtbl.hash (if Case.insensitive () then String.lowercase (Case.normalize n) else n) +let hash n = (Case.ops())#hash n + +let bad someHostIsRunningWindows n = + (Case.ops())#badFilename someHostIsRunningWindows n Modified: trunk/src/name.mli =================================================================== --- trunk/src/name.mli 2009-05-03 00:20:31 UTC (rev 325) +++ trunk/src/name.mli 2009-05-04 18:48:23 UTC (rev 326) @@ -9,3 +9,5 @@ val compare : t -> t -> int val eq : t -> t -> bool val hash : t -> int + +val bad : bool -> t -> bool Modified: trunk/src/path.ml =================================================================== --- trunk/src/path.ml 2009-05-03 00:20:31 UTC (rev 325) +++ trunk/src/path.ml 2009-05-04 18:48:23 UTC (rev 326) @@ -170,8 +170,7 @@ let toString path = path -let compare p1 p2 = - if Case.insensitive () then Util.nocase_cmp p1 p2 else compare p1 p2 +let compare p1 p2 = (Case.ops())#compare p1 p2 let toDebugString path = String.concat " / " (toStringList path) @@ -191,6 +190,7 @@ assert (not (isEmpty path)); prefix ^ path +(* No need to perform case normalization on local paths *) let hash p = Hashtbl.hash p (* Pref controlling whether symlinks are followed. *) Modified: trunk/src/pred.ml =================================================================== --- trunk/src/pred.ml 2009-05-03 00:20:31 UTC (rev 325) +++ trunk/src/pred.ml 2009-05-04 18:48:23 UTC (rev 326) @@ -28,7 +28,7 @@ mutable default: string list; mutable last_pref : string list; mutable last_def : string list; - mutable last_mode : bool; + mutable last_mode : Case.mode; mutable compiled: Rx.t; mutable associated_strings : (Rx.t * string) list; } @@ -61,7 +61,7 @@ let (p,v) = match Util.splitIntoWordsByString clause mapSeparator with [p] -> (p,None) - | [p;v] -> (p, Some (Util.trimWhitespace v)) + | [p;v] -> (p, Some ((Case.ops())#normalizePattern (Util.trimWhitespace v))) | [] -> raise (Prefs.IllegalValue "Empty pattern") | _ -> raise (Prefs.IllegalValue ("Malformed pattern: " ^ "\"" ^ clause ^ "\"\n" @@ -97,7 +97,7 @@ string :: oldList) (fun l -> l) in {pref = pref; name = name; - last_pref = []; default = []; last_def = []; last_mode = false; + last_pref = []; default = []; last_def = []; last_mode = (Case.ops())#mode; compiled = Rx.empty; associated_strings = []} let addDefaultPatterns p pats = @@ -115,14 +115,16 @@ None -> None | Some v -> Some (rx,v)) compiledList in - p.compiled <- if mode then Rx.case_insensitive compiled else compiled; + p.compiled <- + if (Case.ops())#caseInsensitiveMatch then Rx.case_insensitive compiled + else compiled; p.associated_strings <- strings; p.last_pref <- pref; p.last_def <- p.default; p.last_mode <- mode let recompile_if_needed p = - let mode = Case.insensitive () in + let mode = (Case.ops())#mode in if p.last_mode <> mode || p.last_pref != Prefs.read p.pref || @@ -148,10 +150,11 @@ let test p s = recompile_if_needed p; - let res = Rx.match_string p.compiled (Case.normalize s) in + let res = Rx.match_string p.compiled ((Case.ops())#normalizeMatchedString s) in debug (fun() -> Util.msg "%s '%s' = %b\n" p.name s res); res let assoc p s = recompile_if_needed p; + let s = (Case.ops())#normalizeMatchedString s in snd (Safelist.find (fun (rx,v) -> Rx.match_string rx s) p.associated_strings) Modified: trunk/src/ubase/depend =================================================================== --- trunk/src/ubase/depend 2009-05-03 00:20:31 UTC (rev 325) +++ trunk/src/ubase/depend 2009-05-04 18:48:23 UTC (rev 326) @@ -2,6 +2,8 @@ myMap.cmx: myMap.cmi prefs.cmo: util.cmi uarg.cmi safelist.cmi prefs.cmi prefs.cmx: util.cmx uarg.cmx safelist.cmx prefs.cmi +projectInfo.cmo: +projectInfo.cmx: rx.cmo: rx.cmi rx.cmx: rx.cmi safelist.cmo: safelist.cmi @@ -14,5 +16,11 @@ uprintf.cmx: uprintf.cmi util.cmo: uprintf.cmi safelist.cmi util.cmi util.cmx: uprintf.cmx safelist.cmx util.cmi +myMap.cmi: prefs.cmi: util.cmi +rx.cmi: +safelist.cmi: trace.cmi: prefs.cmi +uarg.cmi: +uprintf.cmi: +util.cmi: Added: trunk/src/unicode.ml =================================================================== --- trunk/src/unicode.ml (rev 0) +++ trunk/src/unicode.ml 2009-05-04 18:48:23 UTC (rev 326) @@ -0,0 +1,859 @@ +(* Unison file synchronizer: src/unicode.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + +open Unicode_tables + +exception Invalid + +let fail () = raise Invalid + +let get s i = Char.code (String.unsafe_get s i) +let set s i v = String.unsafe_set s i (Char.unsafe_chr v) + +(****) + +let hangul_sbase = 0xAC00 +let hangul_lbase = 0x1100 +let hangul_vbase = 0x1161 +let hangul_tbase = 0x11A7 + +let hangul_scount = 11172 +let hangul_lcount = 19 +let hangul_vcount = 21 +let hangul_tcount = 28 +let hangul_ncount = hangul_vcount * hangul_tcount + +let set_char_3 s i c = + set s i (c lsr 12 + 0xE0); + set s (i + 1) ((c lsr 6) land 0x3f + 0x80); + set s (i + 2) (c land 0x3f + 0x80) + +let rec norm s i l s' j = + if i < l then begin + let c = get s i in + if c < 0x80 then begin + set s' j (get ascii_lower c); + norm s (i + 1) l s' (j + 1) + end else if c < 0xE0 then begin + (* 80 - 7FF *) + if c < 0xc2 || i + 1 >= l then raise Invalid; + let c1 = get s (i + 1) in + if c1 land 0xc0 <> 0x80 then raise Invalid; + let idx = get norm_prim (c - 0xc0) in + let idx = idx lsl 6 + c1 - 0x80 in + let k = get norm_second_high idx in + if k = 0 then begin + set s' j c; + set s' (j + 1) c1; + norm s (i + 2) l s' (j + 2) + end else begin + let k = (k - 2) lsl 8 + get norm_second_low idx in + let n = get norm_repl k in + String.blit norm_repl (k + 1) s' j n; + norm s (i + 2) l s' (j + n) + end + end else if c < 0xF0 then begin + (* 800 - FFFF *) + if i + 2 >= l then raise Invalid; + let c1 = get s (i + 1) in + if c1 land 0xc0 <> 0x80 then raise Invalid; + let idx = c lsl 6 + c1 - 0x3880 in + if idx < 0x20 then raise Invalid; + let c2 = get s (i + 2) in + if c2 land 0xc0 <> 0x80 then raise Invalid; + let idx = get norm_prim idx in + let idx = idx lsl 6 + c2 - 0x80 in + let k = get norm_second_high idx in + if k = 0 then begin + set s' j c; + set s' (j + 1) c1; + set s' (j + 2) c2; + norm s (i + 3) l s' (j + 3) + end else if k = 1 then begin + let v = c lsl 12 + c1 lsl 6 + c2 - (0x000E2080 + hangul_sbase) in + if v >= hangul_scount then begin + set s' j c; + set s' (j + 1) c1; + set s' (j + 2) c2; + norm s (i + 3) l s' (j + 3) + end else begin + set_char_3 s' j (v / hangul_ncount + hangul_lbase); + set_char_3 s' (j + 3) + ((v mod hangul_ncount) / hangul_tcount + hangul_vbase); + if v mod hangul_tcount = 0 then + norm s (i + 3) l s' (j + 6) + else begin + set_char_3 s' (j + 6) ((v mod hangul_tcount) + hangul_tbase); + norm s (i + 3) l s' (j + 9) + end + end + end else begin + let k = (k - 2) lsl 8 + get norm_second_low idx in + let n = get norm_repl k in + String.blit norm_repl (k + 1) s' j n; + norm s (i + 3) l s' (j + n) + end + end else begin + (* 10000 - 10FFFF *) + if i + 3 >= l then raise Invalid; + let c1 = get s (i + 1) in + let c2 = get s (i + 2) in + let c3 = get s (i + 3) in + if (c1 lor c2 lor c3) land 0xc0 <> 0x80 then raise Invalid; + let v = c lsl 18 + c1 lsl 12 + c2 lsl 6 + c3 - 0x03c82080 in + if v < 0x10000 || v > 0x10ffff then raise Invalid; + set s' j c; + set s' (j + 1) c1; + set s' (j + 2) c2; + set s' (j + 3) c3; + norm s (i + 4) l s' (j + 4) + end + end else + String.sub s' 0 j + +let normalize s = + let l = String.length s in + let s' = String.create (3 * l) in + try norm s 0 l s' 0 with Invalid -> s + +(****) + +let rec compare_rec s s' i l = + if i = l then begin + if l < String.length s then 1 else + if l < String.length s' then -1 else + 0 + end else begin + let c = get s i in + let c' = get s' i in + if c < 0x80 && c' < 0x80 then begin + let v = compare (get ascii_lower c) (get ascii_lower c') in + if v <> 0 then v else compare_rec s s' (i + 1) l + end else + compare (normalize s) (normalize s') + end + +let compare s s' = + compare_rec s s' 0 (min (String.length s) (String.length s')) + +(****) + +let rec decode_char s i l = + if i = l then fail () else + let c = get s i in + if c < 0x80 then + cont s (i + 1) l c + else if c < 0xE0 then begin + (* 80 - 7FF *) + if c < 0xc2 || i + 1 >= l then fail () else + let c1 = get s (i + 1) in + if c1 land 0xc0 <> 0x80 then fail () else + let v = c lsl 6 + c1 - 0x3080 in + cont s (i + 2) l v + end else if c < 0xF0 then begin + (* 800 - FFFF *) + if i + 2 >= l then fail () else + let c1 = get s (i + 1) in + let c2 = get s (i + 2) in + if (c1 lor c2) land 0xc0 <> 0x80 then fail () else + let v = c lsl 12 + c1 lsl 6 + c2 - 0xe2080 in + if v < 0x800 then fail () else + cont s (i + 3) l v + end else begin + (* 10000 - 10FFFF *) + if i + 3 >= l then fail () else + let c1 = get s (i + 1) in + let c2 = get s (i + 2) in + let c3 = get s (i + 3) in + if (c1 lor c2 lor c3) land 0xc0 <> 0x80 then fail () else + let v = c lsl 18 + c1 lsl 12 + c2 lsl 6 + c3 - 0x03c82080 in + if v < 0x10000 || v > 0x10ffff then fail () else + cont s (i + 4) l v + end + +and cont s i l v = (v, i) + +let encode_char s i l c = + if c < 0x80 then begin + if i >= l then fail () else begin + set s i c; + i + 1 + end + end else if c < 0x800 then begin + if i + 1 >= l then fail () else begin + set s i (c lsr 6 + 0xC0); + set s (i + 1) (c land 0x3f + 0x80); + i + 2 + end + end else if c < 0x10000 then begin + if i + 1 >= l then fail () else begin + set s i (c lsr 12 + 0xE0); + set s (i + 1) ((c lsr 6) land 0x3f + 0x80); + set s (i + 2) (c land 0x3f + 0x80); + i + 3 + end + end else begin + if i + 1 >= l then fail () else begin + set s i (c lsr 18 + 0xF0); + set s (i + 1) ((c lsr 12) land 0x3f + 0x80); + set s (i + 2) ((c lsr 6) land 0x3f + 0x80); + set s (i + 3) (c land 0x3f + 0x80); + i + 4 + end + end + +let rec prev_char s i = + let i = i - 1 in + if i < 0 then fail () else + if (get s i) land 0xc0 <> 0x80 then i else prev_char s i + +(****) + +let uniCharPrecompSourceTable = [| + 0x00000300; 0x00540000; 0x00000301; 0x00750054; + 0x00000302; 0x002000C9; 0x00000303; 0x001C00E9; + 0x00000304; 0x002C0105; 0x00000306; 0x00200131; + 0x00000307; 0x002E0151; 0x00000308; 0x0036017F; + 0x00000309; 0x001801B5; 0x0000030A; 0x000601CD; + 0x0000030B; 0x000601D3; 0x0000030C; 0x002501D9; + 0x0000030F; 0x000E01FE; 0x00000311; 0x000C020C; + 0x00000313; 0x000E0218; 0x00000314; 0x00100226; + 0x0000031B; 0x00040236; 0x00000323; 0x002A023A; + 0x00000324; 0x00020264; 0x00000325; 0x00020266; + 0x00000326; 0x00040268; 0x00000327; 0x0016026C; + 0x00000328; 0x000A0282; 0x0000032D; 0x000C028C; + 0x0000032E; 0x00020298; 0x00000330; 0x0006029A; + 0x00000331; 0x001102A0; 0x00000338; 0x002C02B1; + 0x00000342; 0x001D02DD; 0x00000345; 0x003F02FA; + 0x00000653; 0x00010339; 0x00000654; 0x0006033A; + 0x00000655; 0x00010340; 0x0000093C; 0x00030341; + 0x000009BE; 0x00010344; 0x000009D7; 0x00010345; + 0x00000B3E; 0x00010346; 0x00000B56; 0x00010347; + 0x00000B57; 0x00010348; 0x00000BBE; 0x00020349; + 0x00000BD7; 0x0002034B; 0x00000C56; 0x0001034D; + 0x00000CC2; 0x0001034E; 0x00000CD5; 0x0003034F; + 0x00000CD6; 0x00010352; 0x00000D3E; 0x00020353; + 0x00000D57; 0x00010355; 0x00000DCA; 0x00020356; + 0x00000DCF; 0x00010358; 0x00000DDF; 0x00010359; + 0x0000102E; 0x0001035A; 0x00003099; 0x0030035B; + 0x0000309A; 0x000A038B +|] + +let uniCharBMPPrecompDestinationTable = [| + 0x0041; 0x00C0; 0x0045; 0x00C8; 0x0049; 0x00CC; 0x004E; 0x01F8; + 0x004F; 0x00D2; 0x0055; 0x00D9; 0x0057; 0x1E80; 0x0059; 0x1EF2; + 0x0061; 0x00E0; 0x0065; 0x00E8; 0x0069; 0x00EC; 0x006E; 0x01F9; + 0x006F; 0x00F2; 0x0075; 0x00F9; 0x0077; 0x1E81; 0x0079; 0x1EF3; + 0x00A8; 0x1FED; 0x00C2; 0x1EA6; 0x00CA; 0x1EC0; 0x00D4; 0x1ED2; + 0x00DC; 0x01DB; 0x00E2; 0x1EA7; 0x00EA; 0x1EC1; 0x00F4; 0x1ED3; + 0x00FC; 0x01DC; 0x0102; 0x1EB0; 0x0103; 0x1EB1; 0x0112; 0x1E14; + 0x0113; 0x1E15; 0x014C; 0x1E50; 0x014D; 0x1E51; 0x01A0; 0x1EDC; + 0x01A1; 0x1EDD; 0x01AF; 0x1EEA; 0x01B0; 0x1EEB; 0x0391; 0x1FBA; + 0x0395; 0x1FC8; 0x0397; 0x1FCA; 0x0399; 0x1FDA; 0x039F; 0x1FF8; + 0x03A5; 0x1FEA; 0x03A9; 0x1FFA; 0x03B1; 0x1F70; 0x03B5; 0x1F72; + 0x03B7; 0x1F74; 0x03B9; 0x1F76; 0x03BF; 0x1F78; 0x03C5; 0x1F7A; + 0x03C9; 0x1F7C; 0x03CA; 0x1FD2; 0x03CB; 0x1FE2; 0x0415; 0x0400; + 0x0418; 0x040D; 0x0435; 0x0450; 0x0438; 0x045D; 0x1F00; 0x1F02; + 0x1F01; 0x1F03; 0x1F08; 0x1F0A; 0x1F09; 0x1F0B; 0x1F10; 0x1F12; + 0x1F11; 0x1F13; 0x1F18; 0x1F1A; 0x1F19; 0x1F1B; 0x1F20; 0x1F22; + 0x1F21; 0x1F23; 0x1F28; 0x1F2A; 0x1F29; 0x1F2B; 0x1F30; 0x1F32; + 0x1F31; 0x1F33; 0x1F38; 0x1F3A; 0x1F39; 0x1F3B; 0x1F40; 0x1F42; + 0x1F41; 0x1F43; 0x1F48; 0x1F4A; 0x1F49; 0x1F4B; 0x1F50; 0x1F52; + 0x1F51; 0x1F53; 0x1F59; 0x1F5B; 0x1F60; 0x1F62; 0x1F61; 0x1F63; + 0x1F68; 0x1F6A; 0x1F69; 0x1F6B; 0x1FBF; 0x1FCD; 0x1FFE; 0x1FDD; + 0x0041; 0x00C1; 0x0043; 0x0106; 0x0045; 0x00C9; 0x0047; 0x01F4; + 0x0049; 0x00CD; 0x004B; 0x1E30; 0x004C; 0x0139; 0x004D; 0x1E3E; + 0x004E; 0x0143; 0x004F; 0x00D3; 0x0050; 0x1E54; 0x0052; 0x0154; + 0x0053; 0x015A; 0x0055; 0x00DA; 0x0057; 0x1E82; 0x0059; 0x00DD; + 0x005A; 0x0179; 0x0061; 0x00E1; 0x0063; 0x0107; 0x0065; 0x00E9; + 0x0067; 0x01F5; 0x0069; 0x00ED; 0x006B; 0x1E31; 0x006C; 0x013A; + 0x006D; 0x1E3F; 0x006E; 0x0144; 0x006F; 0x00F3; 0x0070; 0x1E55; + 0x0072; 0x0155; 0x0073; 0x015B; 0x0075; 0x00FA; 0x0077; 0x1E83; + 0x0079; 0x00FD; 0x007A; 0x017A; 0x00A8; 0x0385; 0x00C2; 0x1EA4; + 0x00C5; 0x01FA; 0x00C6; 0x01FC; 0x00C7; 0x1E08; 0x00CA; 0x1EBE; + 0x00CF; 0x1E2E; 0x00D4; 0x1ED0; 0x00D5; 0x1E4C; 0x00D8; 0x01FE; + 0x00DC; 0x01D7; 0x00E2; 0x1EA5; 0x00E5; 0x01FB; 0x00E6; 0x01FD; + 0x00E7; 0x1E09; 0x00EA; 0x1EBF; 0x00EF; 0x1E2F; 0x00F4; 0x1ED1; + 0x00F5; 0x1E4D; 0x00F8; 0x01FF; 0x00FC; 0x01D8; 0x0102; 0x1EAE; + 0x0103; 0x1EAF; 0x0112; 0x1E16; 0x0113; 0x1E17; 0x014C; 0x1E52; + 0x014D; 0x1E53; 0x0168; 0x1E78; 0x0169; 0x1E79; 0x01A0; 0x1EDA; + 0x01A1; 0x1EDB; 0x01AF; 0x1EE8; 0x01B0; 0x1EE9; 0x0391; 0x0386; + 0x0395; 0x0388; 0x0397; 0x0389; 0x0399; 0x038A; 0x039F; 0x038C; + 0x03A5; 0x038E; 0x03A9; 0x038F; 0x03B1; 0x03AC; 0x03B5; 0x03AD; + 0x03B7; 0x03AE; 0x03B9; 0x03AF; 0x03BF; 0x03CC; 0x03C5; 0x03CD; + 0x03C9; 0x03CE; 0x03CA; 0x0390; 0x03CB; 0x03B0; 0x03D2; 0x03D3; + 0x0413; 0x0403; 0x041A; 0x040C; 0x0433; 0x0453; 0x043A; 0x045C; + 0x1F00; 0x1F04; 0x1F01; 0x1F05; 0x1F08; 0x1F0C; 0x1F09; 0x1F0D; + 0x1F10; 0x1F14; 0x1F11; 0x1F15; 0x1F18; 0x1F1C; 0x1F19; 0x1F1D; + 0x1F20; 0x1F24; 0x1F21; 0x1F25; 0x1F28; 0x1F2C; 0x1F29; 0x1F2D; + 0x1F30; 0x1F34; 0x1F31; 0x1F35; 0x1F38; 0x1F3C; 0x1F39; 0x1F3D; + 0x1F40; 0x1F44; 0x1F41; 0x1F45; 0x1F48; 0x1F4C; 0x1F49; 0x1F4D; + 0x1F50; 0x1F54; 0x1F51; 0x1F55; 0x1F59; 0x1F5D; 0x1F60; 0x1F64; + 0x1F61; 0x1F65; 0x1F68; 0x1F6C; 0x1F69; 0x1F6D; 0x1FBF; 0x1FCE; + 0x1FFE; 0x1FDE; 0x0041; 0x00C2; 0x0043; 0x0108; 0x0045; 0x00CA; + 0x0047; 0x011C; 0x0048; 0x0124; 0x0049; 0x00CE; 0x004A; 0x0134; + 0x004F; 0x00D4; 0x0053; 0x015C; 0x0055; 0x00DB; 0x0057; 0x0174; + 0x0059; 0x0176; 0x005A; 0x1E90; 0x0061; 0x00E2; 0x0063; 0x0109; + 0x0065; 0x00EA; 0x0067; 0x011D; 0x0068; 0x0125; 0x0069; 0x00EE; + 0x006A; 0x0135; 0x006F; 0x00F4; 0x0073; 0x015D; 0x0075; 0x00FB; + 0x0077; 0x0175; 0x0079; 0x0177; 0x007A; 0x1E91; 0x1EA0; 0x1EAC; + 0x1EA1; 0x1EAD; 0x1EB8; 0x1EC6; 0x1EB9; 0x1EC7; 0x1ECC; 0x1ED8; + 0x1ECD; 0x1ED9; 0x0041; 0x00C3; 0x0045; 0x1EBC; 0x0049; 0x0128; + 0x004E; 0x00D1; 0x004F; 0x00D5; 0x0055; 0x0168; 0x0056; 0x1E7C; + 0x0059; 0x1EF8; 0x0061; 0x00E3; 0x0065; 0x1EBD; 0x0069; 0x0129; + 0x006E; 0x00F1; 0x006F; 0x00F5; 0x0075; 0x0169; 0x0076; 0x1E7D; + 0x0079; 0x1EF9; 0x00C2; 0x1EAA; 0x00CA; 0x1EC4; 0x00D4; 0x1ED6; + 0x00E2; 0x1EAB; 0x00EA; 0x1EC5; 0x00F4; 0x1ED7; 0x0102; 0x1EB4; + 0x0103; 0x1EB5; 0x01A0; 0x1EE0; 0x01A1; 0x1EE1; 0x01AF; 0x1EEE; + 0x01B0; 0x1EEF; 0x0041; 0x0100; 0x0045; 0x0112; 0x0047; 0x1E20; + 0x0049; 0x012A; 0x004F; 0x014C; 0x0055; 0x016A; 0x0059; 0x0232; + 0x0061; 0x0101; 0x0065; 0x0113; 0x0067; 0x1E21; 0x0069; 0x012B; + 0x006F; 0x014D; 0x0075; 0x016B; 0x0079; 0x0233; 0x00C4; 0x01DE; + 0x00C6; 0x01E2; 0x00D5; 0x022C; 0x00D6; 0x022A; 0x00DC; 0x01D5; + 0x00E4; 0x01DF; 0x00E6; 0x01E3; 0x00F5; 0x022D; 0x00F6; 0x022B; + 0x00FC; 0x01D6; 0x01EA; 0x01EC; 0x01EB; 0x01ED; 0x0226; 0x01E0; + 0x0227; 0x01E1; 0x022E; 0x0230; 0x022F; 0x0231; 0x0391; 0x1FB9; + 0x0399; 0x1FD9; 0x03A5; 0x1FE9; 0x03B1; 0x1FB1; 0x03B9; 0x1FD1; + 0x03C5; 0x1FE1; 0x0418; 0x04E2; 0x0423; 0x04EE; 0x0438; 0x04E3; + 0x0443; 0x04EF; 0x1E36; 0x1E38; 0x1E37; 0x1E39; 0x1E5A; 0x1E5C; + 0x1E5B; 0x1E5D; 0x0041; 0x0102; 0x0045; 0x0114; 0x0047; 0x011E; + 0x0049; 0x012C; 0x004F; 0x014E; 0x0055; 0x016C; 0x0061; 0x0103; + 0x0065; 0x0115; 0x0067; 0x011F; 0x0069; 0x012D; 0x006F; 0x014F; + 0x0075; 0x016D; 0x0228; 0x1E1C; 0x0229; 0x1E1D; 0x0391; 0x1FB8; + 0x0399; 0x1FD8; 0x03A5; 0x1FE8; 0x03B1; 0x1FB0; 0x03B9; 0x1FD0; + 0x03C5; 0x1FE0; 0x0410; 0x04D0; 0x0415; 0x04D6; 0x0416; 0x04C1; + 0x0418; 0x0419; 0x0423; 0x040E; 0x0430; 0x04D1; 0x0435; 0x04D7; + 0x0436; 0x04C2; 0x0438; 0x0439; 0x0443; 0x045E; 0x1EA0; 0x1EB6; + 0x1EA1; 0x1EB7; 0x0041; 0x0226; 0x0042; 0x1E02; 0x0043; 0x010A; + 0x0044; 0x1E0A; 0x0045; 0x0116; 0x0046; 0x1E1E; 0x0047; 0x0120; + 0x0048; 0x1E22; 0x0049; 0x0130; 0x004D; 0x1E40; 0x004E; 0x1E44; + 0x004F; 0x022E; 0x0050; 0x1E56; 0x0052; 0x1E58; 0x0053; 0x1E60; + 0x0054; 0x1E6A; 0x0057; 0x1E86; 0x0058; 0x1E8A; 0x0059; 0x1E8E; + 0x005A; 0x017B; 0x0061; 0x0227; 0x0062; 0x1E03; 0x0063; 0x010B; + 0x0064; 0x1E0B; 0x0065; 0x0117; 0x0066; 0x1E1F; 0x0067; 0x0121; + 0x0068; 0x1E23; 0x006D; 0x1E41; 0x006E; 0x1E45; 0x006F; 0x022F; + 0x0070; 0x1E57; 0x0072; 0x1E59; 0x0073; 0x1E61; 0x0074; 0x1E6B; + 0x0077; 0x1E87; 0x0078; 0x1E8B; 0x0079; 0x1E8F; 0x007A; 0x017C; + 0x015A; 0x1E64; 0x015B; 0x1E65; 0x0160; 0x1E66; 0x0161; 0x1E67; + 0x017F; 0x1E9B; 0x1E62; 0x1E68; 0x1E63; 0x1E69; 0x0041; 0x00C4; + 0x0045; 0x00CB; 0x0048; 0x1E26; 0x0049; 0x00CF; 0x004F; 0x00D6; + 0x0055; 0x00DC; 0x0057; 0x1E84; 0x0058; 0x1E8C; 0x0059; 0x0178; + 0x0061; 0x00E4; 0x0065; 0x00EB; 0x0068; 0x1E27; 0x0069; 0x00EF; + 0x006F; 0x00F6; 0x0074; 0x1E97; 0x0075; 0x00FC; 0x0077; 0x1E85; + 0x0078; 0x1E8D; 0x0079; 0x00FF; 0x00D5; 0x1E4E; 0x00F5; 0x1E4F; + 0x016A; 0x1E7A; 0x016B; 0x1E7B; 0x0399; 0x03AA; 0x03A5; 0x03AB; + 0x03B9; 0x03CA; 0x03C5; 0x03CB; 0x03D2; 0x03D4; 0x0406; 0x0407; + 0x0410; 0x04D2; 0x0415; 0x0401; 0x0416; 0x04DC; 0x0417; 0x04DE; + 0x0418; 0x04E4; 0x041E; 0x04E6; 0x0423; 0x04F0; 0x0427; 0x04F4; + 0x042B; 0x04F8; 0x042D; 0x04EC; 0x0430; 0x04D3; 0x0435; 0x0451; + 0x0436; 0x04DD; 0x0437; 0x04DF; 0x0438; 0x04E5; 0x043E; 0x04E7; + 0x0443; 0x04F1; 0x0447; 0x04F5; 0x044B; 0x04F9; 0x044D; 0x04ED; + 0x0456; 0x0457; 0x04D8; 0x04DA; 0x04D9; 0x04DB; 0x04E8; 0x04EA; + 0x04E9; 0x04EB; 0x0041; 0x1EA2; 0x0045; 0x1EBA; 0x0049; 0x1EC8; + 0x004F; 0x1ECE; 0x0055; 0x1EE6; 0x0059; 0x1EF6; 0x0061; 0x1EA3; + 0x0065; 0x1EBB; 0x0069; 0x1EC9; 0x006F; 0x1ECF; 0x0075; 0x1EE7; + 0x0079; 0x1EF7; 0x00C2; 0x1EA8; 0x00CA; 0x1EC2; 0x00D4; 0x1ED4; + 0x00E2; 0x1EA9; 0x00EA; 0x1EC3; 0x00F4; 0x1ED5; 0x0102; 0x1EB2; + 0x0103; 0x1EB3; 0x01A0; 0x1EDE; 0x01A1; 0x1EDF; 0x01AF; 0x1EEC; + 0x01B0; 0x1EED; 0x0041; 0x00C5; 0x0055; 0x016E; 0x0061; 0x00E5; + 0x0075; 0x016F; 0x0077; 0x1E98; 0x0079; 0x1E99; 0x004F; 0x0150; + 0x0055; 0x0170; 0x006F; 0x0151; 0x0075; 0x0171; 0x0423; 0x04F2; + 0x0443; 0x04F3; 0x0041; 0x01CD; 0x0043; 0x010C; 0x0044; 0x010E; + 0x0045; 0x011A; 0x0047; 0x01E6; 0x0048; 0x021E; 0x0049; 0x01CF; + 0x004B; 0x01E8; 0x004C; 0x013D; 0x004E; 0x0147; 0x004F; 0x01D1; + 0x0052; 0x0158; 0x0053; 0x0160; 0x0054; 0x0164; 0x0055; 0x01D3; + 0x005A; 0x017D; 0x0061; 0x01CE; 0x0063; 0x010D; 0x0064; 0x010F; + 0x0065; 0x011B; 0x0067; 0x01E7; 0x0068; 0x021F; 0x0069; 0x01D0; + 0x006A; 0x01F0; 0x006B; 0x01E9; 0x006C; 0x013E; 0x006E; 0x0148; + 0x006F; 0x01D2; 0x0072; 0x0159; 0x0073; 0x0161; 0x0074; 0x0165; + 0x0075; 0x01D4; 0x007A; 0x017E; 0x00DC; 0x01D9; 0x00FC; 0x01DA; + 0x01B7; 0x01EE; 0x0292; 0x01EF; 0x0041; 0x0200; 0x0045; 0x0204; + 0x0049; 0x0208; 0x004F; 0x020C; 0x0052; 0x0210; 0x0055; 0x0214; + 0x0061; 0x0201; 0x0065; 0x0205; 0x0069; 0x0209; 0x006F; 0x020D; + 0x0072; 0x0211; 0x0075; 0x0215; 0x0474; 0x0476; 0x0475; 0x0477; + 0x0041; 0x0202; 0x0045; 0x0206; 0x0049; 0x020A; 0x004F; 0x020E; + 0x0052; 0x0212; 0x0055; 0x0216; 0x0061; 0x0203; 0x0065; 0x0207; + 0x0069; 0x020B; 0x006F; 0x020F; 0x0072; 0x0213; 0x0075; 0x0217; + 0x0391; 0x1F08; 0x0395; 0x1F18; 0x0397; 0x1F28; 0x0399; 0x1F38; + 0x039F; 0x1F48; 0x03A9; 0x1F68; 0x03B1; 0x1F00; 0x03B5; 0x1F10; + 0x03B7; 0x1F20; 0x03B9; 0x1F30; 0x03BF; 0x1F40; 0x03C1; 0x1FE4; + 0x03C5; 0x1F50; 0x03C9; 0x1F60; 0x0391; 0x1F09; 0x0395; 0x1F19; + 0x0397; 0x1F29; 0x0399; 0x1F39; 0x039F; 0x1F49; 0x03A1; 0x1FEC; + 0x03A5; 0x1F59; 0x03A9; 0x1F69; 0x03B1; 0x1F01; 0x03B5; 0x1F11; + 0x03B7; 0x1F21; 0x03B9; 0x1F31; 0x03BF; 0x1F41; 0x03C1; 0x1FE5; + 0x03C5; 0x1F51; 0x03C9; 0x1F61; 0x004F; 0x01A0; 0x0055; 0x01AF; + 0x006F; 0x01A1; 0x0075; 0x01B0; 0x0041; 0x1EA0; 0x0042; 0x1E04; + 0x0044; 0x1E0C; 0x0045; 0x1EB8; 0x0048; 0x1E24; 0x0049; 0x1ECA; + 0x004B; 0x1E32; 0x004C; 0x1E36; 0x004D; 0x1E42; 0x004E; 0x1E46; + 0x004F; 0x1ECC; 0x0052; 0x1E5A; 0x0053; 0x1E62; 0x0054; 0x1E6C; + 0x0055; 0x1EE4; 0x0056; 0x1E7E; 0x0057; 0x1E88; 0x0059; 0x1EF4; + 0x005A; 0x1E92; 0x0061; 0x1EA1; 0x0062; 0x1E05; 0x0064; 0x1E0D; + 0x0065; 0x1EB9; 0x0068; 0x1E25; 0x0069; 0x1ECB; 0x006B; 0x1E33; + 0x006C; 0x1E37; 0x006D; 0x1E43; 0x006E; 0x1E47; 0x006F; 0x1ECD; + 0x0072; 0x1E5B; 0x0073; 0x1E63; 0x0074; 0x1E6D; 0x0075; 0x1EE5; + 0x0076; 0x1E7F; 0x0077; 0x1E89; 0x0079; 0x1EF5; 0x007A; 0x1E93; + 0x01A0; 0x1EE2; 0x01A1; 0x1EE3; 0x01AF; 0x1EF0; 0x01B0; 0x1EF1; + 0x0055; 0x1E72; 0x0075; 0x1E73; 0x0041; 0x1E00; 0x0061; 0x1E01; + 0x0053; 0x0218; 0x0054; 0x021A; 0x0073; 0x0219; 0x0074; 0x021B; + 0x0043; 0x00C7; 0x0044; 0x1E10; 0x0045; 0x0228; 0x0047; 0x0122; + 0x0048; 0x1E28; 0x004B; 0x0136; 0x004C; 0x013B; 0x004E; 0x0145; + 0x0052; 0x0156; 0x0053; 0x015E; 0x0054; 0x0162; 0x0063; 0x00E7; + 0x0064; 0x1E11; 0x0065; 0x0229; 0x0067; 0x0123; 0x0068; 0x1E29; + 0x006B; 0x0137; 0x006C; 0x013C; 0x006E; 0x0146; 0x0072; 0x0157; + 0x0073; 0x015F; 0x0074; 0x0163; 0x0041; 0x0104; 0x0045; 0x0118; + 0x0049; 0x012E; 0x004F; 0x01EA; 0x0055; 0x0172; 0x0061; 0x0105; + 0x0065; 0x0119; 0x0069; 0x012F; 0x006F; 0x01EB; 0x0075; 0x0173; + 0x0044; 0x1E12; 0x0045; 0x1E18; 0x004C; 0x1E3C; 0x004E; 0x1E4A; + 0x0054; 0x1E70; 0x0055; 0x1E76; 0x0064; 0x1E13; 0x0065; 0x1E19; + 0x006C; 0x1E3D; 0x006E; 0x1E4B; 0x0074; 0x1E71; 0x0075; 0x1E77; + 0x0048; 0x1E2A; 0x0068; 0x1E2B; 0x0045; 0x1E1A; 0x0049; 0x1E2C; + 0x0055; 0x1E74; 0x0065; 0x1E1B; 0x0069; 0x1E2D; 0x0075; 0x1E75; + 0x0042; 0x1E06; 0x0044; 0x1E0E; 0x004B; 0x1E34; 0x004C; 0x1E3A; + 0x004E; 0x1E48; 0x0052; 0x1E5E; 0x0054; 0x1E6E; 0x005A; 0x1E94; + 0x0062; 0x1E07; 0x0064; 0x1E0F; 0x0068; 0x1E96; 0x006B; 0x1E35; + 0x006C; 0x1E3B; 0x006E; 0x1E49; 0x0072; 0x1E5F; 0x0074; 0x1E6F; + 0x007A; 0x1E95; 0x003C; 0x226E; 0x003D; 0x2260; 0x003E; 0x226F; + 0x2190; 0x219A; 0x2192; 0x219B; 0x2194; 0x21AE; 0x21D0; 0x21CD; + 0x21D2; 0x21CF; 0x21D4; 0x21CE; 0x2203; 0x2204; 0x2208; 0x2209; + 0x220B; 0x220C; 0x2223; 0x2224; 0x2225; 0x2226; 0x223C; 0x2241; + 0x2243; 0x2244; 0x2245; 0x2247; 0x2248; 0x2249; 0x224D; 0x226D; + 0x2261; 0x2262; 0x2264; 0x2270; 0x2265; 0x2271; 0x2272; 0x2274; + 0x2273; 0x2275; 0x2276; 0x2278; 0x2277; 0x2279; 0x227A; 0x2280; + 0x227B; 0x2281; 0x227C; 0x22E0; 0x227D; 0x22E1; 0x2282; 0x2284; + 0x2283; 0x2285; 0x2286; 0x2288; 0x2287; 0x2289; 0x2291; 0x22E2; + 0x2292; 0x22E3; 0x22A2; 0x22AC; 0x22A8; 0x22AD; 0x22A9; 0x22AE; + 0x22AB; 0x22AF; 0x22B2; 0x22EA; 0x22B3; 0x22EB; 0x22B4; 0x22EC; + 0x22B5; 0x22ED; 0x00A8; 0x1FC1; 0x03B1; 0x1FB6; 0x03B7; 0x1FC6; + 0x03B9; 0x1FD6; 0x03C5; 0x1FE6; 0x03C9; 0x1FF6; 0x03CA; 0x1FD7; + 0x03CB; 0x1FE7; 0x1F00; 0x1F06; 0x1F01; 0x1F07; 0x1F08; 0x1F0E; + 0x1F09; 0x1F0F; 0x1F20; 0x1F26; 0x1F21; 0x1F27; 0x1F28; 0x1F2E; + 0x1F29; 0x1F2F; 0x1F30; 0x1F36; 0x1F31; 0x1F37; 0x1F38; 0x1F3E; + 0x1F39; 0x1F3F; 0x1F50; 0x1F56; 0x1F51; 0x1F57; 0x1F59; 0x1F5F; + 0x1F60; 0x1F66; 0x1F61; 0x1F67; 0x1F68; 0x1F6E; 0x1F69; 0x1F6F; + 0x1FBF; 0x1FCF; 0x1FFE; 0x1FDF; 0x0391; 0x1FBC; 0x0397; 0x1FCC; + 0x03A9; 0x1FFC; 0x03AC; 0x1FB4; 0x03AE; 0x1FC4; 0x03B1; 0x1FB3; + 0x03B7; 0x1FC3; 0x03C9; 0x1FF3; 0x03CE; 0x1FF4; 0x1F00; 0x1F80; + 0x1F01; 0x1F81; 0x1F02; 0x1F82; 0x1F03; 0x1F83; 0x1F04; 0x1F84; + 0x1F05; 0x1F85; 0x1F06; 0x1F86; 0x1F07; 0x1F87; 0x1F08; 0x1F88; + 0x1F09; 0x1F89; 0x1F0A; 0x1F8A; 0x1F0B; 0x1F8B; 0x1F0C; 0x1F8C; + 0x1F0D; 0x1F8D; 0x1F0E; 0x1F8E; 0x1F0F; 0x1F8F; 0x1F20; 0x1F90; + 0x1F21; 0x1F91; 0x1F22; 0x1F92; 0x1F23; 0x1F93; 0x1F24; 0x1F94; + 0x1F25; 0x1F95; 0x1F26; 0x1F96; 0x1F27; 0x1F97; 0x1F28; 0x1F98; + 0x1F29; 0x1F99; 0x1F2A; 0x1F9A; 0x1F2B; 0x1F9B; 0x1F2C; 0x1F9C; + 0x1F2D; 0x1F9D; 0x1F2E; 0x1F9E; 0x1F2F; 0x1F9F; 0x1F60; 0x1FA0; + 0x1F61; 0x1FA1; 0x1F62; 0x1FA2; 0x1F63; 0x1FA3; 0x1F64; 0x1FA4; + 0x1F65; 0x1FA5; 0x1F66; 0x1FA6; 0x1F67; 0x1FA7; 0x1F68; 0x1FA8; + 0x1F69; 0x1FA9; 0x1F6A; 0x1FAA; 0x1F6B; 0x1FAB; 0x1F6C; 0x1FAC; + 0x1F6D; 0x1FAD; 0x1F6E; 0x1FAE; 0x1F6F; 0x1FAF; 0x1F70; 0x1FB2; + 0x1F74; 0x1FC2; 0x1F7C; 0x1FF2; 0x1FB6; 0x1FB7; 0x1FC6; 0x1FC7; + 0x1FF6; 0x1FF7; 0x0627; 0x0622; 0x0627; 0x0623; 0x0648; 0x0624; + 0x064A; 0x0626; 0x06C1; 0x06C2; 0x06D2; 0x06D3; 0x06D5; 0x06C0; + 0x0627; 0x0625; 0x0928; 0x0929; 0x0930; 0x0931; 0x0933; 0x0934; + 0x09C7; 0x09CB; 0x09C7; 0x09CC; 0x0B47; 0x0B4B; 0x0B47; 0x0B48; + 0x0B47; 0x0B4C; 0x0BC6; 0x0BCA; 0x0BC7; 0x0BCB; 0x0B92; 0x0B94; + 0x0BC6; 0x0BCC; 0x0C46; 0x0C48; 0x0CC6; 0x0CCA; 0x0CBF; 0x0CC0; + 0x0CC6; 0x0CC7; 0x0CCA; 0x0CCB; 0x0CC6; 0x0CC8; 0x0D46; 0x0D4A; + 0x0D47; 0x0D4B; 0x0D46; 0x0D4C; 0x0DD9; 0x0DDA; 0x0DDC; 0x0DDD; + 0x0DD9; 0x0DDC; 0x0DD9; 0x0DDE; 0x1025; 0x1026; 0x3046; 0x3094; + 0x304B; 0x304C; 0x304D; 0x304E; 0x304F; 0x3050; 0x3051; 0x3052; + 0x3053; 0x3054; 0x3055; 0x3056; 0x3057; 0x3058; 0x3059; 0x305A; + 0x305B; 0x305C; 0x305D; 0x305E; 0x305F; 0x3060; 0x3061; 0x3062; + 0x3064; 0x3065; 0x3066; 0x3067; 0x3068; 0x3069; 0x306F; 0x3070; + 0x3072; 0x3073; 0x3075; 0x3076; 0x3078; 0x3079; 0x307B; 0x307C; + 0x309D; 0x309E; 0x30A6; 0x30F4; 0x30AB; 0x30AC; 0x30AD; 0x30AE; + 0x30AF; 0x30B0; 0x30B1; 0x30B2; 0x30B3; 0x30B4; 0x30B5; 0x30B6; + 0x30B7; 0x30B8; 0x30B9; 0x30BA; 0x30BB; 0x30BC; 0x30BD; 0x30BE; + 0x30BF; 0x30C0; 0x30C1; 0x30C2; 0x30C4; 0x30C5; 0x30C6; 0x30C7; + 0x30C8; 0x30C9; 0x30CF; 0x30D0; 0x30D2; 0x30D3; 0x30D5; 0x30D6; + 0x30D8; 0x30D9; 0x30DB; 0x30DC; 0x30EF; 0x30F7; 0x30F0; 0x30F8; + 0x30F1; 0x30F9; 0x30F2; 0x30FA; 0x30FD; 0x30FE; 0x306F; 0x3071; + 0x3072; 0x3074; 0x3075; 0x3077; 0x3078; 0x307A; 0x307B; 0x307D; + 0x30CF; 0x30D1; 0x30D2; 0x30D4; 0x30D5; 0x30D7; 0x30D8; 0x30DA; + 0x30DB; 0x30DD +|] + +let uniCharCombiningBitmap = "\ +\x00\x00\x00\x01\x02\x03\x04\x05\ +\x00\x06\x07\x08\x09\x0A\x0B\x0C\ +\x0D\x14\x00\x00\x00\x00\x00\x0E\ +\x0F\x00\x00\x00\x00\x00\x00\x00\ +\x10\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x11\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x12\x00\x00\x13\x00\ +\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\ +\xFF\xFF\x00\x00\xFF\xFF\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x78\x03\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\xFE\xFF\xFB\xFF\xFF\xBB\ +\x16\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\xF8\x3F\x00\x00\x00\x01\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\xC0\xFF\x9F\x3D\x00\x00\ +\x00\x00\x02\x00\x00\x00\xFF\xFF\ +\xFF\x07\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\xC0\xFF\x01\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x0E\x00\x00\x00\x00\x00\x00\xD0\ +\xFF\x3F\x1E\x00\x0C\x00\x00\x00\ +\x0E\x00\x00\x00\x00\x00\x00\xD0\ +\x9F\x39\x80\x00\x0C\x00\x00\x00\ +\x04\x00\x00\x00\x00\x00\x00\xD0\ +\x87\x39\x00\x00\x00\x00\x03\x00\ +\x0E\x00\x00\x00\x00\x00\x00\xD0\ +\xBF\x3B\x00\x00\x00\x00\x00\x00\ +\x0E\x00\x00\x00\x00\x00\x00\xD0\ +\x8F\x39\xC0\x00\x00\x00\x00\x00\ +\x04\x00\x00\x00\x00\x00\x00\xC0\ +\xC7\x3D\x80\x00\x00\x00\x00\x00\ +\x0E\x00\x00\x00\x00\x00\x00\xC0\ +\xDF\x3D\x60\x00\x00\x00\x00\x00\ +\x0C\x00\x00\x00\x00\x00\x00\xC0\ +\xDF\x3D\x60\x00\x00\x00\x00\x00\ +\x0C\x00\x00\x00\x00\x00\x00\xC0\ +\xCF\x3D\x80\x00\x00\x00\x00\x00\ +\x0C\x00\x00\x00\x00\x00\x00\x00\ +\x00\x84\x5F\xFF\x00\x00\x0C\x00\ +\x00\x00\x00\x00\x00\x00\xF2\x07\ +\x80\x7F\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\xF2\x1B\ +\x00\x3F\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x03\x00\x00\xA0\xC2\ +\x00\x00\x00\x00\x00\x00\xFE\xFF\ +\xDF\x00\xFF\xFE\xFF\xFF\xFF\x1F\ +\x40\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\xF0\xC7\x03\ +\x00\x00\xC0\x03\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x1C\x00\x00\x00\x1C\x00\ +\x00\x00\x0C\x00\x00\x00\x0C\x00\ +\x00\x00\x00\x00\x00\x00\xF0\xFF\ +\xFF\xFF\x0F\x00\x00\x00\x00\x00\ +\x00\x38\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x02\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\xFF\xFF\xFF\x07\x00\x00\ +\x00\x00\x00\x00\x00\xFC\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x06\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x40\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\xFF\xFF\x00\x00\x0F\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\x00\x00\x00\x00\ +\x00\x00\x00\x00\xFE\xFF\x3F\x00\ +\x00\x00\x00\x00\x00\xFF\xFF\xFF\ +\x07\x00\x00\x00\x00\x00\x00\x00" + +(****) + +let bitmap_test base bitmap character = + character >= base && character < 0x10000 + && + (let value = get bitmap ((character lsr 8) land 0xFF) in + value = 0xFF + || + (value <> 0 + && + get bitmap ((value - 1) * 32 + 256 + (character land 0xFF) / 8) + land (1 lsl (character land 7)) <> 0)) + +let unicode_combinable character = + bitmap_test 0x0300 uniCharCombiningBitmap character + +let rec find_rec t i j v = + if i + 1 = j then begin + if t.(i * 2) = v then t.(i * 2 + 1) else 0 + end else begin + let k = (i + j) / 2 in + if v < t.(k * 2) then + find_rec t i k v + else + find_rec t k j v + end + +let find t i n v = + let j = i + n in + if v < t.(2 * i) || v > t.(2 * (j - 1)) then 0 else + find_rec t i j v + +let uniCharPrecompSourceTableLen = Array.length uniCharPrecompSourceTable / 2 + +let combine v v' = + if v' >= hangul_vbase && v' < hangul_tbase + hangul_tcount then begin + if + v' < hangul_vbase + hangul_vcount && + v >= hangul_lbase && v < hangul_lbase + hangul_lcount + then + hangul_sbase + ((v - hangul_lbase) * (hangul_vcount * hangul_tcount)) + + ((v' - hangul_vbase) * hangul_tcount) + else if + v' > hangul_tbase && + v >= hangul_sbase && v < hangul_sbase + hangul_scount + then + if (v - hangul_sbase) mod hangul_tcount <> 0 then 0 else + v + v' - hangul_tbase + else + 0 + end else begin + let k = + find uniCharPrecompSourceTable 0 + uniCharPrecompSourceTableLen v' + in + if k = 0 then 0 else + find uniCharBMPPrecompDestinationTable (k land 0xFFFF) (k lsr 16) v + end + +(****) + +let rec scan d s i l = + if i < l then begin + let c = get s i in + if c < 0x80 then + cont d s i l (i + 1) c + else if c < 0xE0 then begin + (* 80 - 7FF *) + if c < 0xc2 || i + 1 >= l then fail () else + let c1 = get s (i + 1) in + if c1 land 0xc0 <> 0x80 then fail () else + let v = c lsl 6 + c1 - 0x3080 in + cont d s i l (i + 2) v + end else if c < 0xF0 then begin + (* 800 - FFFF *) + if i + 2 >= l then fail () else + let c1 = get s (i + 1) in + let c2 = get s (i + 2) in + if (c1 lor c2) land 0xc0 <> 0x80 then fail () else + let v = c lsl 12 + c1 lsl 6 + c2 - 0xe2080 in + if v < 0x800 then fail () else + cont d s i l (i + 3) v + end else begin + (* 10000 - 10FFFF *) + if i + 3 >= l then fail () else + let c1 = get s (i + 1) in + let c2 = get s (i + 2) in + let c3 = get s (i + 3) in + if (c1 lor c2 lor c3) land 0xc0 <> 0x80 then fail () else + let v = c lsl 18 + c1 lsl 12 + c2 lsl 6 + c3 - 0x03c82080 in + if v < 0x10000 || v > 0x10ffff then fail () else + cont d s i l (i + 4) v + end + end else begin + let (i1, i2) = d in + String.blit s i2 s i1 (l - i2); + String.sub s 0 (i1 + l - i2) + end + +and cont d s i l j v' = + if unicode_combinable v' then begin + let i = prev_char s i in + let (v, _) = decode_char s i l in + let v'' = combine v v' in + if v'' = 0 then + scan d s j l + else begin + let (i1, i2) = d in + String.blit s i2 s i1 (i - i2); + let i1 = i1 + i - i2 in + let (v'', i) = compose_rec s j l v'' in + let i1 = encode_char s i1 l v'' in + scan (i1, i) s i l + end + end else + scan d s j l + +and compose_rec s i l v = + try + let (v', j) = decode_char s i l in + if unicode_combinable v' then begin + let v'' = combine v v' in + if v'' = 0 then + (v, i) + else + compose_rec s j l v'' + end else + (v, i) + with Invalid -> + (v, i) + +let compose s = + try scan (0, 0) (String.copy s) 0 (String.length s) with Invalid -> s + +(***) + +let set_2 s i v = + set s i (v land 0xff); + set s (i + 1) (v lsr 8) + +let get_2 s i = (get s (i + 1)) lsl 8 + get s i + +let rec scan s' j s i l = + if i < l then begin + let c = get s i in + if c < 0x80 then + cont s' j s (i + 1) l c + else if c < 0xE0 then begin + (* 80 - 7FF *) + if c < 0xc2 || i + 1 >= l then fail () else + let c1 = get s (i + 1) in + if c1 land 0xc0 <> 0x80 then fail () else + let v = c lsl 6 + c1 - 0x3080 in + cont s' j s (i + 2) l v + end else if c < 0xF0 then begin + (* 800 - FFFF *) + if i + 2 >= l then fail () else + let c1 = get s (i + 1) in + let c2 = get s (i + 2) in + if (c1 lor c2) land 0xc0 <> 0x80 then fail () else + let v = c lsl 12 + c1 lsl 6 + c2 - 0xe2080 in + if v < 0x800 then fail () else + cont s' j s (i + 3) l v + end else begin + (* 10000 - 10FFFF *) + if i + 3 >= l then fail () else + let c1 = get s (i + 1) in + let c2 = get s (i + 2) in + let c3 = get s (i + 3) in + if (c1 lor c2 lor c3) land 0xc0 <> 0x80 then fail () else + let v = c lsl 18 + c1 lsl 12 + c2 lsl 6 + c3 - 0x03c82080 in + if v < 0x10000 || v > 0x10ffff then fail () else + cont s' j s (i + 4) l v + end + end else + String.sub s' 0 j + +and cont s' j s i l v = + if v < 0x10000 then begin + set_2 s' j v; + scan s' (j + 2) s i l + end else begin + let v = v - 0x10000 in + set_2 s' j (v lsr 10 + 0xD800); + set_2 s' (j + 2) (v land 0x3FF + 0xDC00); + scan s' (j + 4) s i l + end + +let to_utf_16 s = + let l = String.length s in + let s' = String.create (2 * l) in + scan s' 0 s 0 l + +(****) + +let rec scan s' i' l' s i l = + if i + 2 <= l then begin + let v = get_2 s i in + if v < 0xD800 || v > 0xDFFF then + let i' = encode_char s' i' l' v in + scan s' i' l' s (i + 2) l + else if v >= 0xdc00 || i + 4 > l then + fail () + else begin + let v' = get_2 s (i + 2) in + if v' < 0xDC00 || v' > 0XDFFF then fail () else + let i' = + encode_char s' i' l' ((v - 0xD800) lsl 10 + (v' - 0xDC00) + 0x10000) + in + scan s' i' l' s (i + 4) l + end + end else if i < l then + fail () + else + String.sub s' 0 i' + +let from_utf_16 s = + let l = String.length s in + let l' = 3 * l / 2 in + let s' = String.create l' in + scan s' 0 l' s 0 l + +(****) + +let rec scan s i l = + i = l || + let c = get s i in + if c < 0x80 then + scan s (i + 1) l + else if c < 0xE0 then begin + (* 80 - 7FF *) + c >= 0xc2 && i + 1 < l && + let c1 = get s (i + 1) in + c1 land 0xc0 = 0x80 && + scan s (i + 2) l + end else if c < 0xF0 then begin + (* 800 - FFFF *) + i + 2 < l && + let c1 = get s (i + 1) in + let c2 = get s (i + 2) in + (c1 lor c2) land 0xc0 = 0x80 && + let v = c lsl 12 + c1 lsl 6 + c2 - 0xe2080 in + v >= 0x800 && + scan s (i + 3) l + end else begin + (* 10000 - 10FFFF *) + i + 3 < l && + let c1 = get s (i + 1) in + let c2 = get s (i + 2) in + let c3 = get s (i + 3) in + (c1 lor c2 lor c3) land 0xc0 = 0x80 && + let v = c lsl 18 + c1 lsl 12 + c2 lsl 6 + c3 - 0x03c82080 in + v >= 0x10000 && v < 0x10ffff && + scan s (i + 4) l + end + +let check_utf_8 s = scan s 0 (String.length s) Added: trunk/src/unicode.mli =================================================================== --- trunk/src/unicode.mli (rev 0) +++ trunk/src/unicode.mli 2009-05-04 18:48:23 UTC (rev 326) @@ -0,0 +1,23 @@ +(* Unison file synchronizer: src/unicode.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + + +(* Case-insensitive comparison. If two strings are equal according to + Mac OS X (Darwin, actually, but the algorithm has hopefully + remained unchanged) or Windows (Samba), then this function returns 0 *) +val compare : string -> string -> int + +(* Corresponding normalization *) +val normalize : string -> string + +(* Compose Unicode strings. This reverts the decomposition performed + by Mac OS X. *) +val compose : string -> string + +(* Convert to and from little-endian UTF-16 encoding *) +(*XXX What about null-termination? *) +val to_utf_16 : string -> string +val from_utf_16 : string -> string + +(* Check wether the string contains only well-formed UTF-8 characters *) +val check_utf_8 : string -> bool Added: trunk/src/unicode_tables.ml =================================================================== --- trunk/src/unicode_tables.ml (rev 0) +++ trunk/src/unicode_tables.ml 2009-05-04 18:48:23 UTC (rev 326) @@ -0,0 +1,11 @@ +(*-*-coding: utf-8;-*-*) +let ascii_lower = + "\000\001\002\003\004\005\006\007\008\t\n\011\012\013\014\015\016\017\018\019\020\021\022\023\024\025\026\027\028\029\030\031 !\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\127" +let norm_repl = + "\003aÌ€\003aÌ\003aÌ‚\003ã\003ä\003aÌŠ\002æ\003ç\003eÌ€\003eÌ\003eÌ‚\003ë\003iÌ€\003iÌ\003iÌ‚\003ï\002ð\003ñ\003oÌ€\003oÌ\003oÌ‚\003õ\003ö\002ø\003uÌ€\003uÌ\003uÌ‚\003ü\003yÌ\002þ\003ÿ\003aÌ„\003ă\003ą\003cÌ\003cÌ‚\003ċ\003cÌŒ\003dÌŒ\002Ä‘\003eÌ„\003ĕ\003ė\003ę\003eÌŒ\003gÌ‚\003ğ\003ġ\003ģ\003hÌ‚\002ħ\003ĩ\003iÌ„\003ĭ\003į\003i̇\002ij\003jÌ‚\003ķ\003lÌ\003ļ\003lÌŒ\002Å€\002Å‚\003nÌ\003ņ\003nÌŒ\002Å‹\003oÌ„\003ŏ\003oÌ‹\002Å“\003rÌ\003ŗ\003rÌŒ\003sÌ\003sÌ‚\003ş\003sÌŒ\003ţ\003tÌŒ\002ŧ\003ũ\003uÌ„\003ŭ\003uÌŠ\003uÌ‹\003ų\003wÌ‚\003yÌ‚\003zÌ\003ż\003zÌŒ\002É“\002ƃ\002Æ…\002É”\002ƈ\002É–\002É—\002ÆŒ\002Ç\002É™\002É›\002Æ’\002É \002É£\002É©\002ɨ\002Æ™\002ɯ\002ɲ\002ɵ\003oÌ›\002Æ£\002Æ¥\002ƨ\002ʃ\002Æ­\002ʈ\003uÌ›\002ÊŠ\002Ê‹\002Æ´\002ƶ\002Ê’\002ƹ\002ƽ\002dž\002lj\002ÇŒ\003aÌŒ\003iÌŒ\003oÌŒ\003uÌŒ\005ǖ\005üÌ\005ǚ\005ǜ\005ǟ\005ǡ\004ǣ\002Ç¥\003gÌŒ\003kÌŒ\003oÌ! ¨\005ǭ\004Ê’ÌŒ\003jÌŒ\002dz\003gÌ\003nÌ€\005aÌŠÌ\004æÌ\004øÌ\003aÌ\003aÌ‘\003eÌ\003eÌ‘\003iÌ\003iÌ‘\003oÌ\003oÌ‘\003rÌ\003rÌ‘\003uÌ\003uÌ‘\003ș\003ț\003hÌŒ\003ȧ\003ȩ\005ȫ\005ȭ\003ȯ\005ȱ\003yÌ„\002Ì€\002Ì\002Ì“\004̈Ì\002ʹ\001;\004¨Ì\004αÌ\002·\004εÌ\004ηÌ\004ιÌ\004οÌ\004Ï…Ì\004ωÌ\006ϊÌ\002α\002β\002γ\002δ\002ε\002ζ\002η\002θ\002ι\002κ\002λ\002μ\002ν\002ξ\002ο\002Ï€\002Ï\002σ\002Ï„\002Ï…\002φ\002χ\002ψ\002ω\004ϊ\004ϋ\006ϋÌ\004Ï’Ì\004ϔ\002Ï£\002Ï¥\002ϧ\002Ï©\002Ï«\002Ï­\002ϯ\004ѐ\004ё\002Ñ’\004гÌ\002Ñ”\002Ñ•\002Ñ–\004ї\002ј\002Ñ™\002Ñš\002Ñ›\004кÌ\004ѝ\004ў\002ÑŸ\002а\002б\002в\002г\002д\002е\002ж\002з\002и\004й\002к\002л\002м\002н\002о\002п\002Ñ€\002Ñ\002Ñ‚\002у\002Ñ„\002Ñ…\002ц\002ч\002ш\002щ\002ÑŠ\002Ñ‹\002ÑŒ\002Ñ\002ÑŽ\002Ñ\002Ñ¡\002Ñ£\002Ñ¥\002ѧ\002Ñ©\002Ñ«\002Ñ­\002ѯ\002ѱ\002ѳ\002ѵ\004ѵÌ\002ѹ\002Ñ»\002ѽ\002Ñ¿\002Ò\002Ò! ‘\002Ò“\002Ò•\002Ò—\002Ò™\002Ò›\002Ò\002ÒŸ\002Ò¡\002Ò£\002Ò¥\! 002Ò§\00 2Ò©\002Ò«\002Ò­\002Ò¯\002Ò±\002Ò³\002Òµ\002Ò·\002Ò¹\002Ò»\002Ò½\002Ò¿\004ӂ\002Ó„\002Óˆ\002ÓŒ\004ӑ\004ӓ\002Ó•\004ӗ\002Ó™\004ӛ\004ӝ\004ӟ\002Ó¡\004ӣ\004ӥ\004ӧ\002Ó©\004ӫ\004Ñ̈\004ӯ\004ӱ\004ӳ\004ӵ\004ӹ\002Õ¡\002Õ¢\002Õ£\002Õ¤\002Õ¥\002Õ¦\002Õ§\002Õ¨\002Õ©\002Õª\002Õ«\002Õ¬\002Õ­\002Õ®\002Õ¯\002Õ°\002Õ±\002Õ²\002Õ³\002Õ´\002Õµ\002Õ¶\002Õ·\002Õ¸\002Õ¹\002Õº\002Õ»\002Õ¼\002Õ½\002Õ¾\002Õ¿\002Ö€\002Ö\002Ö‚\002Öƒ\002Ö„\002Ö…\002Ö†\004آ\004أ\004ÙˆÙ”\004إ\004ÙŠÙ”\004Û•Ù”\004ÛÙ”\004Û’Ù”\006ऩ\006ऱ\006ऴ\006क़\006ख़\006ग़\006ज़\006ड़\006ढ़\006फ़\006य़\006ো\006ৌ\006ড়\006ঢ়\006য়\006ਲ਼\006ਸ਼\006ਖ਼\006ਗ਼\006ਜ਼\006ਫ਼\006ୈ\006ୋ\006ୌ\006ଡ଼\006ଢ଼\006ஔ\006ொ\006ோ\006ௌ\006ై\006ೀ\006ೇ\006ೈ\006ೊ\009ೋ\006ൊ\006ോ\006ൌ\006ේ\006à·™à·\009à·™à·à·Š\006ෞ\006! གྷ\006ཌྷ\006དྷ\006བྷ\006ཛྷ\006ཀྵ\006ཱི\006ཱུ\006ྲྀ\006ླྀ\006ཱྀ\006ྒྷ\006ྜྷ\006ྡྷ\006ྦྷ\006ྫྷ\006à¾à¾µ\006ဦ\003áƒ\003ბ\003გ\003დ\003ე\003ვ\003ზ\003თ\003ი\003კ\003ლ\003მ\003ნ\003áƒ\003პ\003ჟ\003რ\003ს\003ტ\003უ\003ფ\003ქ\003ღ\003ყ\003შ\003ჩ\003ც\003ძ\003წ\003ჭ\003ხ\003ჯ\003ჰ\003ჱ\003ჲ\003ჳ\003ჴ\003ჵ\003aÌ¥\003ḃ\003bÌ£\003ḇ\005çÌ\003ḋ\003dÌ£\003ḏ\003ḑ\003dÌ­\005eÌ„Ì€\005eÌ„Ì\003eÌ­\003eÌ°\005ḝ\003ḟ\003gÌ„\003ḣ\003hÌ£\003ḧ\003ḩ\003hÌ®\003iÌ°\005ïÌ\003kÌ\003kÌ£\003ḵ\003lÌ£\005ḹ\003ḻ\003lÌ­\003mÌ\003ṁ\003mÌ£\003ṅ\003nÌ£\003ṉ\003nÌ­\005õÌ\005ṏ\005oÌ„Ì€\005oÌ„Ì\003pÌ\003ṗ\003ṙ\003rÌ£\005ṝ\003ṟ\003ṡ\003sÌ£\005sÌ̇\005ṧ\005ṩ\003ṫ\003tÌ£\003ṯ\003tÌ­\003ṳ\003uÌ°\003uÌ­\005ũÌ\005ṻ\003ṽ\003vÌ£\003wÌ€\003wÌ\003ẅ\003ẇ\003wÌ£\003ẋ\003ẍ\003ẏ\003zÌ‚\00! 3zÌ£\003ẕ\003ẖ\003ẗ\003wÌŠ\003yÌŠ\004ẛ\003aÌ£\003ả\! 005aÌ‚Ì \005aÌ‚Ì€\005ẩ\005ẫ\005ậ\005ăÌ\005ằ\005ẳ\005ẵ\005ặ\003eÌ£\003ẻ\003ẽ\005eÌ‚Ì\005eÌ‚Ì€\005ể\005ễ\005ệ\003ỉ\003iÌ£\003oÌ£\003ỏ\005oÌ‚Ì\005oÌ‚Ì€\005ổ\005ỗ\005ộ\005oÌ›Ì\005ờ\005ở\005ỡ\005ợ\003uÌ£\003ủ\005uÌ›Ì\005ừ\005ử\005ữ\005ự\003yÌ€\003yÌ£\003ỷ\003ỹ\004ἀ\004ἁ\006ἂ\006ἃ\006ἀÌ\006ἁÌ\006ἆ\006ἇ\004ἐ\004ἑ\006ἒ\006ἓ\006ἐÌ\006ἑÌ\004ἠ\004ἡ\006ἢ\006ἣ\006ἠÌ\006ἡÌ\006ἦ\006ἧ\004ἰ\004ἱ\006ἲ\006ἳ\006ἰÌ\006ἱÌ\006ἶ\006ἷ\004ὀ\004ὁ\006ὂ\006ὃ\006ὀÌ\006ὁÌ\004Ï…Ì“\004Ï…Ì”\006Ï…Ì“Ì€\006ὓ\006Ï…Ì“Ì\006Ï…Ì”Ì\006Ï…Ì“Í‚\006ὗ\004ὠ\004ὡ\006ὢ\006ὣ\006ὠÌ\006ὡÌ\006ὦ\006ὧ\004ὰ\004ὲ\004ὴ\004ὶ\004ὸ\004Ï…Ì€\004ὼ\006ᾀ\006ᾁ\008ᾂ\008ᾃ\008ἀÌÍ…\008ἁÌÍ…\008ᾆ\008ἁÍ! ‚Í…\006ᾐ\006ᾑ\008ᾒ\008ᾓ\008ἠÌÍ…\008ἡÌÍ…\008ᾖ\008ᾗ\006ᾠ\006ᾡ\008ᾢ\008ᾣ\008ὠÌÍ…\008ὡÌÍ…\008ᾦ\008ᾧ\004ᾰ\004ᾱ\006ᾲ\004ᾳ\006αÌÍ…\004ᾶ\006ᾷ\004῁\006ῂ\004ῃ\006ηÌÍ…\004ῆ\006ῇ\005῍\005᾿Ì\005῏\004ῐ\004ῑ\006ῒ\004ῖ\006ῗ\005῝\005῾Ì\005῟\004ῠ\004Ï…Ì„\006ῢ\004ÏÌ“\004ÏÌ”\004Ï…Í‚\006ῧ\004῭\001`\006ῲ\004ῳ\006ωÌÍ…\004ῶ\006ῷ\002´\000\003â…°\003â…±\003â…²\003â…³\003â…´\003â…µ\003â…¶\003â…·\003â…¸\003â…¹\003â…º\003â…»\003â…¼\003â…½\003â…¾\003â…¿\003â“\003â“‘\003â“’\003â““\003â“”\003â“•\003â“–\003â“—\003ⓘ\003â“™\003â“š\003â“›\003â“œ\003â“\003â“ž\003â“Ÿ\003â“ \003â“¡\003â“¢\003â“£\003ⓤ\003â“¥\003ⓦ\003ⓧ\003ⓨ\003â“©\006ã‹ã‚™\006ãã‚™\006ãã‚™\006ã‘ã‚™\006ã“ã‚™\006ã•ã‚™\006ã—ã‚™\006ã™ã‚™\006ã›ã‚™\006ãã‚™\006ãŸã‚™\006ã¡ã‚™\006ã¤ã‚™\006ã¦ã‚™\006ã¨ã‚™\006ã¯ã‚™\006! ã¯ã‚š\006ã²ã‚™\006ã²ã‚š\006ãµã‚™\006ãµã‚š\006ã¸ã‚™\006ã! ¸ã‚š\006 ã»ã‚™\006ã»ã‚š\006ã†ã‚™\006ã‚ã‚™\006ã‚«ã‚™\006ã‚­ã‚™\006グ\006ゲ\006ゴ\006ザ\006ã‚·ã‚™\006ズ\006ゼ\006ゾ\006ã‚¿ã‚™\006ãƒã‚™\006ヅ\006デ\006ド\006ãƒã‚™\006ãƒã‚š\006ビ\006ピ\006ブ\006プ\006ベ\006ペ\006ボ\006ポ\006ヴ\006ヷ\006ヸ\006ヹ\006ヺ\006ヾ\004×™Ö´\004ײַ\004ש×\004שׂ\006שּ×\006שּׂ\004×Ö·\004×Ö¸\004×Ö¼\004בּ\004×’Ö¼\004דּ\004×”Ö¼\004וּ\004×–Ö¼\004טּ\004×™Ö¼\004ךּ\004×›Ö¼\004לּ\004מּ\004× Ö¼\004סּ\004×£Ö¼\004פּ\004צּ\004קּ\004רּ\004שּ\004תּ\004וֹ\004בֿ\004×›Ö¿\004פֿ\003ï½\003ｂ\003ｃ\003ｄ\003ï½…\003ｆ\003ｇ\003ｈ\003ｉ\003ｊ\003ｋ\003ｌ\003ï½\003ｎ\003ï½\003ï½\003ｑ\003ï½’\003ｓ\003ï½”\003ｕ\003ï½–\003ï½—\003ｘ\003ï½™\003ｚ" +let norm_prim = + "\000\000\000\002\003\004\005\006\007\000\000\000\000\008\009\010\011\012\013\014\015\016\000\000\017\000\000\018\000\000\000\000\000\000\000\000\019\020\000\021\022\023\000\000\000\024\025\026\000\027\000\028\000\029\000\030\000\000\000\000\000\031\032\000\033\000\034\035\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\036\037\038\039\040\041\042\043\044\045\000\000\000\046\000\000\000\000\000\000\000\000\000\000\000\000\047\048\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\049\050\051\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\! 000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\! 000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\00! 0\000\00 0\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001! \001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\052! \053\000\000\000\000\000\000\000\000\000\000\000\000\000\054\0! 55\000\0 00\000" +let norm_second_high = + "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\000\002\002\002\002\002\002\002\000\002\002\002\002\002\002\000\002\002\002\002\002\002\002\002\002\000\002\002\002\002\002\002\000\000\002\002\002\002\002\000\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\000\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\000\002\002\002\002\002\002\002\002\002\000\002\000\002\002\! 002\002\000\002\002\002\002\002\002\002\000\002\000\002\002\002\002\002\002\000\003\000\003\003\003\003\003\003\003\000\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\000\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\002\003\003\003\003\003\003\000\000\003\003\000\003\000\003\003\000\003\003\003\000\000\003\003\003\003\000\003\003\000\003\003\003\000\000\000\003\003\000\003\003\003\003\000\003\000\000\003\000\003\000\000\003\000\003\003\003\003\003\003\000\003\000\003\003\000\000\000\003\000\000\000\000\000\000\000\003\003\000\003\003\000\003\003\000\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\000\004\004\004\004\004\004\004\000\004\004\004\004\004\004\004\004\004\004\004\004\004\000\004\004\000\000\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\000\000\004\004\000\000\000\000\000\000\004\004\004\004\004\004\004\! 004\004\004\004\004\004\004\000\000\000\000\000\000\000\000\00! 0\000\00 0\000\004\004\000\004\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\004\004\004\004\004\004\000\004\000\004\004\004\004\004\004\004\004\005\005\005\005\005\005\005\005\005\005\005\005\000\005\005\005\005\005\005\005\005\005\004\004\004\004\005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\000\000\000\000\000\000\000\005\005\004\004\004\000\000\000\000\005\005\000\000\000\000\000\000\000\000\000\000\000\000\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\006\006\006\000\000\000\000\000\000! \000\000\000\005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\005\000\005\000\000\000\005\000\000\000\000\005\005\005\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\006\006\000\006\000\006\000\006\000\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\000\006\006\006\000\000\000\006\000\000\000\006\000\000\000\000\006\006\006\006\006\000\006\006\006\000\006\006\006\006\006\006\006\000\006\006\006\006\006\006\006\000\006\006\006\006\006\006\006\006\006\006\006\006\000\000\006\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \000\000\000\000\006\006\006\006\006\006\007\007\007\007\007\0! 07\007\0 07\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\007\007\007\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\000\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\000\000\000\000\000\000\000\007\000\000\007\00! 0\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\007\007\007\007\007\007\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\007\000\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\000\000\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\008\008\000\000\008\000\000\000\000\000\000\000\000\000\000\000\000\000\00! 0\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\! 000\000\ 000\000\000\000\000\000\000\000\000\000\008\000\000\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0! 00\000\000\000\000\000\000\000\000\000\000\008\000\000\000\000\000\000\008\008\000\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\008\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\000\000\000\000\000\000\000\008\000\000\000\000\008\000\000\000\000\008\000\000\000\000\008\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\0! 00\000\000\000\000\000\000\008\000\008\008\000\009\000\000\000! \000\000 \000\000\000\009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\009\000\000\000\000\000\000\000\000\000\009\000\000\000\000\009\000\000\000\000\009\000\000\000\000\009\000\000\000\000\000\000\000\000\000\000\000\000\009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\! 000\000\000\000\000\000\000\000\000\000\000\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\000\011\000\000\000\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\012\012\! 012\012\012\012\012\012\012\012\012\012\012\012\012\012\000\00! 0\000\00 0\000\000\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\000\000\012\012\012\012\012\012\000\000\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\013\013\000\000\012\012\012\012\013\013\000\000\013\013\013\013\013\013\013\013\000\013\000\013\000\013\000\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\004\013\004\013\004\013\004\013\004\013\004\013\004\000\000\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\014\014\014\014\013\013\013\013\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\000\014\014\014\014\013\004\014\000\005\000\000\014\014\014\014\000\014\014\013\004\013\004\014\014\014\014\014\014\014\004\000\000\014\014\014\014\013\004\000\014\014\014\014\014\015\005\015\015\015\015\014\014\013\004\015\015\004\015\000\000\015\015\015! \000\015\015\013\004\013\004\015\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\015\015\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\015\015\015\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\015\015\015\015\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \000\000\000\000\000\000\000\000\000\000\015\015\015\015\015\0! 15\015\0 15\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\000\015\000\015\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\000\016\000\016\000\016\000\000\000\000\000\000\016\016\000\016\016\000\016\016\000\016\016\000\016\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\000\017\000\017\000\017\000\000\000\000\000\000\017\017\000\017\017\000\017\017\000\017\017\000\017\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\01! 7\000\000\017\017\017\017\000\000\000\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\000\017\000\000\000\000\000\000\000\000\000\000\017\017\017\017\017\017\017\017\017\017\017\017\017\000\017\017\017\017\017\000\017\000\017\017\000\017\018\000\018\018\018\018\018\018\018\018\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\018\018\018\018\018\018\018\018\018\01! 8\018\018\018\018\018\018\018\018\018\018\018\018\018\018\018\! 000\000\ 000\000\000" +let norm_second_low = + "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\008\012\016\020\024\027\031\035\039\043\047\051\055\059\063\066\070\074\078\082\086\000\090\093\097\101\105\109\113\000\000\004\008\012\016\020\000\027\031\035\039\043\047\051\055\059\000\066\070\074\078\082\086\000\000\093\097\101\105\109\000\116\120\120\124\124\128\128\132\132\136\136\140\140\144\144\148\148\152\000\155\155\159\159\163\163\167\167\171\171\175\175\179\179\183\183\187\187\191\191\195\000\198\198\202\202\206\206\210\210\214\000\218\000\221\221\! 225\225\000\229\229\233\233\237\237\241\000\244\000\247\247\251\251\255\255\000\003\000\006\006\010\010\014\014\018\000\021\021\025\025\029\029\033\033\037\037\041\041\045\045\049\049\053\053\057\000\060\060\064\064\068\068\072\072\076\076\080\080\084\084\088\088\116\092\092\096\096\100\100\000\000\104\107\000\110\000\113\116\000\119\122\125\000\000\128\131\134\137\000\140\143\000\146\149\152\000\000\000\155\158\000\161\164\164\168\000\171\000\000\174\000\177\000\000\180\000\183\186\186\190\193\196\000\199\000\202\205\000\000\000\208\000\000\000\000\000\000\000\211\211\000\214\214\000\217\217\000\220\220\224\224\228\228\232\232\236\236\242\242\248\248\254\254\000\004\004\010\010\016\016\021\000\024\024\028\028\032\032\036\036\042\042\047\051\051\000\054\054\000\000\058\058\062\062\068\068\073\073\078\078\082\082\086\086\090\090\094\094\098\098\102\102\106\106\110\110\114\114\118\118\122\122\126\126\130\130\000\000\134\134\000\000\000\000\000\000\138\138\142\142\146\146\152\! 152\158\158\162\162\168\168\000\000\000\000\000\000\000\000\00! 0\000\00 0\000\172\175\000\178\181\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\186\000\000\000\000\000\000\000\000\000\189\000\000\000\000\000\000\191\196\201\204\209\214\000\219\000\224\229\234\241\244\247\250\253\000\003\006\009\012\015\018\021\024\027\030\033\000\036\039\042\045\048\051\054\057\062\196\204\209\214\067\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\036\000\000\000\000\000\000\000\057\062\219\224\229\000\000\000\000\074\079\000\000\000\000\000\000\000\000\000\000\000\000\000\084\000\087\000\090\000\093\000\096\000\099\000\102\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\105\110\115\118\123\126\129\132\137\140\143\146\149\154\159\164\167\170\173\176\179\182\185\188\191\194\199\202\205\208\211\214\217\220\223\226\229\232\235\238\241\244\247\250\253\000\003\006\000\000\000\000\000\000! \000\000\000\194\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\105\110\000\118\000\000\000\132\000\000\000\000\149\154\159\000\009\000\012\000\015\000\018\000\021\000\024\000\027\000\030\000\033\000\036\000\039\000\042\042\047\000\050\000\053\000\056\000\059\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\062\000\065\000\068\000\071\000\074\000\077\000\080\000\083\000\086\000\089\000\092\000\095\000\098\000\101\000\104\000\107\000\110\000\113\000\116\000\119\000\122\000\125\000\128\000\131\000\000\134\134\139\000\000\000\142\000\000\000\145\000\000\000\000\148\148\153\153\158\000\161\161\166\000\169\169\174\174\179\179\184\000\187\187\192\192\197\197\202\000\205\205\210\210\215\215\220\220\225\225\230\230\000\000\235\235\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \000\000\000\000\240\243\246\249\252\255\002\005\008\011\014\0! 17\020\0 23\026\029\032\035\038\041\044\047\050\053\056\059\062\065\068\071\074\077\080\083\086\089\092\095\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\098\103\108\113\118\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\123\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\133\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\138\000\000\000\000\000\000\000\145\000\000\152\00! 0\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\159\166\173\180\187\194\201\208\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\215\222\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\229\236\000\243\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\250\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\015\022\000\000\029\000\000\000\000\000\000\000\000\000\000\000\000\000\00! 0\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\! 000\000\ 000\000\000\000\000\000\000\000\000\000\036\000\000\043\050\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\057\064\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\071\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\078\085\092\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\099\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0! 00\000\000\000\000\000\000\000\000\000\000\106\000\000\000\000\000\000\113\120\000\127\134\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\144\151\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\165\000\172\179\189\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\000\000\000\000\000\000\000\000\000\203\000\000\000\000\210\000\000\000\000\217\000\000\000\000\224\000\000\000\000\000\000\000\000\000\000\000\000\231\000\000\0! 00\000\000\000\000\000\000\238\000\245\252\000\003\000\000\000! \000\000 \000\000\000\010\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\000\000\000\000\000\000\000\000\000\024\000\000\000\000\031\000\000\000\000\038\000\000\000\000\045\000\000\000\000\000\000\000\000\000\000\000\000\052\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\059\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\066\070\074\078\082\086\090\094\098\102\106\110\114\118\122\126\130\134\138\142\146\150\154\158\162\166\170\174\178\182\186\190\194\198\202\206\210\214\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\! 000\000\000\000\000\000\000\000\000\000\000\218\218\222\222\226\226\230\230\234\234\240\240\244\244\248\248\252\252\000\000\004\004\010\010\016\016\020\020\024\024\030\030\034\034\038\038\042\042\046\046\050\050\054\054\058\058\062\062\068\068\072\072\076\076\080\080\084\084\090\090\094\094\098\098\102\102\106\106\110\110\114\114\118\118\122\122\126\126\132\132\138\138\144\144\150\150\154\154\158\158\162\162\166\166\172\172\176\176\180\180\184\184\190\190\196\196\202\202\206\206\210\210\214\214\218\218\222\222\226\226\230\230\236\236\242\242\246\246\250\250\254\254\002\002\006\006\010\010\014\014\018\018\022\022\026\026\030\030\034\034\038\042\046\050\000\054\000\000\000\000\059\059\063\063\067\067\073\073\079\079\085\085\091\091\097\097\103\103\109\109\115\115\121\121\127\127\131\131\135\135\139\139\145\145\151\151\157\157\163\163\169\169\173\173\177\177\181\181\185\185\191\191\197\197\203\203\209\209\215\215\221\221\227\227\233\233\239\239\245\245\249\249\253\253\003\003\! 009\009\015\015\021\021\027\027\031\031\035\035\039\039\000\00! 0\000\00 0\000\000\043\048\053\060\067\074\081\088\043\048\053\060\067\074\081\088\095\100\105\112\119\126\000\000\095\100\105\112\119\126\000\000\133\138\143\150\157\164\171\178\133\138\143\150\157\164\171\178\185\190\195\202\209\216\223\230\185\190\195\202\209\216\223\230\237\242\247\254\005\012\000\000\237\242\247\254\005\012\000\000\019\024\029\036\043\050\057\064\000\024\000\036\000\050\000\064\071\076\081\088\095\102\109\116\071\076\081\088\095\102\109\116\123\196\128\204\133\209\138\214\143\219\148\224\153\229\000\000\158\165\172\181\190\199\208\217\158\165\172\181\190\199\208\217\226\233\240\249\002\011\020\029\226\233\240\249\002\011\020\029\038\045\052\061\070\079\088\097\038\045\052\061\070\079\088\097\106\111\116\123\128\000\135\140\106\111\123\196\123\000\009\000\000\147\152\159\164\000\171\176\128\204\133\209\159\183\189\195\201\206\211\234\000\000\218\223\201\206\138\214\000\230\236\242\248\253\002\067\009\014\019\024\248\253\148\224\014\031\191\036\000\000\038\045\050! \000\057\062\143\219\153\229\045\069\000\000\000\000\000\000\000\000\000\000\000\000\000\000\072\072\072\072\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\072\072\072\072\072\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\072\072\072\072\072\072\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\073\077\081\085\089\093\097\101\105\109\113\117\121\125\129\133\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \000\000\000\000\000\000\000\000\000\000\137\141\145\149\153\1! 57\161\1 65\169\173\177\181\185\189\193\197\201\205\209\213\217\221\225\229\233\237\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\241\000\248\000\255\000\006\000\013\000\020\000\027\000\034\000\041\000\048\000\055\000\062\000\000\069\000\076\000\083\000\000\000\000\000\000\090\097\000\104\111\000\118\125\000\132\139\000\146\153\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\160\000\000\000\000\000\000\000\000\000\167\000\000\000\000\000\000\000\000\000\000\000\000\000\174\000\181\000\188\000\195\000\202\000\209\000\216\000\223\000\230\000\237\000\244\000\251\000\000\002\000\009\000\016\000\000\000\000\000\000\023\030\000\037\044\000\051\058\000\065\072\000\079\086\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\09! 3\000\000\100\107\114\121\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\135\000\140\000\000\000\000\000\000\000\000\000\000\145\150\155\162\169\174\179\184\189\194\199\204\209\000\214\219\224\229\234\000\239\000\244\249\000\254\003\000\008\013\018\023\028\033\038\043\048\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\072\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\053\057\061\065\069\073\077\081\085\089\09! 3\097\101\105\109\113\117\121\125\129\133\137\141\145\149\153\! 000\000\ 000\000\000" Modified: trunk/src/update.ml =================================================================== --- trunk/src/update.ml 2009-05-03 00:20:31 UTC (rev 325) +++ trunk/src/update.ml 2009-05-04 18:48:23 UTC (rev 326) @@ -34,11 +34,13 @@ representation does not change between unison versions.) *) (*FIX: Use similar_correct in props.ml next time the format is modified (see file props.ml for the new function) *) -(*FIX: use Case.normalize next time the format is modified *) (*FIX: also change Fileinfo.stamp to drop the info.ctime component, next time the format is modified *) (*FIX: also make Jerome's suggested change about file times (see his mesg in unison-pending email folder). *) +(*FIX: one should also store whether we are in case-insensitive mode + in the archive and check the mode has not changed when the archive + is loaded *) let archiveFormat = 22 module NameMap = MyMap.Make (Name) @@ -1185,20 +1187,8 @@ Note that case conflicts and illegal filenames can only occur under Unix, when syncing with a Windows file system. *) -let badWindowsFilenameRx = - (* FIX: This should catch all device names (like aux, con, ...). I don't - know what all the possible device names are. *) - Rx.case_insensitive - (Rx.rx "\\.*|aux|con|lpt1|prn|(.*[\000-\031\\/<>:\"|].*)") +let badFilename s = Name.bad (Prefs.read Globals.someHostIsRunningWindows) s -let isBadWindowsFilename s = - (* FIX: should also check for a max filename length, not sure how much *) - Rx.match_string badWindowsFilenameRx (Name.toString s) -let badFilename s = - (* Don't check unless we are syncing with Windows *) - Prefs.read Globals.someHostIsRunningWindows && - isBadWindowsFilename s - let getChildren fspath path = let children = (* We sort them in reverse order, as findDuplicate will reverse From sylvain at le-gall.net Tue May 5 04:22:02 2009 From: sylvain at le-gall.net (Sylvain Le Gall) Date: Tue, 5 May 2009 08:22:02 +0000 (UTC) Subject: [Unison-hackers] Unison on launchpad (was: [unison-users] Broken unicode handling in unison 2.27.57) References: <49ECAF35.1020505@gmx.net> <07446779-E134-4363-AFB6-C4168981E9EC@cis.upenn.edu> <49FAA627.1090909@gmx.net> <49FB37CF.5080800@gmx.net> <4CEFE5C1-C567-4612-8E1E-0F79CCD069CC@cis.upenn.edu> <49FF15F5.3090707@gmx.net> Message-ID: Hello, On 04-05-2009, Martin von Gagern wrote: > Benjamin Pierce wrote: >> I'm willing to help with repository issues, but I'd prefer to wait a >> little till it's clear that this project is making progress before >> sinking a lot of time into setting things up. Would it make sense just= > >> to take a copy of the sources, put it somewhere convenient for >> collaboration among whoever is interested in this, let things run for a= > >> little while, and then synchronize the two replicas and set up a way of= > >> keeping them in sync? > > Russel Winder was so kind to create the unison group and project on > launchpad.net, and I've uploaded a bzr-svn import of the repository. I > think I'll keep that in sync manually for now, and when this works out > ask you to automate the synchronization. > > The project page: https://launchpad.net/unison > The developer team: https://launchpad.net/~unison > Available bzr branches: https://code.launchpad.net/unison It is probably a bit late to say that, but maybe a better hosting for a pure OCaml project like Unison, would be http://forge.ocamlcore.org (aka OCaml forge). We can provide darcs, git, svn or cvs hosting. We also have bzr, though it is only used by one project. The point is that OCaml forge helps you to gather more people related to OCaml than launchpad which is more general purpose. In other word, you get more visibility for people doing OCaml programming (which are hard to find). Regards, Sylvain Le Gall From bcpierce at cis.upenn.edu Tue May 5 08:17:42 2009 From: bcpierce at cis.upenn.edu (Benjamin Pierce) Date: Tue, 5 May 2009 08:17:42 -0400 Subject: [Unison-hackers] Unison on launchpad (was: [unison-users] Broken unicode handling in unison 2.27.57) In-Reply-To: References: <49ECAF35.1020505@gmx.net> <07446779-E134-4363-AFB6-C4168981E9EC@cis.upenn.edu> <49FAA627.1090909@gmx.net> <49FB37CF.5080800@gmx.net> <4CEFE5C1-C567-4612-8E1E-0F79CCD069CC@cis.upenn.edu> <49FF15F5.3090707@gmx.net> Message-ID: Let's keep in mind that this is not a question of re-hosting Unison itself -- it's just a short-term fork to do a particular piece of work... Best, - Benjamin On May 5, 2009, at 4:22 AM, Sylvain Le Gall wrote: > Hello, > > On 04-05-2009, Martin von Gagern wrote: >> Benjamin Pierce wrote: >>> I'm willing to help with repository issues, but I'd prefer to wait a >>> little till it's clear that this project is making progress before >>> sinking a lot of time into setting things up. Would it make sense >>> just= >> >>> to take a copy of the sources, put it somewhere convenient for >>> collaboration among whoever is interested in this, let things run >>> for a= >> >>> little while, and then synchronize the two replicas and set up a >>> way of= >> >>> keeping them in sync? >> >> Russel Winder was so kind to create the unison group and project on >> launchpad.net, and I've uploaded a bzr-svn import of the >> repository. I >> think I'll keep that in sync manually for now, and when this works >> out >> ask you to automate the synchronization. >> >> The project page: https://launchpad.net/unison >> The developer team: https://launchpad.net/~unison >> Available bzr branches: https://code.launchpad.net/unison > > It is probably a bit late to say that, but maybe a better hosting > for a > pure OCaml project like Unison, would be http://forge.ocamlcore.org > (aka > OCaml forge). > > We can provide darcs, git, svn or cvs hosting. We also have bzr, > though > it is only used by one project. > > The point is that OCaml forge helps you to gather more people > related to > OCaml than launchpad which is more general purpose. In other word, you > get more visibility for people doing OCaml programming (which are hard > to find). > > Regards, > Sylvain Le Gall > > _______________________________________________ > Unison-hackers mailing list > Unison-hackers at lists.seas.upenn.edu > http://lists.seas.upenn.edu/mailman/listinfo/unison-hackers From bcpierce at cis.upenn.edu Tue May 5 08:26:22 2009 From: bcpierce at cis.upenn.edu (Benjamin Pierce) Date: Tue, 5 May 2009 08:26:22 -0400 Subject: [Unison-hackers] [unison-users] Experimental Unicode support In-Reply-To: <20090504201909.GB16235@pps.jussieu.fr> References: <20090504201909.GB16235@pps.jussieu.fr> Message-ID: <05FFF373-903F-46C2-A3F8-6904C847E456@cis.upenn.edu> > I have spent the day adding some basic Unicode support to the > developper version of Unison. This should address most issues with > synchronizing between Mac OS X and Linux (but not with Windows). > > When Unison is in case insensitive mode (this is the default when > synchronizing with a Mac machine) and the "unicode" preference is set > to true, file names are compared following the HFS+ standard (based on > some code I wrote last december). Wow -- this looks like a great first step. Thanks, Jerome! > A lot of issues mentioned by Martin von Gagern are not yet addressed, > but that should be a good starting point. Do you have any advice to offer on a good strategy for the rest? Best, - Benjamin > > -- Jerome > > > ------------------------------------ > > Yahoo! Groups Links > > <*> To visit your group on the web, go to: > http://groups.yahoo.com/group/unison-users/ > > <*> Your email settings: > Individual Email | Traditional > > <*> To change settings online go to: > http://groups.yahoo.com/group/unison-users/join > (Yahoo! ID required) > > <*> To change settings via email: > mailto:unison-users-digest at yahoogroups.com > mailto:unison-users-fullfeatured at yahoogroups.com > > <*> To unsubscribe from this group, send an email to: > unison-users-unsubscribe at yahoogroups.com > > <*> Your use of Yahoo! Groups is subject to: > http://docs.yahoo.com/info/terms/ > From bcpierce at seas.upenn.edu Tue May 5 08:41:37 2009 From: bcpierce at seas.upenn.edu (Benjamin C. Pierce) Date: Tue, 5 May 2009 08:41:37 -0400 Subject: [Unison-hackers] [unison-svn] r327 - in trunk: doc src Message-ID: <200905051241.n45Cfb9Q026725@yaws.seas.upenn.edu> Author: bcpierce Date: 2009-05-05 08:41:35 -0400 (Tue, 05 May 2009) New Revision: 327 Modified: trunk/doc/unison-manual.tex trunk/src/RECENTNEWS trunk/src/case.ml trunk/src/mkProjectInfo.ml trunk/src/update.ml Log: * Incorporate recent change from 2.32 branch. Modified: trunk/doc/unison-manual.tex =================================================================== --- trunk/doc/unison-manual.tex 2009-05-04 18:48:23 UTC (rev 326) +++ trunk/doc/unison-manual.tex 2009-05-05 12:41:35 UTC (rev 327) @@ -51,7 +51,7 @@ \LARGE% Version \unisonversion \\[4ex] % % \today % - \large Copyright 1998-2008, Benjamin C. Pierce + \large Copyright 1998-2009, Benjamin C. Pierce \end{center}% \fi% % Modified: trunk/src/RECENTNEWS =================================================================== --- trunk/src/RECENTNEWS 2009-05-04 18:48:23 UTC (rev 326) +++ trunk/src/RECENTNEWS 2009-05-05 12:41:35 UTC (rev 327) @@ -1,3 +1,9 @@ +CHANGES FROM VERSION 2.33.1 + +* Incorporate recent change from 2.32 branch. + + +------------------------------- CHANGES FROM VERSION 2.33.-4 * Updated list of bad Windows file names following the MSDN Modified: trunk/src/case.ml =================================================================== --- trunk/src/case.ml 2009-05-04 18:48:23 UTC (rev 326) +++ trunk/src/case.ml 2009-05-05 12:41:35 UTC (rev 327) @@ -90,7 +90,7 @@ let rmTrailDots s = s -(*FIX: disabled for know -- requires an archive version change +(*FIX: disabled for now -- requires an archive version change if Prefs.read someHostIsRunningWindows && not (Prefs.read allHostsAreRunningWindows) && Modified: trunk/src/mkProjectInfo.ml =================================================================== --- trunk/src/mkProjectInfo.ml 2009-05-04 18:48:23 UTC (rev 326) +++ trunk/src/mkProjectInfo.ml 2009-05-05 12:41:35 UTC (rev 327) @@ -106,3 +106,4 @@ + Modified: trunk/src/update.ml =================================================================== --- trunk/src/update.ml 2009-05-04 18:48:23 UTC (rev 326) +++ trunk/src/update.ml 2009-05-05 12:41:35 UTC (rev 327) @@ -1004,56 +1004,57 @@ (** Status display **) -(* BCP (3/09) We used to try to be smart about showing status messages - at regular intervals, but people seem to find this confusing. - Let's replace all this with something simpler -- just show directories as - they are scanned... (but I'll leave the code in for now, in case we find - we want to restore the old behavior). *) -(* - let bigFileLength = 10 * 1024 - let bigFileLengthFS = Uutil.Filesize.ofInt bigFileLength - let smallFileLength = 1024 - let fileLength = ref 0 - let t0 = ref 0. +let bigFileLength = 10 * 1024 +let bigFileLengthFS = Uutil.Filesize.ofInt bigFileLength +let smallFileLength = 1024 +let fileLength = ref 0 +let t0 = ref 0. - (* Note that we do *not* want to do any status displays from the server - side, since this will cause the server to block until the client has - finished its own update detection and can receive and acknowledge - the status display message -- thus effectively serializing the client - and server! *) - let showStatusAddLength info = - if not !Trace.runningasserver then begin - let len1 = Props.length info.Fileinfo.desc in - let len2 = Osx.ressLength info.Fileinfo.osX.Osx.ressInfo in - if len1 >= bigFileLengthFS || len2 >= bigFileLengthFS then - fileLength := bigFileLength - else - fileLength := - min bigFileLength - (!fileLength + Uutil.Filesize.toInt len1 + Uutil.Filesize.toInt len2) - end +(* Note that we do *not* want to do any status displays from the server + side, since this will cause the server to block until the client has + finished its own update detection and can receive and acknowledge + the status display message -- thus effectively serializing the client + and server! *) +let showStatusAddLength info = + if not !Trace.runningasserver then begin + let len1 = Props.length info.Fileinfo.desc in + let len2 = Osx.ressLength info.Fileinfo.osX.Osx.ressInfo in + if len1 >= bigFileLengthFS || len2 >= bigFileLengthFS then + fileLength := bigFileLength + else + fileLength := + min bigFileLength + (!fileLength + Uutil.Filesize.toInt len1 + Uutil.Filesize.toInt len2) + end - let showStatus path = - if not !Trace.runningasserver then begin - fileLength := !fileLength + smallFileLength; - if !fileLength >= bigFileLength then begin - fileLength := 0; - let t = Unix.gettimeofday () in - if t -. !t0 > 0.05 then begin - Trace.statusDetail ("scanning... got to " ^ Path.toString path); - t0 := t - end +let showStatus path = + if not !Trace.runningasserver then begin + fileLength := !fileLength + smallFileLength; + if !fileLength >= bigFileLength then begin + fileLength := 0; + let t = Unix.gettimeofday () in + if t -. !t0 > 0.05 then begin + Trace.statusDetail ("scanning... " ^ Path.toString path); + t0 := t end end -*) + end +let showStatusDir path = () + +(* BCP (4/09) The code above tries to be smart about showing status messages + at regular intervals, but people seem to find this confusing. + I tried replace all this with something simpler -- just show directories as + they are scanned -- but this seems worse: it prints far too much stuff. + So I'm going to revert to the old version. *) +(* let showStatus path = () let showStatusAddLength info = () - let showStatusDir path = if not !Trace.runningasserver then begin Trace.statusDetail ("scanning... " ^ Path.toString path); end +*) (* ------- *) From bcpierce at cis.upenn.edu Tue May 5 09:00:16 2009 From: bcpierce at cis.upenn.edu (Benjamin Pierce) Date: Tue, 5 May 2009 09:00:16 -0400 Subject: [Unison-hackers] Unison on launchpad (was: [unison-users] Broken unicode handling in unison 2.27.57) In-Reply-To: <49FF15F5.3090707@gmx.net> References: <49ECAF35.1020505@gmx.net> <07446779-E134-4363-AFB6-C4168981E9EC@cis.upenn.edu> <49FAA627.1090909@gmx.net> <49FB37CF.5080800@gmx.net> <4CEFE5C1-C567-4612-8E1E-0F79CCD069CC@cis.upenn.edu> <49FF15F5.3090707@gmx.net> Message-ID: Hi Martin, Yes, the patch looks OK to me. But it doesn't seem to apply cleanly -- I get ~/current/unison/trunk/src> patch -i p.tmp patching file .bzrignore patching file Makefile patch: **** malformed patch at line 30: all:: INSTALL Am I applying it the wrong way? -- Benjamin On May 4, 2009, at 12:21 PM, Martin von Gagern wrote: > Hi! > > Benjamin Pierce wrote: >> I'm willing to help with repository issues, but I'd prefer to wait a >> little till it's clear that this project is making progress before >> sinking a lot of time into setting things up. Would it make sense >> just >> to take a copy of the sources, put it somewhere convenient for >> collaboration among whoever is interested in this, let things run >> for a >> little while, and then synchronize the two replicas and set up a >> way of >> keeping them in sync? > > Russel Winder was so kind to create the unison group and project on > launchpad.net, and I've uploaded a bzr-svn import of the repository. I > think I'll keep that in sync manually for now, and when this works out > ask you to automate the synchronization. > > The project page: https://launchpad.net/unison > The developer team: https://launchpad.net/~unison > Available bzr branches: https://code.launchpad.net/unison > > The build relies on svn keyword substitution to keep track of the > current version number. bzr doesn't replace keywords by default, and > has > a different idea of revision numbers as well, as they are per branch, > not per repository. I've attached a patch that deals with the > situation > by finding the bzr revision number corresponding to the origin svn > revision, and starts counting from there. Should not cause trouble for > developers using svn, as it only gets called when the keyword isn't > expanded. > > I've also improved behaviour of the build in case the mkProjectInfo > build fails. Without modification, this can lead to an empty > Makefile.ProjectInfo causing an empty $(NAME) and thus an empty > dependency in "buildexecutable:: $(NAME)$(EXEC_EXT)", so nothing was > build, and no error was signaled. Now I'm deleting files on error, and > depending on Makefile.ProjectInfo, so the build will fail. > > Are you willing to merge this patch into the main unison trunk, or > should it exist as a separate branch on launchpad? I'd prefer a merge. > >> P.S. Since the discussion is getting pretty technical, I suggest we >> move it to the unison-hackers list. I'll cross-post this there so >> you >> can just "reply all" and then edit headers. (You'll need to sign >> up for >> that list, but you should do that anyway, since it's where commit >> logs >> get sent.) > > Fine with me. And those commit messages will help me keep stuff in > sync, > I believe. > > I guess I'll soon get back to you with a wishlist of stuff I want > explained. Just a note for now: I found out Glib.Utf8 provides a > normalize function, so I might end up using that instead of camomile. > > Greetings, > Martin > # Bazaar merge directive format 2 (Bazaar 0.90) > # revision_id: martin.vgagern at gmx.net-20090504154753-1ht6w3g5cbwpm9yu > # target_branch: http://bazaar.launchpad.net/~unison/unison/trunk > # testament_sha1: 729c80164fd2e5e562afa3b4c4b40fd4e5a22cbe > # timestamp: 2009-05-04 18:04:34 +0200 > # source_branch: http://bazaar.launchpad.net/~unison/unison/bzrbuild > # base_revision_id: svn-v4:4bce34ff-96ee-0310-b826-\ > # 95abcfff6e26:trunk:321 > # > # Begin patch > === added file '.bzrignore' > --- .bzrignore 1970-01-01 00:00:00 +0000 > +++ .bzrignore 2009-05-04 15:47:53 +0000 > @@ -0,0 +1,9 @@ > +src/Makefile.ProjectInfo > +src/mkProjectInfo > +src/TAGS > +src/ubase/projectInfo.ml > +src/unison > +src/unison.exe > +src/**/*.cmi > +src/**/*.cmx > +src/**/*.cmo > > === modified file 'src/Makefile' > --- src/Makefile 2008-08-21 14:39:05 +0000 > +++ src/Makefile 2009-05-04 15:47:53 +0000 > @@ -37,6 +37,16 @@ > > all:: INSTALL > > +.PHONY: all clean install doinstall installtext text \ > + setupdemo-old setupdemo modifydemo demo \ > + run runbatch runt rundebug runp runtext runsort runprefer \ > + prefsdocs runtest repeattest \ > + selftest selftestdebug selftestremote testmerge \ > + checkin installremote > + > +.DELETE_ON_ERROR: > +# to avoid problems when e.g. mkProjectInfo fails to run > + > INSTALL: $(NAME)$(EXEC_EXT) > # file isn't made for OS X, so check that it's there first > (if [ -f $(NAME) ]; then ./$(NAME) -doc install > INSTALLATION; fi) > @@ -50,11 +60,14 @@ > # NAME, VERSION, and MAJORVERSION, automatically generated > -include Makefile.ProjectInfo > > -Makefile.ProjectInfo: mkProjectInfo > +../.bzr/branch/last-revision: > +# Do nothing to create this target if it doesn't already exist. > + > +Makefile.ProjectInfo: mkProjectInfo ../.bzr/branch/last-revision > ./mkProjectInfo > $@ > > mkProjectInfo: mkProjectInfo.ml > - ocamlc -o $@ $^ > + ocamlc -o $@ unix.cma str.cma $^ > > clean:: > $(RM) mkProjectInfo > > === modified file 'src/Makefile.OCaml' > --- src/Makefile.OCaml 2009-05-02 00:57:23 +0000 > +++ src/Makefile.OCaml 2009-05-04 15:47:53 +0000 > @@ -125,6 +125,7 @@ > endif > endif > > +.PHONY: buildexecutable > buildexecutable:: > @echo NATIVE = $(NATIVE) > @echo THREADS = $(THREADS) > @@ -132,7 +133,7 @@ > @echo OSTYPE = $(OSTYPE) > @echo OSARCH = $(OSARCH) > > -ubase/projectInfo.ml: mkProjectInfo > +ubase/projectInfo.ml: Makefile.ProjectInfo > echo 'let myName = "'$(NAME)'";;' > $@ > echo 'let myVersion = "'$(VERSION)'";;' >> $@ > echo 'let myMajorVersion = "'$(MAJORVERSION)'";;' >> $@ > @@ -160,6 +161,7 @@ > # NOTE: the OCAMLLIBDIR is not getting passed correctly? > # The two cases for cltool are needed because Xcode 2.1+ > # builds in build/Default/, and earlier versions use build/ > +.PHONY: macexecutable > macexecutable: $(NAME)-blob.o > # sed -e's/@@VERSION@@/$(VERSION)/' $(UIMACDIR)/Info.plist.template > > $(UIMACDIR)/Info.plist > (cd $(UIMACDIR); xcodebuild OCAMLLIBDIR="$(OCAMLLIBDIR)" > SYMROOT=build) > @@ -388,6 +390,7 @@ > -$(RM) -r *.obj *.lib *.exp > -$(RM) -r *.tmp *.bak?.tmp .*.bak?.tmp > > +.PHONY: paths > paths: > @echo PATH = $(PATH) > @echo OCAMLLIBDIR = $(OCAMLLIBDIR) > > === modified file 'src/mkProjectInfo.ml' > --- src/mkProjectInfo.ml 2009-05-02 01:30:31 +0000 > +++ src/mkProjectInfo.ml 2009-05-04 13:14:57 +0000 > @@ -42,9 +42,36 @@ > (* > ---------------------------------------------------------------------- *) > (* You shouldn't need to edit below. *) > > +(* run the bzr tool to get version information for bzr branches *) > +exception BzrException of Unix.process_status;; > +let bzr args = > + let bzr = (try Sys.getenv "BZR" with Not_found -> "bzr") in > + let cmd = bzr ^ " " ^ args in > + let inc = Unix.open_process_in cmd in > + let buf = Buffer.create 16 in > + (try > + while true do > + Buffer.add_channel buf inc 1 > + done > + with End_of_file -> ()); > + let status = Unix.close_process_in inc in > + match status with > + Unix.WEXITED 0 -> Buffer.contents buf > + | _ -> raise (BzrException status);; > + > +(* extract a substring using a regular expression *) > +let extract_str re str = > + let _ = Str.search_forward (Str.regexp re) str 0 in > + Str.matched_group 1 str;; > +let extract_int re str = int_of_string (extract_str re str);; > + > let revisionString = "$Rev$";; > -let revision = Scanf.sscanf revisionString "$Rev: %d " (fun x -> x);; > -let pointVersion = revision - pointVersionOrigin;; > +let pointVersion = if String.length revisionString > 5 > +then Scanf.sscanf revisionString "$Rev: %d " (fun x -> x) - > pointVersionOrigin > +else let pvo = extract_int "^revno:[ \t]*\\([0-9]+\\)[ \t]*$" > + (bzr ("log -r svn:" ^ > + string_of_int pointVersionOrigin)) > in > + extract_int "^\\([0-9]+\\)$" (bzr "revno") - pvo;; > > Printf.printf "MAJORVERSION=%d.%d\n" majorVersion minorVersion;; > Printf.printf "VERSION=%d.%d.%d\n" majorVersion minorVersion > pointVersion;; > From Martin.vGagern at gmx.net Tue May 5 09:14:15 2009 From: Martin.vGagern at gmx.net (Martin von Gagern) Date: Tue, 05 May 2009 15:14:15 +0200 Subject: [Unison-hackers] Help building OSX GUI In-Reply-To: References: <3A36B4E3-2A27-435E-9E11-B852AC372A58@cis.upenn.edu> <4DBFC2EC-8355-478D-A199-7D7DB3220A37@polytechnique.org> <3BB79FBC-BB3C-429A-B9ED-433A9C92BDDE@cis.upenn.edu> <87A2B849-D292-461F-9880-DD7670552370@polytechnique.org> <2675D41E-0A57-4707-A0F4-64618C1C4963@cis.upenn.edu> <4615B1A2-3029-4BF7-96C8-2997F3B089A4@kalkwarf.com> <57894FBB-B83F-4CFF-97F8-668A24B2AA5F@cis.upenn.edu> <6BE46969-2D68-4F45-9D28-2B5D720755A7@polytechnique.org> <12DE3A85-A6F2-4D01-81D9-2949F66827BB@cis.upenn.edu> <2E008972-2CB9-42C0-9827-58C66813CDBB@cis.upenn.edu> <1BED0079-7560-4068-A15B-CB861BA33028@polytechnique.org> <28F17C90-F376-4AE0-8026-271BED414177@kalkwarf.com> <3D552623-2BC0-4696-B4C1-17CC84408F0A@cis.upenn.edu> Message-ID: <4A003BA7.5090803@gmx.net> Hi! I'm on using ocaml as built with fink, and rebuilding ocaml just to allow developing unison doesn't sound too attractive. Without modifications, I get this error: Undefined symbols: "_chmod$UNIX2003", referenced from: _setFileInfos in unison-blob.o _setFileInfos in unison-blob.o The reference to that symbol is present in osxsupport.o as well, so it's the C compiler invoked by ocamlopt that's introducing this reference. The symbol is part of the OS X 10.5 SDK, but not the 10.4 SDK. Alan Schmitt wrote: > Right now, everything is set to compile for both 10.4 and 10.5, but > requires a specially built ocaml (which is simply a line to add in a > configuration file in godi). The reason for this is that I don't have > access to Tiger machines anymore and I want to provide a single binary > for our users. You shouldn't have to rebuild ocaml just to get a certain command line argument passed on to the C compiler. The -ccopt flag does that. It might be that code compiled from ocaml source files does introduce additional dependencies if you don't rebuild ocaml, but as this hasn't been a problem for me, I'll not worry about it here. > We could try to do some tweaking to allow different compilation options, > but I would first need to find out how to change the target SDK from the > command line (right now I only know how to do it in XCode). On my system there is a -sdk command line flag to xcodebuild. Specifying a value like macos10.5 for it will select the corresponding SDK, falling back to the project configured SDK if the selected one isn't available. The attached patch takes care of both these approaches: specifying the SDK to xcodebuild and passing -mmacosx-version-min to the C compiler. Both are controlled using the single MINOSXVERSION variable in the makefile. So in theory "make MINOSXVERSION=10.4" should give you a binary ready to run anywhere, while "make MINOSXVERSION=10.5" will give you a version making use of all the latest features, or whatever. Both of these builds compile for me, while the unmodified build failed with the unresolved reference quoted in the beginning. I would like to see the patch included. Greetings, Martin von Gagern -------------- next part -------------- An embedded and charset-unspecified text was scrubbed... Name: macbuild-264.patch Url: http://lists.seas.upenn.edu/pipermail/unison-hackers/attachments/20090505/3646fc1b/macbuild-264.txt From bcpierce at cis.upenn.edu Tue May 5 09:26:49 2009 From: bcpierce at cis.upenn.edu (Benjamin Pierce) Date: Tue, 5 May 2009 09:26:49 -0400 Subject: [Unison-hackers] Help building OSX GUI In-Reply-To: <4A003BA7.5090803@gmx.net> References: <3A36B4E3-2A27-435E-9E11-B852AC372A58@cis.upenn.edu> <4DBFC2EC-8355-478D-A199-7D7DB3220A37@polytechnique.org> <3BB79FBC-BB3C-429A-B9ED-433A9C92BDDE@cis.upenn.edu> <87A2B849-D292-461F-9880-DD7670552370@polytechnique.org> <2675D41E-0A57-4707-A0F4-64618C1C4963@cis.upenn.edu> <4615B1A2-3029-4BF7-96C8-2997F3B089A4@kalkwarf.com> <57894FBB-B83F-4CFF-97F8-668A24B2AA5F@cis.upenn.edu> <6BE46969-2D68-4F45-9D28-2B5D720755A7@polytechnique.org> <12DE3A85-A6F2-4D01-81D9-2949F66827BB@cis.upenn.edu> <2E008972-2CB9-42C0-9827-58C66813CDBB@cis.upenn.edu> <1BED0079-7560-4068-A15B-CB861BA33028@polytechnique.org> <28F17C90-F376-4AE0-8026-271BED414177@kalkwarf.com> <3D552623-2BC0-4696-B4C1-17CC84408F0A@cis.upenn.edu> <4A003BA7.5090803@gmx.net> Message-ID: <3AA479FC-1F08-4A38-BF5B-B9B2F5D3BC1B@cis.upenn.edu> I'm not an expert on compiling on OSX, so I'll leave it to you and Alan to sort out what's the best way to fix the makefiles. I'll be glad to apply whatever patch you both agree on. - B On May 5, 2009, at 9:14 AM, Martin von Gagern wrote: > Hi! > > I'm on using ocaml as built with fink, and rebuilding ocaml just to > allow developing unison doesn't sound too attractive. Without > modifications, I get this error: > > Undefined symbols: > "_chmod$UNIX2003", referenced from: > _setFileInfos in unison-blob.o > _setFileInfos in unison-blob.o > > The reference to that symbol is present in osxsupport.o as well, so > it's > the C compiler invoked by ocamlopt that's introducing this reference. > The symbol is part of the OS X 10.5 SDK, but not the 10.4 SDK. > > Alan Schmitt wrote: >> Right now, everything is set to compile for both 10.4 and 10.5, but >> requires a specially built ocaml (which is simply a line to add in a >> configuration file in godi). The reason for this is that I don't have >> access to Tiger machines anymore and I want to provide a single >> binary >> for our users. > > You shouldn't have to rebuild ocaml just to get a certain command line > argument passed on to the C compiler. The -ccopt flag does that. It > might be that code compiled from ocaml source files does introduce > additional dependencies if you don't rebuild ocaml, but as this hasn't > been a problem for me, I'll not worry about it here. > >> We could try to do some tweaking to allow different compilation >> options, >> but I would first need to find out how to change the target SDK >> from the >> command line (right now I only know how to do it in XCode). > > On my system there is a -sdk command line flag to xcodebuild. > Specifying > a value like macos10.5 for it will select the corresponding SDK, > falling > back to the project configured SDK if the selected one isn't > available. > > The attached patch takes care of both these approaches: specifying the > SDK to xcodebuild and passing -mmacosx-version-min to the C compiler. > Both are controlled using the single MINOSXVERSION variable in the > makefile. So in theory "make MINOSXVERSION=10.4" should give you a > binary ready to run anywhere, while "make MINOSXVERSION=10.5" will > give > you a version making use of all the latest features, or whatever. > > Both of these builds compile for me, while the unmodified build failed > with the unresolved reference quoted in the beginning. I would like to > see the patch included. > > Greetings, > Martin von Gagern > === modified file 'src/Makefile.OCaml' > --- src/Makefile.OCaml 2009-05-05 08:28:15 +0000 > +++ src/Makefile.OCaml 2009-05-05 12:54:21 +0000 > @@ -157,6 +157,10 @@ > endif > > MINOSXVERSION=10.5 > +XCODEFLAGS=-sdk macosx$(MINOSXVERSION) > +ifeq ($(OSARCH),osx) > + CAMLFLAGS+=-ccopt -mmacosx-version-min=$(MINOSXVERSION) > +endif > > # NOTE: the OCAMLLIBDIR is not getting passed correctly? > # The two cases for cltool are needed because Xcode 2.1+ > @@ -164,7 +168,7 @@ > .PHONY: macexecutable > macexecutable: $(NAME)-blob.o > # sed -e's/@@VERSION@@/$(VERSION)/' $(UIMACDIR)/Info.plist.template > > $(UIMACDIR)/Info.plist > - (cd $(UIMACDIR); xcodebuild OCAMLLIBDIR="$(OCAMLLIBDIR)" > SYMROOT=build) > + (cd $(UIMACDIR); xcodebuild $(XCODEFLAGS) OCAMLLIBDIR="$ > (OCAMLLIBDIR)" SYMROOT=build) > if [ -e $(UIMACDIR)/build/Default ]; then \ > gcc -mmacosx-version-min=$(MINOSXVERSION) $(UIMACDIR)/cltool.c -o > $(UIMACDIR)/build/Default/Unison.app/Contents/MacOS/cltool - > framework Carbon; \ > else \ > > _______________________________________________ > Unison-hackers mailing list > Unison-hackers at lists.seas.upenn.edu > http://lists.seas.upenn.edu/mailman/listinfo/unison-hackers From Martin.vGagern at gmx.net Tue May 5 09:26:26 2009 From: Martin.vGagern at gmx.net (Martin von Gagern) Date: Tue, 05 May 2009 15:26:26 +0200 Subject: [Unison-hackers] Unison on launchpad In-Reply-To: References: <49ECAF35.1020505@gmx.net> <07446779-E134-4363-AFB6-C4168981E9EC@cis.upenn.edu> <49FAA627.1090909@gmx.net> <49FB37CF.5080800@gmx.net> <4CEFE5C1-C567-4612-8E1E-0F79CCD069CC@cis.upenn.edu> <49FF15F5.3090707@gmx.net> Message-ID: <4A003E82.8080107@gmx.net> Benjamin Pierce wrote: > Yes, the patch looks OK to me. Jeromes commit broke things, as pointVersionOrigin=325 isn't part of the trunk. I'm working on a patch to simply use bzr revnos as point revisions. Those are for developers only anyway, so actual numbers shouldn't matter too much. I'll have an updated patch available shortly. > But it doesn't seem to apply cleanly --> I get > > ~/current/unison/trunk/src> patch -i p.tmp > patching file .bzrignore > patching file Makefile > patch: **** malformed patch at line 30: all:: INSTALL > > Am I applying it the wrong way? Yes. The patch is for trunk, not trunk/src, so you should have passed -p1 to patch or similar. Greetings, Martin -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 261 bytes Desc: OpenPGP digital signature Url : http://lists.seas.upenn.edu/pipermail/unison-hackers/attachments/20090505/fe949990/signature.sig From bcpierce at cis.upenn.edu Tue May 5 09:42:54 2009 From: bcpierce at cis.upenn.edu (Benjamin Pierce) Date: Tue, 5 May 2009 09:42:54 -0400 Subject: [Unison-hackers] Unison on launchpad In-Reply-To: <4A003E82.8080107@gmx.net> References: <49ECAF35.1020505@gmx.net> <07446779-E134-4363-AFB6-C4168981E9EC@cis.upenn.edu> <49FAA627.1090909@gmx.net> <49FB37CF.5080800@gmx.net> <4CEFE5C1-C567-4612-8E1E-0F79CCD069CC@cis.upenn.edu> <49FF15F5.3090707@gmx.net> <4A003E82.8080107@gmx.net> Message-ID: <9DD180AA-84E2-45E3-B999-7470756FEA52@cis.upenn.edu> Sorry for missing that. I'll wait for your new patch. - B On May 5, 2009, at 9:26 AM, Martin von Gagern wrote: > Benjamin Pierce wrote: >> Yes, the patch looks OK to me. > > Jeromes commit broke things, as pointVersionOrigin=325 isn't part of > the > trunk. I'm working on a patch to simply use bzr revnos as point > revisions. Those are for developers only anyway, so actual numbers > shouldn't matter too much. I'll have an updated patch available > shortly. > >> But it doesn't seem to apply cleanly --> I get >> >> ~/current/unison/trunk/src> patch -i p.tmp >> patching file .bzrignore >> patching file Makefile >> patch: **** malformed patch at line 30: all:: INSTALL >> >> Am I applying it the wrong way? > > Yes. The patch is for trunk, not trunk/src, so you should have passed > -p1 to patch or similar. > > Greetings, > Martin > From Martin.vGagern at gmx.net Tue May 5 09:50:00 2009 From: Martin.vGagern at gmx.net (Martin von Gagern) Date: Tue, 05 May 2009 15:50:00 +0200 Subject: [Unison-hackers] Unison on launchpad In-Reply-To: <9DD180AA-84E2-45E3-B999-7470756FEA52@cis.upenn.edu> References: <49ECAF35.1020505@gmx.net> <07446779-E134-4363-AFB6-C4168981E9EC@cis.upenn.edu> <49FAA627.1090909@gmx.net> <49FB37CF.5080800@gmx.net> <4CEFE5C1-C567-4612-8E1E-0F79CCD069CC@cis.upenn.edu> <49FF15F5.3090707@gmx.net> <4A003E82.8080107@gmx.net> <9DD180AA-84E2-45E3-B999-7470756FEA52@cis.upenn.edu> Message-ID: <4A004408.4080208@gmx.net> Benjamin Pierce wrote: > Sorry for missing that. I'll wait for your new patch. Not your fault; I failed to notify you as soon as I found the breakage. In any case, here's the patch. It won't apply cleanly, though, because of the Rev which of course must match your tree. So I suggest you run the following command in the trunk of your checkout, not its src subdir: sed 's/\$Rev\$/$Rev: '$(svnversion)' $/' bzrbuild-267.patch | patch -p0 Greetings, and thanks, Martin -------------- next part -------------- An embedded and charset-unspecified text was scrubbed... Name: bzrbuild-267.patch Url: http://lists.seas.upenn.edu/pipermail/unison-hackers/attachments/20090505/94e82a85/bzrbuild-267-0001.txt From bcpierce at seas.upenn.edu Tue May 5 13:06:30 2009 From: bcpierce at seas.upenn.edu (Benjamin C. Pierce) Date: Tue, 5 May 2009 13:06:30 -0400 Subject: [Unison-hackers] [unison-svn] r328 - in trunk: . src src/uimacnew/uimacnew.xcodeproj tools Message-ID: <200905051706.n45H6UXX003472@yaws.seas.upenn.edu> Author: bcpierce Date: 2009-05-05 13:06:29 -0400 (Tue, 05 May 2009) New Revision: 328 Modified: trunk/Makefile trunk/src/Makefile trunk/src/Makefile.OCaml trunk/src/RECENTNEWS trunk/src/mkProjectInfo.ml trunk/src/uimacnew/uimacnew.xcodeproj/project.pbxproj trunk/tools/Makefile Log: * Incorporate Makefile improvements from Martin von Gagern Modified: trunk/Makefile =================================================================== --- trunk/Makefile 2009-05-05 12:41:35 UTC (rev 327) +++ trunk/Makefile 2009-05-05 17:06:29 UTC (rev 328) @@ -13,10 +13,10 @@ -include src/Makefile.ProjectInfo src/Makefile.ProjectInfo: src/mkProjectInfo - src/mkProjectInfo > $@ + $(MAKE) -C src Makefile.ProjectInfo src/mkProjectInfo: src/mkProjectInfo.ml - ocamlc -o $@ $^ + $(MAKE) -C src mkProjectInfo docs: $(MAKE) -C src UISTYLE=text Modified: trunk/src/Makefile =================================================================== --- trunk/src/Makefile 2009-05-05 12:41:35 UTC (rev 327) +++ trunk/src/Makefile 2009-05-05 17:06:29 UTC (rev 328) @@ -37,6 +37,16 @@ all:: INSTALL +.PHONY: all clean install doinstall installtext text \ + setupdemo-old setupdemo modifydemo demo \ + run runbatch runt rundebug runp runtext runsort runprefer \ + prefsdocs runtest repeattest \ + selftest selftestdebug selftestremote testmerge \ + checkin installremote + +.DELETE_ON_ERROR: +# to avoid problems when e.g. mkProjectInfo fails to run + INSTALL: $(NAME)$(EXEC_EXT) # file isn't made for OS X, so check that it's there first (if [ -f $(NAME) ]; then ./$(NAME) -doc install > INSTALLATION; fi) @@ -50,11 +60,11 @@ # NAME, VERSION, and MAJORVERSION, automatically generated -include Makefile.ProjectInfo -Makefile.ProjectInfo: mkProjectInfo +Makefile.ProjectInfo: mkProjectInfo $(wildcard ../.bzr/branch/last-revision) ./mkProjectInfo > $@ mkProjectInfo: mkProjectInfo.ml - ocamlc -o $@ $^ + ocamlc -o $@ unix.cma str.cma $^ clean:: $(RM) mkProjectInfo Modified: trunk/src/Makefile.OCaml =================================================================== --- trunk/src/Makefile.OCaml 2009-05-05 12:41:35 UTC (rev 327) +++ trunk/src/Makefile.OCaml 2009-05-05 17:06:29 UTC (rev 328) @@ -125,6 +125,7 @@ endif endif +.PHONY: buildexecutable buildexecutable:: @echo NATIVE = $(NATIVE) @echo THREADS = $(THREADS) @@ -132,7 +133,7 @@ @echo OSTYPE = $(OSTYPE) @echo OSARCH = $(OSARCH) -ubase/projectInfo.ml: mkProjectInfo +ubase/projectInfo.ml: Makefile.ProjectInfo echo 'let myName = "'$(NAME)'";;' > $@ echo 'let myVersion = "'$(VERSION)'";;' >> $@ echo 'let myMajorVersion = "'$(MAJORVERSION)'";;' >> $@ @@ -160,6 +161,7 @@ # NOTE: the OCAMLLIBDIR is not getting passed correctly? # The two cases for cltool are needed because Xcode 2.1+ # builds in build/Default/, and earlier versions use build/ +.PHONY: macexecutable macexecutable: $(NAME)-blob.o # sed -e's/@@VERSION@@/$(VERSION)/' $(UIMACDIR)/Info.plist.template > $(UIMACDIR)/Info.plist (cd $(UIMACDIR); xcodebuild OCAMLLIBDIR="$(OCAMLLIBDIR)" SYMROOT=build) @@ -388,6 +390,7 @@ -$(RM) -r *.obj *.lib *.exp -$(RM) -r *.tmp *.bak?.tmp .*.bak?.tmp +.PHONY: paths paths: @echo PATH = $(PATH) @echo OCAMLLIBDIR = $(OCAMLLIBDIR) Modified: trunk/src/RECENTNEWS =================================================================== --- trunk/src/RECENTNEWS 2009-05-05 12:41:35 UTC (rev 327) +++ trunk/src/RECENTNEWS 2009-05-05 17:06:29 UTC (rev 328) @@ -1,3 +1,8 @@ +CHANGES FROM VERSION 2.33.2 + +* Incorporate Makefile improvements from Martin von Gagern + +------------------------------- CHANGES FROM VERSION 2.33.1 * Incorporate recent change from 2.32 branch. Modified: trunk/src/mkProjectInfo.ml =================================================================== --- trunk/src/mkProjectInfo.ml 2009-05-05 12:41:35 UTC (rev 327) +++ trunk/src/mkProjectInfo.ml 2009-05-05 17:06:29 UTC (rev 328) @@ -42,10 +42,47 @@ (* ---------------------------------------------------------------------- *) (* You shouldn't need to edit below. *) -let revisionString = "$Rev$";; -let revision = Scanf.sscanf revisionString "$Rev: %d " (fun x -> x);; -let pointVersion = revision - pointVersionOrigin;; +(* run the bzr tool to get version information for bzr branches *) +exception BzrException of Unix.process_status;; +let bzr args = + let bzr = (try Sys.getenv "BZR" with Not_found -> "bzr") in + let cmd = bzr ^ " " ^ args in + let inc = Unix.open_process_in cmd in + let buf = Buffer.create 16 in + (try + while true do + Buffer.add_channel buf inc 1 + done + with End_of_file -> ()); + let status = Unix.close_process_in inc in + match status with + Unix.WEXITED 0 -> Buffer.contents buf + | _ -> raise (BzrException status);; +(* extract a substring using a regular expression *) +let extract_str re str = + let _ = Str.search_forward (Str.regexp re) str 0 in + Str.matched_group 1 str;; +let extract_int re str = int_of_string (extract_str re str);; + +let revisionString = "$Rev: 327$";; +let pointVersion = if String.length revisionString > 5 +then Scanf.sscanf revisionString "$Rev: %d " (fun x -> x) - pointVersionOrigin +else (* Determining the pointVersionOrigin in bzr is kind of tricky: + - The mentioned revision number might not be part of this branch + - The mentioned revision number might be rhs of some merge + - The bzr-svn plugin might be outdated or not installed at all + + On the whole, getting this to work seems too much effort for now. + So we'll simply use the revno as is as the point version, + and revisit offsetting them if unison should ever move its trunk to bzr. + + let pvo = extract_int "^revno:[ \t]*\\([0-9]+\\)[ \t]*$" + (bzr ("log -r svn:" ^ + string_of_int pointVersionOrigin)) in + *) + extract_int "^\\([0-9]+\\)$" (bzr "revno") (* - pvo *);; + Printf.printf "MAJORVERSION=%d.%d\n" majorVersion minorVersion;; Printf.printf "VERSION=%d.%d.%d\n" majorVersion minorVersion pointVersion;; Printf.printf "NAME=%s\n" projectName;; @@ -107,3 +144,4 @@ + Modified: trunk/src/uimacnew/uimacnew.xcodeproj/project.pbxproj =================================================================== --- trunk/src/uimacnew/uimacnew.xcodeproj/project.pbxproj 2009-05-05 12:41:35 UTC (rev 327) +++ trunk/src/uimacnew/uimacnew.xcodeproj/project.pbxproj 2009-05-05 17:06:29 UTC (rev 328) @@ -461,7 +461,7 @@ ); runOnlyForDeploymentPostprocessing = 0; shellPath = /bin/sh; - shellScript = "if [ -x /usr/libexec/path_helper ]; then\n eval `/usr/libexec/path_helper -s`\nfi\nif [ ! -x ${PROJECT_DIR}/../Makefile.ProjectInfo ]; then\n if [ ! -x ${PROJECT_DIR}/../mkProjectInfo ]; then\n cd ${PROJECT_DIR}/..; ocamlc -o mkProjectInfo mkProjectInfo.ml\n fi\n cd ${PROJECT_DIR}/..; ./mkProjectInfo > Makefile.ProjectInfo\nfi\nOCAMLLIBDIR=`ocamlc -v | tail -n -1 | sed -e 's/.* //g' | sed -e 's/\\\\\\/\\\\//g' | tr -d '\\r'`\nsource ${PROJECT_DIR}/../Makefile.ProjectInfo\necho MARKETING_VERSION = $VERSION > ${PROJECT_DIR}/ExternalSettings.xcconfig\necho OCAMLLIBDIR = $OCAMLLIBDIR >> ${PROJECT_DIR}/ExternalSettings.xcconfig"; + shellScript = "if [ -x /usr/libexec/path_helper ]; then\n eval `/usr/libexec/path_helper -s`\nfi\nif [ ! -x ${PROJECT_DIR}/../Makefile.ProjectInfo ]; then\n if [ ! -x ${PROJECT_DIR}/../mkProjectInfo ]; then\n cd ${PROJECT_DIR}/..; ocamlc -o mkProjectInfo unix.cma str.cma mkProjectInfo.ml\n fi\n cd ${PROJECT_DIR}/..; ./mkProjectInfo > Makefile.ProjectInfo\nfi\nOCAMLLIBDIR=`ocamlc -v | tail -n -1 | sed -e 's/.* //g' | sed -e 's/\\\\\\/\\\\//g' | tr -d '\\r'`\nsource ${PROJECT_DIR}/../Makefile.ProjectInfo\necho MARKETING_VERSION = $VERSION > ${PROJECT_DIR}/ExternalSettings.xcconfig\necho OCAMLLIBDIR = $OCAMLLIBDIR >> ${PROJECT_DIR}/ExternalSettings.xcconfig"; }; 2E282CBA0D9AE17300439D01 /* Run Script (make unison-blob.o) */ = { isa = PBXShellScriptBuildPhase; Modified: trunk/tools/Makefile =================================================================== --- trunk/tools/Makefile 2009-05-05 12:41:35 UTC (rev 327) +++ trunk/tools/Makefile 2009-05-05 17:06:29 UTC (rev 328) @@ -18,7 +18,7 @@ date | ./ask ../src/Makefile.ProjectInfo: ../src/mkProjectInfo - ../src/mkProjectInfo > $@ + $(MAKE) -C ../src Makefile.ProjectInfo ../src/mkProjectInfo: ../src/mkProjectInfo.ml - ocamlc -o $@ $^ + $(MAKE) -C ../src mkProjectInfo From Martin.vGagern at gmx.net Tue May 5 13:52:19 2009 From: Martin.vGagern at gmx.net (Martin von Gagern) Date: Tue, 05 May 2009 19:52:19 +0200 Subject: [Unison-hackers] [unison-svn] r328 - in trunk: . src src/uimacnew/uimacnew.xcodeproj tools In-Reply-To: <200905051706.n45H6UXX003472@yaws.seas.upenn.edu> References: <200905051706.n45H6UXX003472@yaws.seas.upenn.edu> Message-ID: <4A007CD3.2050409@gmx.net> No good! Benjamin C. Pierce wrote: > Modified: trunk/src/mkProjectInfo.ml > =================================================================== > --- trunk/src/mkProjectInfo.ml 2009-05-05 12:41:35 UTC (rev 327) > +++ trunk/src/mkProjectInfo.ml 2009-05-05 17:06:29 UTC (rev 328) > @@ -42,10 +42,47 @@ ... > -let revisionString = "$Rev$";; ... > +let revisionString = "$Rev: 327$";; .... > +let pointVersion = if String.length revisionString > 5 OK, for some reason, subversion decided to change its idea of what this file should look like prior to keyword substitution. With this commit, the check following it will break. I guess I'll try to detect the presence of bazaar by looking for its .bzr directory at the root of the branch, instead of looking at this revision string. Buit that'll have to wait till tomorrow. On the whole, I'm surprised as to how much trouble this whole auto-versioning is causing for the bzr branches. :-( Greetings, Martin -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 261 bytes Desc: OpenPGP digital signature Url : http://lists.seas.upenn.edu/pipermail/unison-hackers/attachments/20090505/ddca3a46/signature.sig From alan.schmitt at polytechnique.org Wed May 6 05:07:46 2009 From: alan.schmitt at polytechnique.org (Alan Schmitt) Date: Wed, 6 May 2009 11:07:46 +0200 Subject: [Unison-hackers] Version 2.32 now the official beta-release In-Reply-To: References: Message-ID: On 2 mai 09, at 04:53, Benjamin Pierce wrote: > I'll post an announcement to unison-users and unison-announce in a few > days. In the meantime, this would be a good time for people that > provide binaries to turn the crank... The OS X binary is up at http://alan.petitepomme.net/unison/assets/Unison-2.32.dmg I'm using it, but if others want to try it ... Alan -------------- next part -------------- A non-text attachment was scrubbed... Name: PGP.sig Type: application/pgp-signature Size: 195 bytes Desc: This is a digitally signed message part Url : http://lists.seas.upenn.edu/pipermail/unison-hackers/attachments/20090506/64af5c9f/PGP.sig From alan.schmitt at polytechnique.org Wed May 6 05:28:56 2009 From: alan.schmitt at polytechnique.org (Alan Schmitt) Date: Wed, 6 May 2009 11:28:56 +0200 Subject: [Unison-hackers] Help building OSX GUI In-Reply-To: <4A003BA7.5090803@gmx.net> References: <3A36B4E3-2A27-435E-9E11-B852AC372A58@cis.upenn.edu> <4DBFC2EC-8355-478D-A199-7D7DB3220A37@polytechnique.org> <3BB79FBC-BB3C-429A-B9ED-433A9C92BDDE@cis.upenn.edu> <87A2B849-D292-461F-9880-DD7670552370@polytechnique.org> <2675D41E-0A57-4707-A0F4-64618C1C4963@cis.upenn.edu> <4615B1A2-3029-4BF7-96C8-2997F3B089A4@kalkwarf.com> <57894FBB-B83F-4CFF-97F8-668A24B2AA5F@cis.upenn.edu> <6BE46969-2D68-4F45-9D28-2B5D720755A7@polytechnique.org> <12DE3A85-A6F2-4D01-81D9-2949F66827BB@cis.upenn.edu> <2E008972-2CB9-42C0-9827-58C66813CDBB@cis.upenn.edu> <1BED0079-7560-4068-A15B-CB861BA33028@polytechnique.org> <28F17C90-F376-4AE0-8026-271BED414177@kalkwarf.com> <3D552623-2BC0-4696-B4C1-17CC84408F0A@cis.upenn.edu> <4A003BA7.5090803@gmx.net> Message-ID: On 5 mai 09, at 15:14, Martin von Gagern wrote: > I'm on using ocaml as built with fink, and rebuilding ocaml just to > allow developing unison doesn't sound too attractive. Without > modifications, I get this error: > > Undefined symbols: > "_chmod$UNIX2003", referenced from: > _setFileInfos in unison-blob.o > _setFileInfos in unison-blob.o > > The reference to that symbol is present in osxsupport.o as well, so > it's > the C compiler invoked by ocamlopt that's introducing this reference. > The symbol is part of the OS X 10.5 SDK, but not the 10.4 SDK. Yes, this is correct. > Alan Schmitt wrote: >> Right now, everything is set to compile for both 10.4 and 10.5, but >> requires a specially built ocaml (which is simply a line to add in a >> configuration file in godi). The reason for this is that I don't have >> access to Tiger machines anymore and I want to provide a single >> binary >> for our users. > > You shouldn't have to rebuild ocaml just to get a certain command line > argument passed on to the C compiler. The -ccopt flag does that. It > might be that code compiled from ocaml source files does introduce > additional dependencies if you don't rebuild ocaml, but as this hasn't > been a problem for me, I'll not worry about it here. The problem is the following: to provide a binary that work on both 10.4 and 10.5, one needs to say so when compiling both unison and ocaml. If you use a Leopard-only ocaml when building a Tiger+Leopard Unison, you get the above error (because ocaml libraries use Leopard- only symbols). So you actually need to rebuild ocaml to get Tiger +Leopard ocaml libraries. (Now you probably don't care if you don't want a version that works with both.) >> We could try to do some tweaking to allow different compilation >> options, >> but I would first need to find out how to change the target SDK >> from the >> command line (right now I only know how to do it in XCode). > > On my system there is a -sdk command line flag to xcodebuild. > Specifying > a value like macos10.5 for it will select the corresponding SDK, > falling > back to the project configured SDK if the selected one isn't > available. > > The attached patch takes care of both these approaches: specifying the > SDK to xcodebuild and passing -mmacosx-version-min to the C compiler. > Both are controlled using the single MINOSXVERSION variable in the > makefile. So in theory "make MINOSXVERSION=10.4" should give you a > binary ready to run anywhere, while "make MINOSXVERSION=10.5" will > give > you a version making use of all the latest features, or whatever. > > Both of these builds compile for me, while the unmodified build failed > with the unresolved reference quoted in the beginning. I would like to > see the patch included. > > Greetings, > Martin von Gagern > === modified file 'src/Makefile.OCaml' > --- src/Makefile.OCaml 2009-05-05 08:28:15 +0000 > +++ src/Makefile.OCaml 2009-05-05 12:54:21 +0000 > @@ -157,6 +157,10 @@ > endif > > MINOSXVERSION=10.5 > +XCODEFLAGS=-sdk macosx$(MINOSXVERSION) > +ifeq ($(OSARCH),osx) > + CAMLFLAGS+=-ccopt -mmacosx-version-min=$(MINOSXVERSION) > +endif > > # NOTE: the OCAMLLIBDIR is not getting passed correctly? > # The two cases for cltool are needed because Xcode 2.1+ > @@ -164,7 +168,7 @@ > .PHONY: macexecutable > macexecutable: $(NAME)-blob.o > # sed -e's/@@VERSION@@/$(VERSION)/' $(UIMACDIR)/Info.plist.template > > $(UIMACDIR)/Info.plist > - (cd $(UIMACDIR); xcodebuild OCAMLLIBDIR="$(OCAMLLIBDIR)" > SYMROOT=build) > + (cd $(UIMACDIR); xcodebuild $(XCODEFLAGS) OCAMLLIBDIR="$ > (OCAMLLIBDIR)" SYMROOT=build) > if [ -e $(UIMACDIR)/build/Default ]; then \ > gcc -mmacosx-version-min=$(MINOSXVERSION) $(UIMACDIR)/cltool.c -o > $(UIMACDIR)/build/Default/Unison.app/Contents/MacOS/cltool - > framework Carbon; \ > else \ You were able to build a 10.4 build with a 10.5 ocaml? If so there is probably something wrong somewhere. In any case, the approach is sound and I would agree to incorporate the patch, as soon as doing a "make MINOSXVERSION=10.4" fails with the undefined symbols above if using a 10.5 ocaml. Alan -------------- next part -------------- A non-text attachment was scrubbed... Name: PGP.sig Type: application/pgp-signature Size: 195 bytes Desc: This is a digitally signed message part Url : http://lists.seas.upenn.edu/pipermail/unison-hackers/attachments/20090506/e937257a/PGP.sig From Martin.vGagern at gmx.net Wed May 6 11:48:24 2009 From: Martin.vGagern at gmx.net (Martin von Gagern) Date: Wed, 06 May 2009 17:48:24 +0200 Subject: [Unison-hackers] Help building OSX GUI In-Reply-To: References: <3A36B4E3-2A27-435E-9E11-B852AC372A58@cis.upenn.edu> <4DBFC2EC-8355-478D-A199-7D7DB3220A37@polytechnique.org> <3BB79FBC-BB3C-429A-B9ED-433A9C92BDDE@cis.upenn.edu> <87A2B849-D292-461F-9880-DD7670552370@polytechnique.org> <2675D41E-0A57-4707-A0F4-64618C1C4963@cis.upenn.edu> <4615B1A2-3029-4BF7-96C8-2997F3B089A4@kalkwarf.com> <57894FBB-B83F-4CFF-97F8-668A24B2AA5F@cis.upenn.edu> <6BE46969-2D68-4F45-9D28-2B5D720755A7@polytechnique.org> <12DE3A85-A6F2-4D01-81D9-2949F66827BB@cis.upenn.edu> <2E008972-2CB9-42C0-9827-58C66813CDBB@cis.upenn.edu> <1BED0079-7560-4068-A15B-CB861BA33028@polytechnique.org> <28F17C90-F376-4AE0-8026-271BED414177@kalkwarf.com> <3D552623-2BC0-4696-B4C1-17CC84408F0A@cis.upenn.edu> <4A003BA7.5090803@gmx.net> Message-ID: <4A01B148.9070004@gmx.net> Alan Schmitt wrote: > On 5 mai 09, at 15:14, Martin von Gagern wrote: >> Undefined symbols: >> "_chmod$UNIX2003", referenced from: >> _setFileInfos in unison-blob.o >> _setFileInfos in unison-blob.o >> >> You shouldn't have to rebuild ocaml just to get a certain command line >> argument passed on to the C compiler. The -ccopt flag does that. It >> might be that code compiled from ocaml source files does introduce >> additional dependencies if you don't rebuild ocaml, but as this hasn't >> been a problem for me, I'll not worry about it here. > > The problem is the following: to provide a binary that work on both 10.4 > and 10.5, one needs to say so when compiling both unison and ocaml. If > you use a Leopard-only ocaml when building a Tiger+Leopard Unison, you > get the above error (because ocaml libraries use Leopard-only symbols). Above as above, the one I quoted? That shouldn't be the case, because the above error message was caused by C files, where ocamlopt only invokes gcc, so what ocaml itself is built against should not matter. > You were able to build a 10.4 build with a 10.5 ocaml? Probably not. I were able to get a 10.4 build with the ocaml fink installed and I didn't want to bother with. Upon closer inspection, it seems that fink does build this against the 10.4 SDK. At lkeast there is some mentioning of MACOSX_DEPLOYMENT_TARGET 10.4 in the build info. > In any case, the approach is sound > and I would agree to incorporate the patch, as soon as doing a "make > MINOSXVERSION=10.4" fails with the undefined symbols above if using a > 10.5 ocaml. I don't have a ocaml for 10.5 around. If you do, can you give it a try? Why make the failure a requirement? If it doesn't fail, that might be because ocaml, even though it itself was build for 10.5, might decide to be nice and only use 10.4 symbols in the objects it produces. I don't see anything wrong with that, even though I believe it's unlikely. In any case, if that should happen, then a 10.5 ocaml would be able to build unison binaries ready to run on 10.4, and I'd be happy with that as well. So I'd say yes, it will probably fail as you outlined, but if it doesn't, then that's even better. Thanks fpr the review, greetings, Martin -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 261 bytes Desc: OpenPGP digital signature Url : http://lists.seas.upenn.edu/pipermail/unison-hackers/attachments/20090506/0986f2a2/signature-0001.sig From Jerome.Vouillon at pps.jussieu.fr Wed May 6 12:33:52 2009 From: Jerome.Vouillon at pps.jussieu.fr (Jerome Vouillon) Date: Wed, 6 May 2009 18:33:52 +0200 Subject: [Unison-hackers] [unison-users] Experimental Unicode support In-Reply-To: <05FFF373-903F-46C2-A3F8-6904C847E456@cis.upenn.edu> References: <20090504201909.GB16235@pps.jussieu.fr> <05FFF373-903F-46C2-A3F8-6904C847E456@cis.upenn.edu> Message-ID: <20090506163352.GA25891@pps.jussieu.fr> On Tue, May 05, 2009 at 08:26:22AM -0400, Benjamin Pierce wrote: >> I have spent the day adding some basic Unicode support to the >> developper version of Unison. This should address most issues with >> synchronizing between Mac OS X and Linux (but not with Windows). >> >> When Unison is in case insensitive mode (this is the default when >> synchronizing with a Mac machine) and the "unicode" preference is set >> to true, file names are compared following the HFS+ standard (based on >> some code I wrote last december). > > Wow -- this looks like a great first step. Thanks, Jerome! > >> A lot of issues mentioned by Martin von Gagern are not yet addressed, >> but that should be a good starting point. > > Do you have any advice to offer on a good strategy for the rest? First, some Mac OS X users should test the code. Then, we need to sort out what we want to implement next. This means in particular clarifying some points in the long text posted by Martin von Gagern last week, and see what is already implemented and what remains to be done. I'll try to make some progress on the Windows side next week. -- Jerome From vouillon at seas.upenn.edu Wed May 6 12:52:53 2009 From: vouillon at seas.upenn.edu (vouillon@seas.upenn.edu) Date: Wed, 6 May 2009 12:52:53 -0400 Subject: [Unison-hackers] [unison-svn] r329 - in trunk: icons src src/lwt src/win32rc Message-ID: <200905061652.n46Gqrte020946@yaws.seas.upenn.edu> Author: vouillon Date: 2009-05-06 12:52:46 -0400 (Wed, 06 May 2009) New Revision: 329 Added: trunk/icons/U.16x16x16m.png trunk/icons/U.24x24x16m.png trunk/icons/U.256x256x16m.png trunk/icons/U.32x32x16m.png trunk/icons/U.48x48x16m.png Modified: trunk/icons/U.ico trunk/src/.depend trunk/src/Makefile.OCaml trunk/src/RECENTNEWS trunk/src/case.ml trunk/src/case.mli trunk/src/lwt/depend trunk/src/mkProjectInfo.ml trunk/src/name.ml trunk/src/name.mli trunk/src/uigtk2.ml trunk/src/update.ml trunk/src/win32rc/U.ico trunk/src/win32rc/unison.rc trunk/src/win32rc/unison.res trunk/src/win32rc/unison.res.lib Log: * Improved error messages when rejecting non-unicode encoded file names * uigtk2: fixed the code for transcoding from Windows Codepage 1252 to UTF-8 (for some reason, I mistakenly took a table corresponding to Codepage 1250 instead) * Windows: added icons with transparency Added: trunk/icons/U.16x16x16m.png =================================================================== (Binary files differ) Property changes on: trunk/icons/U.16x16x16m.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: trunk/icons/U.24x24x16m.png =================================================================== (Binary files differ) Property changes on: trunk/icons/U.24x24x16m.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: trunk/icons/U.256x256x16m.png =================================================================== (Binary files differ) Property changes on: trunk/icons/U.256x256x16m.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: trunk/icons/U.32x32x16m.png =================================================================== (Binary files differ) Property changes on: trunk/icons/U.32x32x16m.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: trunk/icons/U.48x48x16m.png =================================================================== (Binary files differ) Property changes on: trunk/icons/U.48x48x16m.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Modified: trunk/icons/U.ico =================================================================== (Binary files differ) Modified: trunk/src/.depend =================================================================== --- trunk/src/.depend 2009-05-05 17:06:29 UTC (rev 328) +++ trunk/src/.depend 2009-05-06 16:52:46 UTC (rev 329) @@ -45,8 +45,8 @@ abort.cmi abort.cmx: uutil.cmx ubase/util.cmx ubase/trace.cmx ubase/safelist.cmx \ abort.cmi -case.cmo: ubase/util.cmi unicode.cmi ubase/rx.cmi ubase/prefs.cmi case.cmi -case.cmx: ubase/util.cmx unicode.cmx ubase/rx.cmx ubase/prefs.cmx case.cmi +case.cmo: ubase/util.cmi unicode.cmi ubase/prefs.cmi case.cmi +case.cmx: ubase/util.cmx unicode.cmx ubase/prefs.cmx case.cmi checksum.cmo: checksum.cmi checksum.cmx: checksum.cmi clroot.cmo: ubase/util.cmi ubase/rx.cmi ubase/prefs.cmi clroot.cmi @@ -111,8 +111,8 @@ ubase/safelist.cmx remote.cmx ubase/prefs.cmx os.cmx fspath.cmx mkProjectInfo.cmo: mkProjectInfo.cmx: -name.cmo: ubase/util.cmi case.cmi name.cmi -name.cmx: ubase/util.cmx case.cmx name.cmi +name.cmo: ubase/util.cmi ubase/rx.cmi case.cmi name.cmi +name.cmx: ubase/util.cmx ubase/rx.cmx case.cmx name.cmi os.cmo: uutil.cmi ubase/util.cmi ubase/safelist.cmi props.cmi ubase/prefs.cmi \ path.cmi osx.cmi name.cmi fspath.cmi fingerprint.cmi fileinfo.cmi os.cmi os.cmx: uutil.cmx ubase/util.cmx ubase/safelist.cmx props.cmx ubase/prefs.cmx \ Modified: trunk/src/Makefile.OCaml =================================================================== --- trunk/src/Makefile.OCaml 2009-05-05 17:06:29 UTC (rev 328) +++ trunk/src/Makefile.OCaml 2009-05-06 16:52:46 UTC (rev 329) @@ -105,14 +105,15 @@ else # Unix system, or Cygwin with GNU C compiler OBJ_EXT=.o - CWD=$(shell pwd) ifeq ($(OSARCH),win32gnuc) + CWD=. EXEC_EXT=.exe CLIBS+=-cclib win32rc/unison.res.lib STATIC=false # Cygwin is not MinGW :-( buildexecutable:: @echo Building for Windows with Cygwin GNU C else + CWD=$(shell pwd) EXEC_EXT= # openpty is in the libutil library ifneq ($(OSARCH),solaris) @@ -343,6 +344,9 @@ endif +win32rc/unison.res: win32rc/unison.rc win32rc/U.ico + windres win32rc/unison.rc win32rc/unison.res + win32rc/unison.res.lib: win32rc/unison.res windres win32rc/unison.res win32rc/unison.res.lib Modified: trunk/src/RECENTNEWS =================================================================== --- trunk/src/RECENTNEWS 2009-05-05 17:06:29 UTC (rev 328) +++ trunk/src/RECENTNEWS 2009-05-06 16:52:46 UTC (rev 329) @@ -1,5 +1,14 @@ CHANGES FROM VERSION 2.33.2 +* Improved error messages when rejecting non-unicode encoded file names +* uigtk2: fixed the code for transcoding from Windows Codepage 1252 to + UTF-8 (for some reason, I mistakenly took a table corresponding to + Codepage 1250 instead) +* Windows: added icons with transparency + +------------------------------- +CHANGES FROM VERSION 2.33.2 + * Incorporate Makefile improvements from Martin von Gagern ------------------------------- Modified: trunk/src/case.ml =================================================================== --- trunk/src/case.ml 2009-05-05 17:06:29 UTC (rev 328) +++ trunk/src/case.ml 2009-05-06 16:52:46 UTC (rev 329) @@ -104,24 +104,6 @@ (****) -(* Windows file naming conventions are descripted here: - *) -let badWindowsFilenameRx = - Rx.case_insensitive - (Rx.rx - "(.*[\000-\031<>:\"/\\|?*].*)|\ - ((con|prn|aux|nul|com[1-9]|lpt[1-9])(\\.[^.]*)?)|\ - (.*[. ])") - -let isBadWindowsFilename s = - (* FIX: should also check for a max filename length, not sure how much *) - Rx.match_string badWindowsFilenameRx s -let badFilename someHostIsRunningWindows s = - (* Don't check unless we are syncing with Windows *) - someHostIsRunningWindows && isBadWindowsFilename s - -(****) - type mode = Sensitive | Insensitive | UnicodeInsensitive (* @@ -140,7 +122,7 @@ method normalizePattern s = s method caseInsensitiveMatch = false method normalizeMatchedString s = s - method badFilename w s = badFilename w s + method badEncoding s = false end let insensitiveOps = object @@ -150,7 +132,7 @@ method normalizePattern s = s method caseInsensitiveMatch = true method normalizeMatchedString s = s - method badFilename w s = badFilename w s + method badEncoding s = false end let unicodeInsensitiveOps = object @@ -160,7 +142,7 @@ method normalizePattern p = Unicode.normalize p method caseInsensitiveMatch = false method normalizeMatchedString s = Unicode.normalize s - method badFilename w s = not (Unicode.check_utf_8 s) || badFilename w s + method badEncoding s = not (Unicode.check_utf_8 s) end (* Note: the dispatch must be fast *) Modified: trunk/src/case.mli =================================================================== --- trunk/src/case.mli 2009-05-05 17:06:29 UTC (rev 328) +++ trunk/src/case.mli 2009-05-06 16:52:46 UTC (rev 329) @@ -10,6 +10,6 @@ normalizePattern : string -> string; caseInsensitiveMatch : bool; normalizeMatchedString : string -> string; - badFilename : bool -> string -> bool > + badEncoding : string -> bool > val init : bool -> unit Modified: trunk/src/lwt/depend =================================================================== --- trunk/src/lwt/depend 2009-05-05 17:06:29 UTC (rev 328) +++ trunk/src/lwt/depend 2009-05-06 16:52:46 UTC (rev 329) @@ -6,5 +6,7 @@ lwt_util.cmx: lwt.cmx lwt_util.cmi pqueue.cmo: pqueue.cmi pqueue.cmx: pqueue.cmi +lwt.cmi: lwt_unix.cmi: lwt.cmi lwt_util.cmi: lwt.cmi +pqueue.cmi: Modified: trunk/src/mkProjectInfo.ml =================================================================== --- trunk/src/mkProjectInfo.ml 2009-05-05 17:06:29 UTC (rev 328) +++ trunk/src/mkProjectInfo.ml 2009-05-06 16:52:46 UTC (rev 329) @@ -145,3 +145,4 @@ + Modified: trunk/src/name.ml =================================================================== --- trunk/src/name.ml 2009-05-05 17:06:29 UTC (rev 328) +++ trunk/src/name.ml 2009-05-06 16:52:46 UTC (rev 329) @@ -39,5 +39,18 @@ let hash n = (Case.ops())#hash n -let bad someHostIsRunningWindows n = - (Case.ops())#badFilename someHostIsRunningWindows n +(****) + +let badEncoding s = (Case.ops())#badEncoding s + +(* Windows file naming conventions are descripted here: + *) +let badWindowsFilenameRx = + Rx.case_insensitive + (Rx.rx + "(.*[\000-\031<>:\"/\\|?*].*)|\ + ((con|prn|aux|nul|com[1-9]|lpt[1-9])(\\.[^.]*)?)|\ + (.*[. ])") + +(* FIX: should also check for a max filename length, not sure how much *) +let badFile s = Rx.match_string badWindowsFilenameRx s Modified: trunk/src/name.mli =================================================================== --- trunk/src/name.mli 2009-05-05 17:06:29 UTC (rev 328) +++ trunk/src/name.mli 2009-05-06 16:52:46 UTC (rev 329) @@ -10,4 +10,5 @@ val eq : t -> t -> bool val hash : t -> int -val bad : bool -> t -> bool +val badEncoding : t -> bool +val badFile : t -> bool Modified: trunk/src/uigtk2.ml =================================================================== --- trunk/src/uigtk2.ml 2009-05-05 17:06:29 UTC (rev 328) +++ trunk/src/uigtk2.ml 2009-05-06 16:52:46 UTC (rev 329) @@ -170,25 +170,38 @@ non-ASCII characters. *) let code = - [| 0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15; 16; 17; 18; - 19; 20; 21; 22; 23; 24; 25; 26; 27; 28; 29; 30; 31; 32; 33; 34; - 35; 36; 37; 38; 39; 40; 41; 42; 43; 44; 45; 46; 47; 48; 49; 50; - 51; 52; 53; 54; 55; 56; 57; 58; 59; 60; 61; 62; 63; 64; 65; 66; - 67; 68; 69; 70; 71; 72; 73; 74; 75; 76; 77; 78; 79; 80; 81; 82; - 83; 84; 85; 86; 87; 88; 89; 90; 91; 92; 93; 94; 95; 96; 97; 98; - 99; 100; 101; 102; 103; 104; 105; 106; 107; 108; 109; 110; 111; - 112; 113; 114; 115; 116; 117; 118; 119; 120; 121; 122; 123; 124; - 125; 126; 127; 8364; 129; 8218; 131; 8222; 8230; 8224; 8225; 136; - 8240; 352; 8249; 346; 356; 381; 377; 144; 8216; 8217; 8220; 8221; - 8226; 8211; 8212; 152; 8482; 353; 8250; 347; 357; 382; 378; 160; - 711; 728; 321; 164; 260; 166; 167; 168; 169; 350; 171; 172; 173; - 174; 379; 176; 177; 731; 322; 180; 181; 182; 183; 184; 261; 351; - 187; 376; 733; 317; 380; 340; 193; 194; 258; 196; 313; 262; 199; - 268; 201; 280; 203; 282; 205; 206; 270; 272; 323; 327; 211; 212; - 336; 214; 215; 344; 366; 218; 368; 220; 221; 354; 223; 341; 225; - 226; 259; 228; 314; 263; 231; 269; 233; 281; 235; 283; 237; 238; - 271; 273; 324; 328; 243; 244; 337; 246; 247; 345; 367; 250; 369; - 252; 253; 355; 729 |] + [| 0x0000; 0x0001; 0x0002; 0x0003; 0x0004; 0x0005; 0x0006; 0x0007; + 0x0008; 0x0009; 0x000A; 0x000B; 0x000C; 0x000D; 0x000E; 0x000F; + 0x0010; 0x0011; 0x0012; 0x0013; 0x0014; 0x0015; 0x0016; 0x0017; + 0x0018; 0x0019; 0x001A; 0x001B; 0x001C; 0x001D; 0x001E; 0x001F; + 0x0020; 0x0021; 0x0022; 0x0023; 0x0024; 0x0025; 0x0026; 0x0027; + 0x0028; 0x0029; 0x002A; 0x002B; 0x002C; 0x002D; 0x002E; 0x002F; + 0x0030; 0x0031; 0x0032; 0x0033; 0x0034; 0x0035; 0x0036; 0x0037; + 0x0038; 0x0039; 0x003A; 0x003B; 0x003C; 0x003D; 0x003E; 0x003F; + 0x0040; 0x0041; 0x0042; 0x0043; 0x0044; 0x0045; 0x0046; 0x0047; + 0x0048; 0x0049; 0x004A; 0x004B; 0x004C; 0x004D; 0x004E; 0x004F; + 0x0050; 0x0051; 0x0052; 0x0053; 0x0054; 0x0055; 0x0056; 0x0057; + 0x0058; 0x0059; 0x005A; 0x005B; 0x005C; 0x005D; 0x005E; 0x005F; + 0x0060; 0x0061; 0x0062; 0x0063; 0x0064; 0x0065; 0x0066; 0x0067; + 0x0068; 0x0069; 0x006A; 0x006B; 0x006C; 0x006D; 0x006E; 0x006F; + 0x0070; 0x0071; 0x0072; 0x0073; 0x0074; 0x0075; 0x0076; 0x0077; + 0x0078; 0x0079; 0x007A; 0x007B; 0x007C; 0x007D; 0x007E; 0x007F; + 0x20AC; 0x1234; 0x201A; 0x0192; 0x201E; 0x2026; 0x2020; 0x2021; + 0x02C6; 0x2030; 0x0160; 0x2039; 0x0152; 0x1234; 0x017D; 0x1234; + 0x1234; 0x2018; 0x2019; 0x201C; 0x201D; 0x2022; 0x2013; 0x2014; + 0x02DC; 0x2122; 0x0161; 0x203A; 0x0153; 0x1234; 0x017E; 0x0178; + 0x00A0; 0x00A1; 0x00A2; 0x00A3; 0x00A4; 0x00A5; 0x00A6; 0x00A7; + 0x00A8; 0x00A9; 0x00AA; 0x00AB; 0x00AC; 0x00AD; 0x00AE; 0x00AF; + 0x00B0; 0x00B1; 0x00B2; 0x00B3; 0x00B4; 0x00B5; 0x00B6; 0x00B7; + 0x00B8; 0x00B9; 0x00BA; 0x00BB; 0x00BC; 0x00BD; 0x00BE; 0x00BF; + 0x00C0; 0x00C1; 0x00C2; 0x00C3; 0x00C4; 0x00C5; 0x00C6; 0x00C7; + 0x00C8; 0x00C9; 0x00CA; 0x00CB; 0x00CC; 0x00CD; 0x00CE; 0x00CF; + 0x00D0; 0x00D1; 0x00D2; 0x00D3; 0x00D4; 0x00D5; 0x00D6; 0x00D7; + 0x00D8; 0x00D9; 0x00DA; 0x00DB; 0x00DC; 0x00DD; 0x00DE; 0x00DF; + 0x00E0; 0x00E1; 0x00E2; 0x00E3; 0x00E4; 0x00E5; 0x00E6; 0x00E7; + 0x00E8; 0x00E9; 0x00EA; 0x00EB; 0x00EC; 0x00ED; 0x00EE; 0x00EF; + 0x00F0; 0x00F1; 0x00F2; 0x00F3; 0x00F4; 0x00F5; 0x00F6; 0x00F7; + 0x00F8; 0x00F9; 0x00FA; 0x00FB; 0x00FC; 0x00FD; 0x00FE; 0x00FF |] let rec transcodeRec buf s i l = if i < l then begin Modified: trunk/src/update.ml =================================================================== --- trunk/src/update.ml 2009-05-05 17:06:29 UTC (rev 328) +++ trunk/src/update.ml 2009-05-06 16:52:46 UTC (rev 329) @@ -1188,7 +1188,17 @@ Note that case conflicts and illegal filenames can only occur under Unix, when syncing with a Windows file system. *) -let badFilename s = Name.bad (Prefs.read Globals.someHostIsRunningWindows) s +let checkFilename s = + if Name.badEncoding s then + `BadEnc + else if + (* Don't check unless we are syncing with Windows *) + Prefs.read Globals.someHostIsRunningWindows && + Name.badFile s + then + `BadName + else + `Ok let getChildren fspath path = let children = @@ -1204,10 +1214,8 @@ let childStatus nm count = if count > 1 then `Dup - else if badFilename nm then - `Bad else - `Ok + checkFilename nm in let rec findDuplicates' res nm count l = match l with @@ -1282,8 +1290,15 @@ in updates := (nm, uiChild) :: !updates; archive - | `Bad -> + | `BadEnc -> let uiChild = + Error ("The file name is not encoded in Unicode (" + ^ Path.toString path' ^ ")") + in + updates := (nm, uiChild) :: !updates; + archive + | `BadName -> + let uiChild = Error ("The name of this Unix file is not allowed in Windows (" ^ Path.toString path' ^ ")") in @@ -1449,12 +1464,16 @@ try Safelist.find (fun (name', _) -> Name.eq name name') children with Not_found -> - (name, if badFilename name then `Bad else `Ok) + (name, checkFilename name) in match status with - `Bad -> + | `BadEnc -> raise (Util.Transient ("The path " ^ Path.toString fullpath ^ + " is not encoded in Unicode")) + | `BadName -> + raise (Util.Transient + ("The path " ^ Path.toString fullpath ^ " is not allowed in Windows")) | `Dup -> raise (Util.Transient Modified: trunk/src/win32rc/U.ico =================================================================== (Binary files differ) Modified: trunk/src/win32rc/unison.rc =================================================================== --- trunk/src/win32rc/unison.rc 2009-05-05 17:06:29 UTC (rev 328) +++ trunk/src/win32rc/unison.rc 2009-05-06 16:52:46 UTC (rev 329) @@ -1,80 +1,3 @@ #include UNISON_ICON ICON "U.ico" -X_cursor CURSOR DISCARDABLE "cursor00.cur" -arrow CURSOR DISCARDABLE "cursor02.cur" -based_arrow_down CURSOR DISCARDABLE "cursor04.cur" -based_arrow_up CURSOR DISCARDABLE "cursor06.cur" -boat CURSOR DISCARDABLE "cursor08.cur" -bogosity CURSOR DISCARDABLE "cursor0a.cur" -bottom_left_corner CURSOR DISCARDABLE "cursor0c.cur" -bottom_right_corner CURSOR DISCARDABLE "cursor0e.cur" -bottom_side CURSOR DISCARDABLE "cursor10.cur" -bottom_tee CURSOR DISCARDABLE "cursor12.cur" -box_spiral CURSOR DISCARDABLE "cursor14.cur" -center_ptr CURSOR DISCARDABLE "cursor16.cur" -circle CURSOR DISCARDABLE "cursor18.cur" -clock CURSOR DISCARDABLE "cursor1a.cur" -coffee_mug CURSOR DISCARDABLE "cursor1c.cur" -cross CURSOR DISCARDABLE "cursor1e.cur" -cross_reverse CURSOR DISCARDABLE "cursor20.cur" -crosshair CURSOR DISCARDABLE "cursor22.cur" -diamond_cross CURSOR DISCARDABLE "cursor24.cur" -dot CURSOR DISCARDABLE "cursor26.cur" -dotbox CURSOR DISCARDABLE "cursor28.cur" -double_arrow CURSOR DISCARDABLE "cursor2a.cur" -draft_large CURSOR DISCARDABLE "cursor2c.cur" -draft_small CURSOR DISCARDABLE "cursor2e.cur" -draped_box CURSOR DISCARDABLE "cursor30.cur" -exchange CURSOR DISCARDABLE "cursor32.cur" -fleur CURSOR DISCARDABLE "cursor34.cur" -gobbler CURSOR DISCARDABLE "cursor36.cur" -gumby CURSOR DISCARDABLE "cursor38.cur" -hand1 CURSOR DISCARDABLE "cursor3a.cur" -hand2 CURSOR DISCARDABLE "cursor3c.cur" -heart CURSOR DISCARDABLE "cursor3e.cur" -icon CURSOR DISCARDABLE "cursor40.cur" -iron_cross CURSOR DISCARDABLE "cursor42.cur" -left_ptr CURSOR DISCARDABLE "cursor44.cur" -left_side CURSOR DISCARDABLE "cursor46.cur" -left_tee CURSOR DISCARDABLE "cursor48.cur" -leftbutton CURSOR DISCARDABLE "cursor4a.cur" -ll_angle CURSOR DISCARDABLE "cursor4c.cur" -lr_angle CURSOR DISCARDABLE "cursor4e.cur" -man CURSOR DISCARDABLE "cursor50.cur" -middlebutton CURSOR DISCARDABLE "cursor52.cur" -mouse CURSOR DISCARDABLE "cursor54.cur" -pencil CURSOR DISCARDABLE "cursor56.cur" -pirate CURSOR DISCARDABLE "cursor58.cur" -plus CURSOR DISCARDABLE "cursor5a.cur" -question_arrow CURSOR DISCARDABLE "cursor5c.cur" -right_ptr CURSOR DISCARDABLE "cursor5e.cur" -right_side CURSOR DISCARDABLE "cursor60.cur" -right_tee CURSOR DISCARDABLE "cursor62.cur" -rightbutton CURSOR DISCARDABLE "cursor64.cur" -rtl_logo CURSOR DISCARDABLE "cursor66.cur" -sailboat CURSOR DISCARDABLE "cursor68.cur" -sb_down_arrow CURSOR DISCARDABLE "cursor6a.cur" -sb_h_double_arrow CURSOR DISCARDABLE "cursor6c.cur" -sb_left_arrow CURSOR DISCARDABLE "cursor6e.cur" -sb_right_arrow CURSOR DISCARDABLE "cursor70.cur" -sb_up_arrow CURSOR DISCARDABLE "cursor72.cur" -sb_v_double_arrow CURSOR DISCARDABLE "cursor74.cur" -shuttle CURSOR DISCARDABLE "cursor76.cur" -sizing CURSOR DISCARDABLE "cursor78.cur" -spider CURSOR DISCARDABLE "cursor7a.cur" -spraycan CURSOR DISCARDABLE "cursor7c.cur" -star CURSOR DISCARDABLE "cursor7e.cur" -target CURSOR DISCARDABLE "cursor80.cur" -tcross CURSOR DISCARDABLE "cursor82.cur" -top_left_arrow CURSOR DISCARDABLE "cursor84.cur" -top_left_corner CURSOR DISCARDABLE "cursor86.cur" -top_right_corner CURSOR DISCARDABLE "cursor88.cur" -top_side CURSOR DISCARDABLE "cursor8a.cur" -top_tee CURSOR DISCARDABLE "cursor8c.cur" -trek CURSOR DISCARDABLE "cursor8e.cur" -ul_angle CURSOR DISCARDABLE "cursor90.cur" -umbrella CURSOR DISCARDABLE "cursor92.cur" -ur_angle CURSOR DISCARDABLE "cursor94.cur" -xterm CURSOR DISCARDABLE "cursor98.cur" -watch CURSOR DISCARDABLE "cursor96.cur" Modified: trunk/src/win32rc/unison.res =================================================================== (Binary files differ) Modified: trunk/src/win32rc/unison.res.lib =================================================================== (Binary files differ) From alan.schmitt at polytechnique.org Wed May 6 13:18:54 2009 From: alan.schmitt at polytechnique.org (Alan Schmitt) Date: Wed, 6 May 2009 19:18:54 +0200 Subject: [Unison-hackers] Help building OSX GUI In-Reply-To: <4A01B148.9070004@gmx.net> References: <3A36B4E3-2A27-435E-9E11-B852AC372A58@cis.upenn.edu> <4DBFC2EC-8355-478D-A199-7D7DB3220A37@polytechnique.org> <3BB79FBC-BB3C-429A-B9ED-433A9C92BDDE@cis.upenn.edu> <87A2B849-D292-461F-9880-DD7670552370@polytechnique.org> <2675D41E-0A57-4707-A0F4-64618C1C4963@cis.upenn.edu> <4615B1A2-3029-4BF7-96C8-2997F3B089A4@kalkwarf.com> <57894FBB-B83F-4CFF-97F8-668A24B2AA5F@cis.upenn.edu> <6BE46969-2D68-4F45-9D28-2B5D720755A7@polytechnique.org> <12DE3A85-A6F2-4D01-81D9-2949F66827BB@cis.upenn.edu> <2E008972-2CB9-42C0-9827-58C66813CDBB@cis.upenn.edu> <1BED0079-7560-4068-A15B-CB861BA33028@polytechnique.org> <28F17C90-F376-4AE0-8026-271BED414177@kalkwarf.com> <3D552623-2BC0-4696-B4C1-17CC84408F0A@cis.upenn.edu> <4A003BA7.5090803@gmx.net> <4A01B148.9070004@gmx.net> Message-ID: <99001391-D60A-4F65-93BF-67B8C6B15152@polytechnique.org> On 6 mai 09, at 17:48, Martin von Gagern wrote: > Alan Schmitt wrote: >> On 5 mai 09, at 15:14, Martin von Gagern wrote: >>> Undefined symbols: >>> "_chmod$UNIX2003", referenced from: >>> _setFileInfos in unison-blob.o >>> _setFileInfos in unison-blob.o >>> >>> You shouldn't have to rebuild ocaml just to get a certain command >>> line >>> argument passed on to the C compiler. The -ccopt flag does that. It >>> might be that code compiled from ocaml source files does introduce >>> additional dependencies if you don't rebuild ocaml, but as this >>> hasn't >>> been a problem for me, I'll not worry about it here. >> >> The problem is the following: to provide a binary that work on both >> 10.4 >> and 10.5, one needs to say so when compiling both unison and ocaml. >> If >> you use a Leopard-only ocaml when building a Tiger+Leopard Unison, >> you >> get the above error (because ocaml libraries use Leopard-only >> symbols). > > Above as above, the one I quoted? That shouldn't be the case, because > the above error message was caused by C files, where ocamlopt only > invokes gcc, so what ocaml itself is built against should not matter. It matters, because ocamlopt links the cmx files produced with the ocaml standard library (and other libraries, such as the unix one, if required). If the compiled ocaml library mentions Leopard specific symbols (because its C parts were compiled without specifying a target OS, thus by default it's the current OS), then when linking everything together, there is a mismatch between this 10.5 standard library and the requirement for the whole binary to be 10.4 or above. Is it clearer? >> You were able to build a 10.4 build with a 10.5 ocaml? > > Probably not. I were able to get a 10.4 build with the ocaml fink > installed and I didn't want to bother with. Upon closer inspection, it > seems that fink does build this against the 10.4 SDK. At lkeast > there is > some mentioning of MACOSX_DEPLOYMENT_TARGET 10.4 in the build info. So it's a 10.4 ocaml (or to be specific: the C parts of the libraries are compiled as 10.4). >> In any case, the approach is sound >> and I would agree to incorporate the patch, as soon as doing a "make >> MINOSXVERSION=10.4" fails with the undefined symbols above if using a >> 10.5 ocaml. > > I don't have a ocaml for 10.5 around. If you do, can you give it a > try? I don't either, but I could try to find one. I'll take a note of it. > Why make the failure a requirement? If it doesn't fail, that might be > because ocaml, even though it itself was build for 10.5, might > decide to > be nice and only use 10.4 symbols in the objects it produces. I don't > see anything wrong with that, even though I believe it's unlikely. In > any case, if that should happen, then a 10.5 ocaml would be able to > build unison binaries ready to run on 10.4, and I'd be happy with that > as well. So I'd say yes, it will probably fail as you outlined, but if > it doesn't, then that's even better. As I said earlier, it's not the objects it produces but the library that were built when building ocaml, and unless they are compiled as 10.4 they will reference problematic symbols. Alan -------------- next part -------------- A non-text attachment was scrubbed... Name: PGP.sig Type: application/pgp-signature Size: 195 bytes Desc: This is a digitally signed message part Url : http://lists.seas.upenn.edu/pipermail/unison-hackers/attachments/20090506/9fde249a/PGP-0001.sig From Martin.vGagern at gmx.net Wed May 6 13:49:50 2009 From: Martin.vGagern at gmx.net (Martin von Gagern) Date: Wed, 06 May 2009 19:49:50 +0200 Subject: [Unison-hackers] Help building OSX GUI In-Reply-To: <99001391-D60A-4F65-93BF-67B8C6B15152@polytechnique.org> References: <3A36B4E3-2A27-435E-9E11-B852AC372A58@cis.upenn.edu> <4DBFC2EC-8355-478D-A199-7D7DB3220A37@polytechnique.org> <3BB79FBC-BB3C-429A-B9ED-433A9C92BDDE@cis.upenn.edu> <87A2B849-D292-461F-9880-DD7670552370@polytechnique.org> <2675D41E-0A57-4707-A0F4-64618C1C4963@cis.upenn.edu> <4615B1A2-3029-4BF7-96C8-2997F3B089A4@kalkwarf.com> <57894FBB-B83F-4CFF-97F8-668A24B2AA5F@cis.upenn.edu> <6BE46969-2D68-4F45-9D28-2B5D720755A7@polytechnique.org> <12DE3A85-A6F2-4D01-81D9-2949F66827BB@cis.upenn.edu> <2E008972-2CB9-42C0-9827-58C66813CDBB@cis.upenn.edu> <1BED0079-7560-4068-A15B-CB861BA33028@polytechnique.org> <28F17C90-F376-4AE0-8026-271BED414177@kalkwarf.com> <3D552623-2BC0-4696-B4C1-17CC84408F0A@cis.upenn.edu> <4A003BA7.5090803@gmx.net> <4A01B148.9070004@gmx.net> <99001391-D60A-4F65-93BF-67B8C6B15152@polytechnique.o! rg> Message-ID: <4A01CDBE.1040608@gmx.net> Alan Schmitt wrote: >> Above as above, the one I quoted? That shouldn't be the case, because >> the above error message was caused by C files, where ocamlopt only >> invokes gcc, so what ocaml itself is built against should not matter. > > It matters, because ocamlopt links the cmx files produced with the ocaml > standard library (and other libraries, such as the unix one, if > required). If the compiled ocaml library mentions Leopard specific > symbols (because its C parts were compiled without specifying a target > OS, thus by default it's the current OS), then when linking everything > together, there is a mismatch between this 10.5 standard library and the > requirement for the whole binary to be 10.4 or above. Is it clearer? I still believe there is a misunderstanding. My error message originally came from osxsupport.c, not *.ml, so there is no cmx file involved. I think I understand what you are saying, and had figured some of it before. I just don't think it applies to the specific error message I had mentioned. I would expect slightly different error messages, for different symbols. > As I said earlier, it's not the objects it produces but the library that > were built when building ocaml, and unless they are compiled as 10.4 > they will reference problematic symbols. I see. I had assumed that the libraries like unix and so on would get dynamically linked in at runtime, so that it doesn't mater what symbols they contain on the system they were built, as long as the system they are run contains correct symbols. But at least unison doesn't seem to get built that way, and maybe thats better this way, as statically linked applications are a lot easier to distribute. I'm looking forward to someone giving this a try with a 10.5 ocaml, so that the patch can get incorporated. Greetings, Martin -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 261 bytes Desc: OpenPGP digital signature Url : http://lists.seas.upenn.edu/pipermail/unison-hackers/attachments/20090506/79752289/signature.sig From Martin.vGagern at gmx.net Wed May 6 15:15:46 2009 From: Martin.vGagern at gmx.net (Martin von Gagern) Date: Wed, 06 May 2009 21:15:46 +0200 Subject: [Unison-hackers] Fix bzr branch detection (was: [unison-svn] r328) In-Reply-To: <4A007CD3.2050409@gmx.net> References: <200905051706.n45H6UXX003472@yaws.seas.upenn.edu> <4A007CD3.2050409@gmx.net> Message-ID: <4A01E1E2.5020708@gmx.net> Martin von Gagern wrote: > I guess I'll try to detect the presence of bazaar by looking for its > .bzr directory at the root of the branch, instead of looking at this > revision string. Buit that'll have to wait till tomorrow. Can you please apply the attached patch? It's probably easiest to simply copy the single modification, instead of getting the revision number aligned for patch to accept. Greetings, Martin -------------- next part -------------- An embedded and charset-unspecified text was scrubbed... Name: bzrbuild-270.patch Url: http://lists.seas.upenn.edu/pipermail/unison-hackers/attachments/20090506/2b5af055/bzrbuild-270.txt From Martin.vGagern at gmx.net Wed May 6 16:16:02 2009 From: Martin.vGagern at gmx.net (Martin von Gagern) Date: Wed, 06 May 2009 22:16:02 +0200 Subject: [Unison-hackers] [unison-users] Experimental Unicode support In-Reply-To: <20090506163352.GA25891@pps.jussieu.fr> References: <20090504201909.GB16235@pps.jussieu.fr> <05FFF373-903F-46C2-A3F8-6904C847E456@cis.upenn.edu> <20090506163352.GA25891@pps.jussieu.fr> Message-ID: <4A01F002.5070502@gmx.net> Hi Jerome, thanks for your work on the Unicode issues! Jerome Vouillon wrote: > First, some Mac OS X users should test the code. I'd love to give this some testing. Unfortunately, things don't look well here on my OS X 10.5. I've created two directories, a and b, and a file foo.bar in a. I've set up an unison preferences file for these, simply specifying each as a root, using its absolute path, with no further directives in the preferences file. The stable 2.27.52 works well enough. The current r328 trunk (together with my bzr and mac build improvements) however remains "Looking for changes" forever. I have no experience in debugging ocaml applications, and almost no experience debugging on OS X. Judging from the output of pgrep, it looks like every Unison instance exhibiting this problem and killed manually would leave behind one or more running processes. Am I the only one to experience this on OS X? Any hints as to what may be the cause, and how I may debug this? > Then, we need to sort out what we want to implement next. This means > in particular clarifying some points in the long text posted by Martin > von Gagern last week, and see what is already implemented and what > remains to be done. What points do you think should be clarified? Greetings, Martin -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 261 bytes Desc: OpenPGP digital signature Url : http://lists.seas.upenn.edu/pipermail/unison-hackers/attachments/20090506/83a3f345/signature.sig From bcpierce at cis.upenn.edu Wed May 6 22:35:30 2009 From: bcpierce at cis.upenn.edu (Benjamin Pierce) Date: Wed, 6 May 2009 22:35:30 -0400 Subject: [Unison-hackers] Help building OSX GUI In-Reply-To: <4A01CDBE.1040608@gmx.net> References: <3A36B4E3-2A27-435E-9E11-B852AC372A58@cis.upenn.edu> <4DBFC2EC-8355-478D-A199-7D7DB3220A37@polytechnique.org> <3BB79FBC-BB3C-429A-B9ED-433A9C92BDDE@cis.upenn.edu> <87A2B849-D292-461F-9880-DD7670552370@polytechnique.org> <2675D41E-0A57-4707-A0F4-64618C1C4963@cis.upenn.edu> <4615B1A2-3029-4BF7-96C8-2997F3B089A4@kalkwarf.com> <57894FBB-B83F-4CFF-97F8-668A24B2AA5F@cis.upenn.edu> <6BE46969-2D68-4F45-9D28-2B5D720755A7@polytechnique.org> <12DE3A85-A6F2-4D01-81D9-2949F66827BB@cis.upenn.edu> <2E008972-2CB9-42C0-9827-58C66813CDBB@cis.upenn.edu> <1BED0079-7560-4068-A15B-CB861BA33028@polytechnique.org> <28F17C90-F376-4AE0-8026-271BED414177@kalkwarf.com> <3D552623-2BC0-4696-B4C1-17CC84408F0A@cis.upenn.edu> <4A003BA7.5090803@gmx.net> <4A01B148.9070004@gmx.net> <99001391-D60A-4F65-93BF-67B8C6B15152@polytechnique.o! ! rg> <4A01CDBE.1040608@gmx.net> Message-ID: > I'm looking forward to someone giving this a try with a 10.5 ocaml, so > that the patch can get incorporated. I've been running Unison 2.33 on 10.5 today and it seems to work fine with the text UI and with the new unicode support off (syncing both mac<->mac and mac<->linux). So at least nothing old is broken, apparently. :-) With -unicode, it works for small sets of files but the update detection on the linux side seems very slow. One funny bug I noticed is that, with -unicode, my "ignore" directives don't work any more! The pathnames in the ignore directives are clearly not getting normalized the same way as the filenames that it's getting from the OS. The GUI builds for me but doesn't work, because of a known bug with OCaml 3.11 on OSX that causes Unison to fail with "Some error in create_session child." I don't know whether this has been fixed in the meantime... - B From bcpierce at cis.upenn.edu Wed May 6 22:37:49 2009 From: bcpierce at cis.upenn.edu (Benjamin Pierce) Date: Wed, 6 May 2009 22:37:49 -0400 Subject: [Unison-hackers] [unison-users] Experimental Unicode support In-Reply-To: <4A01F002.5070502@gmx.net> References: <20090504201909.GB16235@pps.jussieu.fr> <05FFF373-903F-46C2-A3F8-6904C847E456@cis.upenn.edu> <20090506163352.GA25891@pps.jussieu.fr> <4A01F002.5070502@gmx.net> Message-ID: <33AD9E03-9E81-4C5E-8FAC-1B57B7A51B88@cis.upenn.edu> BTW, the usual way we've been debugging Unison is using the "-debug xxx" facility. If xxx=all, then debugging information from all modules is printed. If xxx=verbose, even more is printed. If xxx is another string, then it prints only debugging info from the corresponding module. It should be easy to see from the code how this works... - B On May 6, 2009, at 4:16 PM, Martin von Gagern wrote: > Hi Jerome, > > thanks for your work on the Unicode issues! > > Jerome Vouillon wrote: >> First, some Mac OS X users should test the code. > > I'd love to give this some testing. Unfortunately, things don't look > well here on my OS X 10.5. > > I've created two directories, a and b, and a file foo.bar in a. I've > set > up an unison preferences file for these, simply specifying each as a > root, using its absolute path, with no further directives in the > preferences file. The stable 2.27.52 works well enough. The current > r328 > trunk (together with my bzr and mac build improvements) however > remains > "Looking for changes" forever. > > I have no experience in debugging ocaml applications, and almost no > experience debugging on OS X. Judging from the output of pgrep, it > looks > like every Unison instance exhibiting this problem and killed manually > would leave behind one or more running processes. > > Am I the only one to experience this on OS X? Any hints as to what may > be the cause, and how I may debug this? > >> Then, we need to sort out what we want to implement next. This means >> in particular clarifying some points in the long text posted by >> Martin >> von Gagern last week, and see what is already implemented and what >> remains to be done. > > What points do you think should be clarified? > > Greetings, > Martin > > > _______________________________________________ > Unison-hackers mailing list > Unison-hackers at lists.seas.upenn.edu > http://lists.seas.upenn.edu/mailman/listinfo/unison-hackers From alan.schmitt at polytechnique.org Thu May 7 01:52:22 2009 From: alan.schmitt at polytechnique.org (Alan Schmitt) Date: Thu, 7 May 2009 07:52:22 +0200 Subject: [Unison-hackers] Help building OSX GUI In-Reply-To: References: <3A36B4E3-2A27-435E-9E11-B852AC372A58@cis.upenn.edu> <4DBFC2EC-8355-478D-A199-7D7DB3220A37@polytechnique.org> <3BB79FBC-BB3C-429A-B9ED-433A9C92BDDE@cis.upenn.edu> <87A2B849-D292-461F-9880-DD7670552370@polytechnique.org> <2675D41E-0A57-4707-A0F4-64618C1C4963@cis.upenn.edu> <4615B1A2-3029-4BF7-96C8-2997F3B089A4@kalkwarf.com> <57894FBB-B83F-4CFF-97F8-668A24B2AA5F@cis.upenn.edu> <6BE46969-2D68-4F45-9D28-2B5D720755A7@polytechnique.org> <12DE3A85-A6F2-4D01-81D9-2949F66827BB@cis.upenn.edu> <2E008972-2CB9-42C0-9827-58C66813CDBB@cis.upenn.edu> <1BED0079-7560-4068-A15B-CB861BA33028@polytechnique.org> <28F17C90-F376-4AE0-8026-271BED414177@kalkwarf.com> <3D552623-2BC0-4696-B4C1-17CC84408F0A@cis.upenn.edu> <4A003BA7.5090803@gmx.net> <4A01B148.9070004@gmx.net> <99001391-D60A-4F65-93BF-67B8C6B15152@polytechnique.o! ! ! rg> <4A01CDBE.1040608@gmx.net> Message-ID: <972B57D3-2310-4919-B7CA-402F386FE649@polytechnique.org> On 7 mai 09, at 04:35, Benjamin Pierce wrote: > The GUI builds for me but doesn't work, because of a known bug with > OCaml 3.11 on OSX that causes Unison to fail with "Some error in > create_session child." I don't know whether this has been fixed in > the meantime... I haven't looked at this, so I'm still building with 3.10. Alan -------------- next part -------------- A non-text attachment was scrubbed... Name: PGP.sig Type: application/pgp-signature Size: 195 bytes Desc: This is a digitally signed message part Url : http://lists.seas.upenn.edu/pipermail/unison-hackers/attachments/20090507/05741fc9/PGP.sig From Jerome.Vouillon at pps.jussieu.fr Thu May 7 05:48:20 2009 From: Jerome.Vouillon at pps.jussieu.fr (Jerome Vouillon) Date: Thu, 7 May 2009 11:48:20 +0200 Subject: [Unison-hackers] Help building OSX GUI In-Reply-To: References: <1BED0079-7560-4068-A15B-CB861BA33028@polytechnique.org> <28F17C90-F376-4AE0-8026-271BED414177@kalkwarf.com> <3D552623-2BC0-4696-B4C1-17CC84408F0A@cis.upenn.edu> <4A003BA7.5090803@gmx.net> <4A01B148.9070004@gmx.net> <4A01CDBE.1040608@gmx.net> Message-ID: <20090507094820.GA7810@pps.jussieu.fr> On Wed, May 06, 2009 at 10:35:30PM -0400, Benjamin Pierce wrote: [...] > With -unicode, it works for small sets of files but the update > detection on the linux side seems very slow. I could not reproduce this. I tried to run Unison on about 100000 files (part of my mail archives). This involves sorting large numbers of files, as well as doing case-insensitive regular expression matching (on the other hand, the file names are all ASCII, so the normalization function does not have that much to do). I used the "immutable" directive, so Unison does not do much else. The result is quite good. The Unicode case-insensitive mode seems to be actually faster than the old mode, though this may be just noise. Unicode mode ./unison -ui text test 1,38s user 0,32s system 99% cpu 1,693 total Case insensitive mode ./unison -ui text test 1,58s user 0,33s system 100% cpu 1,901 total Case sensitive mode ./unison -ui text test 0,92s user 0,27s system 81% cpu 1,457 total 2.32, case sensitive ./unison -ui text test 0,91s user 0,29s system 84% cpu 1,432 total > One funny bug I noticed is that, with -unicode, my "ignore" directives > don't work any more! The pathnames in the ignore directives are > clearly not getting normalized the same way as the filenames that it's > getting from the OS. Indeed, this is broken... -- Jerome From vouillon at seas.upenn.edu Thu May 7 06:01:27 2009 From: vouillon at seas.upenn.edu (vouillon@seas.upenn.edu) Date: Thu, 7 May 2009 06:01:27 -0400 Subject: [Unison-hackers] [unison-svn] r330 - trunk/src Message-ID: <200905071001.n47A1RKr024656@yaws.seas.upenn.edu> Author: vouillon Date: 2009-05-07 06:01:25 -0400 (Thu, 07 May 2009) New Revision: 330 Modified: trunk/src/RECENTNEWS trunk/src/mkProjectInfo.ml trunk/src/pred.ml Log: * Fixed predicate matching in Unicode case-insensitive mode Modified: trunk/src/RECENTNEWS =================================================================== --- trunk/src/RECENTNEWS 2009-05-06 16:52:46 UTC (rev 329) +++ trunk/src/RECENTNEWS 2009-05-07 10:01:25 UTC (rev 330) @@ -1,5 +1,10 @@ CHANGES FROM VERSION 2.33.2 +* Fixed predicate matching in Unicode case-insensitive mode + +------------------------------- +CHANGES FROM VERSION 2.33.2 + * Improved error messages when rejecting non-unicode encoded file names * uigtk2: fixed the code for transcoding from Windows Codepage 1252 to UTF-8 (for some reason, I mistakenly took a table corresponding to Modified: trunk/src/mkProjectInfo.ml =================================================================== --- trunk/src/mkProjectInfo.ml 2009-05-06 16:52:46 UTC (rev 329) +++ trunk/src/mkProjectInfo.ml 2009-05-07 10:01:25 UTC (rev 330) @@ -146,3 +146,4 @@ + Modified: trunk/src/pred.ml =================================================================== --- trunk/src/pred.ml 2009-05-06 16:52:46 UTC (rev 329) +++ trunk/src/pred.ml 2009-05-07 10:01:25 UTC (rev 330) @@ -50,7 +50,9 @@ | (pref, g)::r -> if Util.startswith str pref then let l = String.length pref in - g (Util.trimWhitespace (String.sub str l (String.length str - l))) + let s = + Util.trimWhitespace (String.sub str l (String.length str - l)) in + g ((Case.ops())#normalizePattern s) else select str r f @@ -61,7 +63,7 @@ let (p,v) = match Util.splitIntoWordsByString clause mapSeparator with [p] -> (p,None) - | [p;v] -> (p, Some ((Case.ops())#normalizePattern (Util.trimWhitespace v))) + | [p;v] -> (p, Some (Util.trimWhitespace v)) | [] -> raise (Prefs.IllegalValue "Empty pattern") | _ -> raise (Prefs.IllegalValue ("Malformed pattern: " ^ "\"" ^ clause ^ "\"\n" From bcpierce at cis.upenn.edu Thu May 7 09:25:26 2009 From: bcpierce at cis.upenn.edu (Benjamin Pierce) Date: Thu, 7 May 2009 09:25:26 -0400 Subject: [Unison-hackers] Help building OSX GUI In-Reply-To: <20090507094820.GA7810@pps.jussieu.fr> References: <1BED0079-7560-4068-A15B-CB861BA33028@polytechnique.org> <28F17C90-F376-4AE0-8026-271BED414177@kalkwarf.com> <3D552623-2BC0-4696-B4C1-17CC84408F0A@cis.upenn.edu> <4A003BA7.5090803@gmx.net> <4A01B148.9070004@gmx.net> <4A01CDBE.1040608@gmx.net> <20090507094820.GA7810@pps.jussieu.fr> Message-ID: You're right: I was misdiagnosing the problem. Actually, I haven't yet diagnosed the problem: update detection is running slower than I would expect -- I still need to investigate that. But it's the same with and without -unicode, and it's the same in 2.32. I can confirm that the fix for "ignore" directives works. Thanks! - Benjamin On May 7, 2009, at 5:48 AM, Jerome Vouillon wrote: > On Wed, May 06, 2009 at 10:35:30PM -0400, Benjamin Pierce wrote: > [...] >> With -unicode, it works for small sets of files but the update >> detection on the linux side seems very slow. > > I could not reproduce this. > > I tried to run Unison on about 100000 files (part of my mail > archives). This involves sorting large numbers of files, as well as > doing case-insensitive regular expression matching (on the other hand, > the file names are all ASCII, so the normalization function does not > have that much to do). I used the "immutable" directive, so Unison > does not do much else. The result is quite good. The Unicode > case-insensitive mode seems to be actually faster than the old mode, > though this may be just noise. > > Unicode mode > ./unison -ui text test 1,38s user 0,32s system 99% cpu 1,693 total > > Case insensitive mode > ./unison -ui text test 1,58s user 0,33s system 100% cpu 1,901 total > > Case sensitive mode > ./unison -ui text test 0,92s user 0,27s system 81% cpu 1,457 total > > 2.32, case sensitive > ./unison -ui text test 0,91s user 0,29s system 84% cpu 1,432 total > >> One funny bug I noticed is that, with -unicode, my "ignore" >> directives >> don't work any more! The pathnames in the ignore directives are >> clearly not getting normalized the same way as the filenames that >> it's >> getting from the OS. > > Indeed, this is broken... > > -- Jerome > _______________________________________________ > Unison-hackers mailing list > Unison-hackers at lists.seas.upenn.edu > http://lists.seas.upenn.edu/mailman/listinfo/unison-hackers From standin-000 at tianya.cn Mon May 11 09:39:40 2009 From: standin-000 at tianya.cn (netawater) Date: Mon, 11 May 2009 21:39:40 +0800 Subject: [Unison-hackers] How to enable multi-threading when both roots are local References: <8763h79ujs.fsf@emacs.Arch.net> <2982FCC5-21BB-48BC-A173-BB996D2EFA10@cis.upenn.edu> <87zleiui7a.fsf@emacs.Arch.net> Message-ID: <87bppzsqqr.fsf@emacs.Arch.net> netawater writes: > Benjamin Pierce writes: > >> On a single host, Unison should use all the available disk bandwidth >> just doing a single copy at a time, so there is no reason to enable >> multi-threading there. (Was this your question?) >> >> Best, >> >> - Benjamin >> >> >> On Apr 14, 2009, at 10:30 AM, netawater wrote: >> >>> I have study the source code of unison-2.31.4: >>> >>> transport.ml:23:let maxthreads = >>> transport.ml:24: Prefs.createInt "maxthreads" 20 >>> transport.ml:33:let actionReg = Lwt_util.make_region (Prefs.read >>> maxthreads) >>> transport.ml:74: Lwt_util.resize_region actionReg (Prefs.read >>> maxthreads); >>> transport.ml:75: Lwt_util.resize_region Files.copyReg (Prefs.read >>> maxthreads); >>> >>> It seems maxthreads always being enable, but unison run in >>> mult-threads even I set maxthreads as 1 >>> >>> Thank you very much! >>> >>> _______________________________________________ >>> Unison-hackers mailing list >>> Unison-hackers at lists.seas.upenn.edu >>> http://lists.seas.upenn.edu/mailman/listinfo/unison-hackers > > Thank you for your reply, it is the same situation: I use a network > driver which is regarded as local disk by unison, I need single thread > write process to adapt that network driver. I have got a substitute solution: use socket method in local so that unison regards it as a remote server. It resolved my problem, however I hope unison will be more flexible in the future. From vouillon at seas.upenn.edu Wed May 13 14:02:39 2009 From: vouillon at seas.upenn.edu (vouillon@seas.upenn.edu) Date: Wed, 13 May 2009 14:02:39 -0400 Subject: [Unison-hackers] [unison-svn] r331 - in trunk/src: . lwt ubase Message-ID: <200905131802.n4DI2dKb017387@yaws.seas.upenn.edu> Author: vouillon Date: 2009-05-13 14:02:17 -0400 (Wed, 13 May 2009) New Revision: 331 Added: trunk/src/fs.ml trunk/src/fs.mli trunk/src/system.ml trunk/src/system.mli trunk/src/system_generic.ml trunk/src/system_intf.ml trunk/src/system_win.ml trunk/src/system_win_stubs.c Removed: trunk/src/linktk.ml Modified: trunk/src/.depend trunk/src/Makefile.OCaml trunk/src/RECENTNEWS trunk/src/case.mli trunk/src/common.ml trunk/src/copy.ml trunk/src/fileinfo.ml trunk/src/fileinfo.mli trunk/src/files.ml trunk/src/files.mli trunk/src/fingerprint.ml trunk/src/fingerprint.mli trunk/src/fspath.ml trunk/src/fspath.mli trunk/src/lock.ml trunk/src/lock.mli trunk/src/lwt/lwt_unix.ml trunk/src/main.ml trunk/src/mkProjectInfo.ml trunk/src/os.ml trunk/src/os.mli trunk/src/osx.ml trunk/src/osx.mli trunk/src/props.ml trunk/src/remote.ml trunk/src/stasher.ml trunk/src/test.ml trunk/src/ubase/prefs.ml trunk/src/ubase/prefs.mli trunk/src/ubase/trace.ml trunk/src/ubase/uarg.ml trunk/src/ubase/util.ml trunk/src/ubase/util.mli trunk/src/uicommon.ml trunk/src/uigtk.ml trunk/src/uigtk2.ml trunk/src/uimacbridge.ml trunk/src/uimacbridgenew.ml trunk/src/uitext.ml trunk/src/unicode.ml trunk/src/unicode.mli trunk/src/update.ml trunk/src/uutil.ml trunk/src/uutil.mli trunk/src/xferhint.ml Log: * Added an abstraction layer over Unix/Sys modules in order to be able to redefine all system calls involving filenames * Implemented corresponding bindings for the Windows Unicode API (not activated by default yet) * Uses improved emulation of "select" call provided by Ocaml 3.11 under Windows (the GUI should not freeze as much during synchronization) Modified: trunk/src/.depend =================================================================== --- trunk/src/.depend 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/.depend 2009-05-13 18:02:17 UTC (rev 331) @@ -1,5 +1,5 @@ abort.cmi: uutil.cmi -case.cmi: +case.cmi: ubase/prefs.cmi checksum.cmi: clroot.cmi: common.cmi: uutil.cmi props.cmi path.cmi osx.cmi os.cmi name.cmi fspath.cmi \ @@ -7,16 +7,17 @@ copy.cmi: uutil.cmi props.cmi path.cmi osx.cmi os.cmi lwt/lwt.cmi fspath.cmi \ common.cmi external.cmi: -fileinfo.cmi: props.cmi path.cmi osx.cmi fspath.cmi -files.cmi: uutil.cmi props.cmi path.cmi lwt/lwt_util.cmi lwt/lwt.cmi \ - common.cmi +fileinfo.cmi: system.cmi props.cmi path.cmi osx.cmi fspath.cmi +files.cmi: uutil.cmi system.cmi props.cmi path.cmi lwt/lwt_util.cmi \ + lwt/lwt.cmi common.cmi fileutil.cmi: fingerprint.cmi: uutil.cmi path.cmi fspath.cmi -fspath.cmi: path.cmi name.cmi +fs.cmi: system_intf.cmo fspath.cmi +fspath.cmi: system.cmi path.cmi name.cmi globals.cmi: ubase/prefs.cmi path.cmi lwt/lwt.cmi common.cmi -lock.cmi: +lock.cmi: system.cmi name.cmi: -os.cmi: props.cmi path.cmi name.cmi fspath.cmi fileinfo.cmi +os.cmi: system.cmi props.cmi path.cmi name.cmi fspath.cmi fileinfo.cmi osx.cmi: uutil.cmi ubase/prefs.cmi path.cmi fspath.cmi fingerprint.cmi path.cmi: name.cmi pred.cmi: @@ -26,6 +27,7 @@ sortri.cmi: common.cmi stasher.cmi: ubase/prefs.cmi path.cmi os.cmi fspath.cmi strings.cmi: +system.cmi: system_intf.cmo terminal.cmi: test.cmi: transfer.cmi: uutil.cmi lwt/lwt.cmi @@ -57,38 +59,40 @@ osx.cmx os.cmx name.cmx fspath.cmx fileinfo.cmx common.cmi copy.cmo: xferhint.cmi uutil.cmi ubase/util.cmi transfer.cmi ubase/trace.cmi \ ubase/safelist.cmi remote.cmi props.cmi ubase/prefs.cmi path.cmi osx.cmi \ - os.cmi lwt/lwt_util.cmi lwt/lwt.cmi globals.cmi fspath.cmi fileinfo.cmi \ - external.cmi common.cmi clroot.cmi abort.cmi copy.cmi + os.cmi lwt/lwt_util.cmi lwt/lwt.cmi globals.cmi fspath.cmi fs.cmi \ + fileinfo.cmi external.cmi common.cmi clroot.cmi abort.cmi copy.cmi copy.cmx: xferhint.cmx uutil.cmx ubase/util.cmx transfer.cmx ubase/trace.cmx \ ubase/safelist.cmx remote.cmx props.cmx ubase/prefs.cmx path.cmx osx.cmx \ - os.cmx lwt/lwt_util.cmx lwt/lwt.cmx globals.cmx fspath.cmx fileinfo.cmx \ - external.cmx common.cmx clroot.cmx abort.cmx copy.cmi + os.cmx lwt/lwt_util.cmx lwt/lwt.cmx globals.cmx fspath.cmx fs.cmx \ + fileinfo.cmx external.cmx common.cmx clroot.cmx abort.cmx copy.cmi external.cmo: ubase/util.cmi ubase/safelist.cmi lwt/lwt_util.cmi \ lwt/lwt_unix.cmi lwt/lwt.cmi external.cmi external.cmx: ubase/util.cmx ubase/safelist.cmx lwt/lwt_util.cmx \ lwt/lwt_unix.cmx lwt/lwt.cmx external.cmi -fileinfo.cmo: ubase/util.cmi props.cmi ubase/prefs.cmi path.cmi osx.cmi \ - fspath.cmi fileinfo.cmi -fileinfo.cmx: ubase/util.cmx props.cmx ubase/prefs.cmx path.cmx osx.cmx \ - fspath.cmx fileinfo.cmi -files.cmo: uutil.cmi ubase/util.cmi update.cmi ubase/trace.cmi stasher.cmi \ - ubase/safelist.cmi ubase/rx.cmi remote.cmi props.cmi ubase/prefs.cmi \ - path.cmi osx.cmi os.cmi lwt/lwt_util.cmi lwt/lwt_unix.cmi lwt/lwt.cmi \ - globals.cmi fspath.cmi fingerprint.cmi fileinfo.cmi external.cmi copy.cmi \ - common.cmi abort.cmi files.cmi -files.cmx: uutil.cmx ubase/util.cmx update.cmx ubase/trace.cmx stasher.cmx \ - ubase/safelist.cmx ubase/rx.cmx remote.cmx props.cmx ubase/prefs.cmx \ - path.cmx osx.cmx os.cmx lwt/lwt_util.cmx lwt/lwt_unix.cmx lwt/lwt.cmx \ - globals.cmx fspath.cmx fingerprint.cmx fileinfo.cmx external.cmx copy.cmx \ - common.cmx abort.cmx files.cmi +fileinfo.cmo: ubase/util.cmi system.cmi props.cmi ubase/prefs.cmi path.cmi \ + osx.cmi fspath.cmi fs.cmi fileinfo.cmi +fileinfo.cmx: ubase/util.cmx system.cmx props.cmx ubase/prefs.cmx path.cmx \ + osx.cmx fspath.cmx fs.cmx fileinfo.cmi +files.cmo: uutil.cmi ubase/util.cmi update.cmi ubase/trace.cmi system.cmi \ + stasher.cmi ubase/safelist.cmi ubase/rx.cmi remote.cmi props.cmi \ + ubase/prefs.cmi path.cmi osx.cmi os.cmi lwt/lwt_util.cmi lwt/lwt_unix.cmi \ + lwt/lwt.cmi globals.cmi fspath.cmi fs.cmi fingerprint.cmi fileinfo.cmi \ + external.cmi copy.cmi common.cmi abort.cmi files.cmi +files.cmx: uutil.cmx ubase/util.cmx update.cmx ubase/trace.cmx system.cmx \ + stasher.cmx ubase/safelist.cmx ubase/rx.cmx remote.cmx props.cmx \ + ubase/prefs.cmx path.cmx osx.cmx os.cmx lwt/lwt_util.cmx lwt/lwt_unix.cmx \ + lwt/lwt.cmx globals.cmx fspath.cmx fs.cmx fingerprint.cmx fileinfo.cmx \ + external.cmx copy.cmx common.cmx abort.cmx files.cmi fileutil.cmo: fileutil.cmi fileutil.cmx: fileutil.cmi -fingerprint.cmo: uutil.cmi ubase/util.cmi fspath.cmi fingerprint.cmi -fingerprint.cmx: uutil.cmx ubase/util.cmx fspath.cmx fingerprint.cmi -fspath.cmo: ubase/util.cmi ubase/rx.cmi path.cmi name.cmi fileutil.cmi \ - fspath.cmi -fspath.cmx: ubase/util.cmx ubase/rx.cmx path.cmx name.cmx fileutil.cmx \ - fspath.cmi +fingerprint.cmo: uutil.cmi ubase/util.cmi fspath.cmi fs.cmi fingerprint.cmi +fingerprint.cmx: uutil.cmx ubase/util.cmx fspath.cmx fs.cmx fingerprint.cmi +fs.cmo: ubase/util.cmi system.cmi fspath.cmi fs.cmi +fs.cmx: ubase/util.cmx system.cmx fspath.cmx fs.cmi +fspath.cmo: uutil.cmi ubase/util.cmi system.cmi ubase/rx.cmi path.cmi \ + name.cmi fileutil.cmi fspath.cmi +fspath.cmx: uutil.cmx ubase/util.cmx system.cmx ubase/rx.cmx path.cmx \ + name.cmx fileutil.cmx fspath.cmi globals.cmo: ubase/util.cmi ubase/trace.cmi ubase/safelist.cmi remote.cmi \ ubase/prefs.cmi pred.cmi path.cmi os.cmi name.cmi lwt/lwt_util.cmi \ lwt/lwt_unix.cmi lwt/lwt.cmi common.cmi clroot.cmi globals.cmi @@ -101,26 +105,28 @@ linkgtk.cmx: uigtk.cmx main.cmx linktext.cmo: uitext.cmi main.cmo linktext.cmx: uitext.cmx main.cmx -linktk.cmo: main.cmo -linktk.cmx: main.cmx -lock.cmo: ubase/util.cmi lock.cmi -lock.cmx: ubase/util.cmx lock.cmi +lock.cmo: ubase/util.cmi system.cmi lock.cmi +lock.cmx: ubase/util.cmx system.cmx lock.cmi main.cmo: uutil.cmi ubase/util.cmi uitext.cmi uicommon.cmi strings.cmi \ - ubase/safelist.cmi remote.cmi ubase/prefs.cmi os.cmi fspath.cmi + ubase/safelist.cmi remote.cmi ubase/prefs.cmi os.cmi main.cmx: uutil.cmx ubase/util.cmx uitext.cmx uicommon.cmx strings.cmx \ - ubase/safelist.cmx remote.cmx ubase/prefs.cmx os.cmx fspath.cmx + ubase/safelist.cmx remote.cmx ubase/prefs.cmx os.cmx mkProjectInfo.cmo: mkProjectInfo.cmx: name.cmo: ubase/util.cmi ubase/rx.cmi case.cmi name.cmi name.cmx: ubase/util.cmx ubase/rx.cmx case.cmx name.cmi -os.cmo: uutil.cmi ubase/util.cmi ubase/safelist.cmi props.cmi ubase/prefs.cmi \ - path.cmi osx.cmi name.cmi fspath.cmi fingerprint.cmi fileinfo.cmi os.cmi -os.cmx: uutil.cmx ubase/util.cmx ubase/safelist.cmx props.cmx ubase/prefs.cmx \ - path.cmx osx.cmx name.cmx fspath.cmx fingerprint.cmx fileinfo.cmx os.cmi -osx.cmo: uutil.cmi ubase/util.cmi ubase/safelist.cmi ubase/prefs.cmi path.cmi \ - name.cmi fspath.cmi fingerprint.cmi osx.cmi -osx.cmx: uutil.cmx ubase/util.cmx ubase/safelist.cmx ubase/prefs.cmx path.cmx \ - name.cmx fspath.cmx fingerprint.cmx osx.cmi +os.cmo: uutil.cmi ubase/util.cmi system.cmi ubase/safelist.cmi props.cmi \ + ubase/prefs.cmi path.cmi osx.cmi name.cmi fspath.cmi fs.cmi \ + fingerprint.cmi fileinfo.cmi os.cmi +os.cmx: uutil.cmx ubase/util.cmx system.cmx ubase/safelist.cmx props.cmx \ + ubase/prefs.cmx path.cmx osx.cmx name.cmx fspath.cmx fs.cmx \ + fingerprint.cmx fileinfo.cmx os.cmi +osx.cmo: uutil.cmi ubase/util.cmi system.cmi ubase/safelist.cmi \ + ubase/prefs.cmi path.cmi name.cmi fspath.cmi fs.cmi fingerprint.cmi \ + osx.cmi +osx.cmx: uutil.cmx ubase/util.cmx system.cmx ubase/safelist.cmx \ + ubase/prefs.cmx path.cmx name.cmx fspath.cmx fs.cmx fingerprint.cmx \ + osx.cmi path.cmo: ubase/util.cmi ubase/safelist.cmi ubase/rx.cmi pred.cmi name.cmi \ fileutil.cmi case.cmi path.cmi path.cmx: ubase/util.cmx ubase/safelist.cmx ubase/rx.cmx pred.cmx name.cmx \ @@ -132,35 +138,43 @@ pred.cmx: ubase/util.cmx ubase/safelist.cmx ubase/rx.cmx ubase/prefs.cmx \ case.cmx pred.cmi props.cmo: uutil.cmi ubase/util.cmi ubase/prefs.cmi path.cmi osx.cmi \ - fspath.cmi external.cmi props.cmi + fspath.cmi fs.cmi external.cmi props.cmi props.cmx: uutil.cmx ubase/util.cmx ubase/prefs.cmx path.cmx osx.cmx \ - fspath.cmx external.cmx props.cmi + fspath.cmx fs.cmx external.cmx props.cmi recon.cmo: ubase/util.cmi update.cmi tree.cmi ubase/trace.cmi sortri.cmi \ ubase/safelist.cmi props.cmi ubase/prefs.cmi pred.cmi path.cmi name.cmi \ globals.cmi fileinfo.cmi common.cmi recon.cmi recon.cmx: ubase/util.cmx update.cmx tree.cmx ubase/trace.cmx sortri.cmx \ ubase/safelist.cmx props.cmx ubase/prefs.cmx pred.cmx path.cmx name.cmx \ globals.cmx fileinfo.cmx common.cmx recon.cmi -remote.cmo: uutil.cmi ubase/util.cmi ubase/trace.cmi terminal.cmi \ +remote.cmo: uutil.cmi ubase/util.cmi ubase/trace.cmi terminal.cmi system.cmi \ ubase/safelist.cmi ubase/prefs.cmi os.cmi lwt/lwt_unix.cmi lwt/lwt.cmi \ fspath.cmi common.cmi clroot.cmi remote.cmi -remote.cmx: uutil.cmx ubase/util.cmx ubase/trace.cmx terminal.cmx \ +remote.cmx: uutil.cmx ubase/util.cmx ubase/trace.cmx terminal.cmx system.cmx \ ubase/safelist.cmx ubase/prefs.cmx os.cmx lwt/lwt_unix.cmx lwt/lwt.cmx \ fspath.cmx common.cmx clroot.cmx remote.cmi sortri.cmo: ubase/util.cmi ubase/safelist.cmi ubase/prefs.cmi pred.cmi \ path.cmi common.cmi sortri.cmi sortri.cmx: ubase/util.cmx ubase/safelist.cmx ubase/prefs.cmx pred.cmx \ path.cmx common.cmx sortri.cmi -stasher.cmo: ubase/util.cmi ubase/safelist.cmi remote.cmi props.cmi \ - ubase/prefs.cmi pred.cmi path.cmi osx.cmi os.cmi lwt/lwt_unix.cmi \ - lwt/lwt.cmi globals.cmi fspath.cmi fingerprint.cmi fileutil.cmi \ - fileinfo.cmi copy.cmi common.cmi stasher.cmi -stasher.cmx: ubase/util.cmx ubase/safelist.cmx remote.cmx props.cmx \ - ubase/prefs.cmx pred.cmx path.cmx osx.cmx os.cmx lwt/lwt_unix.cmx \ - lwt/lwt.cmx globals.cmx fspath.cmx fingerprint.cmx fileutil.cmx \ - fileinfo.cmx copy.cmx common.cmx stasher.cmi +stasher.cmo: ubase/util.cmi system.cmi ubase/safelist.cmi remote.cmi \ + props.cmi ubase/prefs.cmi pred.cmi path.cmi osx.cmi os.cmi \ + lwt/lwt_unix.cmi lwt/lwt.cmi globals.cmi fspath.cmi fingerprint.cmi \ + fileutil.cmi fileinfo.cmi copy.cmi common.cmi stasher.cmi +stasher.cmx: ubase/util.cmx system.cmx ubase/safelist.cmx remote.cmx \ + props.cmx ubase/prefs.cmx pred.cmx path.cmx osx.cmx os.cmx \ + lwt/lwt_unix.cmx lwt/lwt.cmx globals.cmx fspath.cmx fingerprint.cmx \ + fileutil.cmx fileinfo.cmx copy.cmx common.cmx stasher.cmi strings.cmo: strings.cmi strings.cmx: strings.cmi +system_generic.cmo: +system_generic.cmx: +system_intf.cmo: +system_intf.cmx: +system.cmo: system_win.cmo system.cmi +system.cmx: system_win.cmx system.cmi +system_win.cmo: unicode.cmi ubase/rx.cmi +system_win.cmx: unicode.cmx ubase/rx.cmx terminal.cmo: ubase/safelist.cmi ubase/rx.cmi lwt/lwt_unix.cmi lwt/lwt.cmi \ terminal.cmi terminal.cmx: ubase/safelist.cmx ubase/rx.cmx lwt/lwt_unix.cmx lwt/lwt.cmx \ @@ -168,11 +182,13 @@ test.cmo: uutil.cmi ubase/util.cmi update.cmi uicommon.cmi transport.cmi \ ubase/trace.cmi stasher.cmi ubase/safelist.cmi remote.cmi recon.cmi \ ubase/prefs.cmi path.cmi os.cmi lwt/lwt_util.cmi lwt/lwt_unix.cmi \ - lwt/lwt.cmi globals.cmi fspath.cmi fingerprint.cmi common.cmi test.cmi + lwt/lwt.cmi globals.cmi fspath.cmi fs.cmi fingerprint.cmi common.cmi \ + test.cmi test.cmx: uutil.cmx ubase/util.cmx update.cmx uicommon.cmx transport.cmx \ ubase/trace.cmx stasher.cmx ubase/safelist.cmx remote.cmx recon.cmx \ ubase/prefs.cmx path.cmx os.cmx lwt/lwt_util.cmx lwt/lwt_unix.cmx \ - lwt/lwt.cmx globals.cmx fspath.cmx fingerprint.cmx common.cmx test.cmi + lwt/lwt.cmx globals.cmx fspath.cmx fs.cmx fingerprint.cmx common.cmx \ + test.cmi transfer.cmo: uutil.cmi ubase/util.cmi ubase/trace.cmi ubase/safelist.cmi \ lwt/lwt.cmi checksum.cmi transfer.cmi transfer.cmx: uutil.cmx ubase/util.cmx ubase/trace.cmx ubase/safelist.cmx \ @@ -188,76 +204,76 @@ tree.cmo: ubase/safelist.cmi tree.cmi tree.cmx: ubase/safelist.cmx tree.cmi uicommon.cmo: xferhint.cmi uutil.cmi ubase/util.cmi update.cmi \ - ubase/trace.cmi stasher.cmi ubase/safelist.cmi remote.cmi recon.cmi \ - props.cmi ubase/prefs.cmi path.cmi osx.cmi os.cmi name.cmi \ + ubase/trace.cmi system.cmi stasher.cmi ubase/safelist.cmi remote.cmi \ + recon.cmi props.cmi ubase/prefs.cmi path.cmi osx.cmi os.cmi name.cmi \ lwt/lwt_unix.cmi lwt/lwt.cmi globals.cmi fspath.cmi files.cmi \ fileinfo.cmi common.cmi clroot.cmi case.cmi uicommon.cmi uicommon.cmx: xferhint.cmx uutil.cmx ubase/util.cmx update.cmx \ - ubase/trace.cmx stasher.cmx ubase/safelist.cmx remote.cmx recon.cmx \ - props.cmx ubase/prefs.cmx path.cmx osx.cmx os.cmx name.cmx \ + ubase/trace.cmx system.cmx stasher.cmx ubase/safelist.cmx remote.cmx \ + recon.cmx props.cmx ubase/prefs.cmx path.cmx osx.cmx os.cmx name.cmx \ lwt/lwt_unix.cmx lwt/lwt.cmx globals.cmx fspath.cmx files.cmx \ fileinfo.cmx common.cmx clroot.cmx case.cmx uicommon.cmi uigtk2.cmo: uutil.cmi ubase/util.cmi update.cmi uitext.cmi uicommon.cmi \ - transport.cmi ubase/trace.cmi strings.cmi sortri.cmi ubase/safelist.cmi \ - remote.cmi recon.cmi ubase/prefs.cmi pixmaps.cmo path.cmi os.cmi \ - lwt/lwt_util.cmi lwt/lwt_unix.cmi lwt/lwt.cmi globals.cmi fspath.cmi \ - files.cmi common.cmi clroot.cmi uigtk2.cmi + transport.cmi ubase/trace.cmi system.cmi strings.cmi sortri.cmi \ + ubase/safelist.cmi remote.cmi recon.cmi ubase/prefs.cmi pixmaps.cmo \ + path.cmi os.cmi lwt/lwt_util.cmi lwt/lwt_unix.cmi lwt/lwt.cmi globals.cmi \ + files.cmi common.cmi clroot.cmi case.cmi uigtk2.cmi uigtk2.cmx: uutil.cmx ubase/util.cmx update.cmx uitext.cmx uicommon.cmx \ - transport.cmx ubase/trace.cmx strings.cmx sortri.cmx ubase/safelist.cmx \ - remote.cmx recon.cmx ubase/prefs.cmx pixmaps.cmx path.cmx os.cmx \ - lwt/lwt_util.cmx lwt/lwt_unix.cmx lwt/lwt.cmx globals.cmx fspath.cmx \ - files.cmx common.cmx clroot.cmx uigtk2.cmi + transport.cmx ubase/trace.cmx system.cmx strings.cmx sortri.cmx \ + ubase/safelist.cmx remote.cmx recon.cmx ubase/prefs.cmx pixmaps.cmx \ + path.cmx os.cmx lwt/lwt_util.cmx lwt/lwt_unix.cmx lwt/lwt.cmx globals.cmx \ + files.cmx common.cmx clroot.cmx case.cmx uigtk2.cmi uigtk.cmo: uutil.cmi ubase/util.cmi update.cmi uitext.cmi uicommon.cmi \ - transport.cmi ubase/trace.cmi strings.cmi sortri.cmi ubase/safelist.cmi \ - remote.cmi recon.cmi ubase/prefs.cmi pixmaps.cmo path.cmi os.cmi \ - lwt/lwt_util.cmi lwt/lwt_unix.cmi lwt/lwt.cmi globals.cmi fspath.cmi \ + transport.cmi ubase/trace.cmi system.cmi strings.cmi sortri.cmi \ + ubase/safelist.cmi remote.cmi recon.cmi ubase/prefs.cmi pixmaps.cmo \ + path.cmi os.cmi lwt/lwt_util.cmi lwt/lwt_unix.cmi lwt/lwt.cmi globals.cmi \ files.cmi common.cmi clroot.cmi uigtk.cmi uigtk.cmx: uutil.cmx ubase/util.cmx update.cmx uitext.cmx uicommon.cmx \ - transport.cmx ubase/trace.cmx strings.cmx sortri.cmx ubase/safelist.cmx \ - remote.cmx recon.cmx ubase/prefs.cmx pixmaps.cmx path.cmx os.cmx \ - lwt/lwt_util.cmx lwt/lwt_unix.cmx lwt/lwt.cmx globals.cmx fspath.cmx \ + transport.cmx ubase/trace.cmx system.cmx strings.cmx sortri.cmx \ + ubase/safelist.cmx remote.cmx recon.cmx ubase/prefs.cmx pixmaps.cmx \ + path.cmx os.cmx lwt/lwt_util.cmx lwt/lwt_unix.cmx lwt/lwt.cmx globals.cmx \ files.cmx common.cmx clroot.cmx uigtk.cmi uimacbridge.cmo: xferhint.cmi uutil.cmi ubase/util.cmi update.cmi \ - uicommon.cmi transport.cmi ubase/trace.cmi terminal.cmi stasher.cmi \ - ubase/safelist.cmi remote.cmi recon.cmi ubase/prefs.cmi path.cmi os.cmi \ - main.cmo lwt/lwt_util.cmi lwt/lwt_unix.cmi lwt/lwt.cmi globals.cmi \ - fspath.cmi files.cmi common.cmi clroot.cmi + uicommon.cmi transport.cmi ubase/trace.cmi terminal.cmi system.cmi \ + stasher.cmi ubase/safelist.cmi remote.cmi recon.cmi ubase/prefs.cmi \ + path.cmi os.cmi main.cmo lwt/lwt_util.cmi lwt/lwt_unix.cmi lwt/lwt.cmi \ + globals.cmi fspath.cmi files.cmi common.cmi clroot.cmi uimacbridge.cmx: xferhint.cmx uutil.cmx ubase/util.cmx update.cmx \ - uicommon.cmx transport.cmx ubase/trace.cmx terminal.cmx stasher.cmx \ - ubase/safelist.cmx remote.cmx recon.cmx ubase/prefs.cmx path.cmx os.cmx \ - main.cmx lwt/lwt_util.cmx lwt/lwt_unix.cmx lwt/lwt.cmx globals.cmx \ - fspath.cmx files.cmx common.cmx clroot.cmx + uicommon.cmx transport.cmx ubase/trace.cmx terminal.cmx system.cmx \ + stasher.cmx ubase/safelist.cmx remote.cmx recon.cmx ubase/prefs.cmx \ + path.cmx os.cmx main.cmx lwt/lwt_util.cmx lwt/lwt_unix.cmx lwt/lwt.cmx \ + globals.cmx fspath.cmx files.cmx common.cmx clroot.cmx uimacbridgenew.cmo: xferhint.cmi uutil.cmi ubase/util.cmi update.cmi \ - uicommon.cmi transport.cmi ubase/trace.cmi terminal.cmi stasher.cmi \ - ubase/safelist.cmi remote.cmi recon.cmi ubase/prefs.cmi path.cmi os.cmi \ - main.cmo lwt/lwt_util.cmi lwt/lwt_unix.cmi lwt/lwt.cmi globals.cmi \ - fspath.cmi files.cmi common.cmi clroot.cmi + uicommon.cmi transport.cmi ubase/trace.cmi terminal.cmi system.cmi \ + stasher.cmi ubase/safelist.cmi remote.cmi recon.cmi ubase/prefs.cmi \ + path.cmi os.cmi main.cmo lwt/lwt_util.cmi lwt/lwt_unix.cmi lwt/lwt.cmi \ + globals.cmi fspath.cmi files.cmi common.cmi clroot.cmi uimacbridgenew.cmx: xferhint.cmx uutil.cmx ubase/util.cmx update.cmx \ - uicommon.cmx transport.cmx ubase/trace.cmx terminal.cmx stasher.cmx \ - ubase/safelist.cmx remote.cmx recon.cmx ubase/prefs.cmx path.cmx os.cmx \ - main.cmx lwt/lwt_util.cmx lwt/lwt_unix.cmx lwt/lwt.cmx globals.cmx \ - fspath.cmx files.cmx common.cmx clroot.cmx + uicommon.cmx transport.cmx ubase/trace.cmx terminal.cmx system.cmx \ + stasher.cmx ubase/safelist.cmx remote.cmx recon.cmx ubase/prefs.cmx \ + path.cmx os.cmx main.cmx lwt/lwt_util.cmx lwt/lwt_unix.cmx lwt/lwt.cmx \ + globals.cmx fspath.cmx files.cmx common.cmx clroot.cmx uitext.cmo: uutil.cmi ubase/util.cmi update.cmi uicommon.cmi transport.cmi \ - ubase/trace.cmi ubase/safelist.cmi remote.cmi recon.cmi ubase/prefs.cmi \ - path.cmi lwt/lwt_util.cmi lwt/lwt_unix.cmi lwt/lwt.cmi globals.cmi \ - common.cmi uitext.cmi + ubase/trace.cmi system.cmi ubase/safelist.cmi remote.cmi recon.cmi \ + ubase/prefs.cmi path.cmi lwt/lwt_util.cmi lwt/lwt_unix.cmi lwt/lwt.cmi \ + globals.cmi common.cmi uitext.cmi uitext.cmx: uutil.cmx ubase/util.cmx update.cmx uicommon.cmx transport.cmx \ - ubase/trace.cmx ubase/safelist.cmx remote.cmx recon.cmx ubase/prefs.cmx \ - path.cmx lwt/lwt_util.cmx lwt/lwt_unix.cmx lwt/lwt.cmx globals.cmx \ - common.cmx uitext.cmi + ubase/trace.cmx system.cmx ubase/safelist.cmx remote.cmx recon.cmx \ + ubase/prefs.cmx path.cmx lwt/lwt_util.cmx lwt/lwt_unix.cmx lwt/lwt.cmx \ + globals.cmx common.cmx uitext.cmi unicode.cmo: unicode_tables.cmo unicode.cmi unicode.cmx: unicode_tables.cmx unicode.cmi unicode_tables.cmo: unicode_tables.cmx: update.cmo: xferhint.cmi uutil.cmi ubase/util.cmi tree.cmi ubase/trace.cmi \ - stasher.cmi ubase/safelist.cmi remote.cmi props.cmi ubase/prefs.cmi \ - pred.cmi path.cmi osx.cmi os.cmi name.cmi ubase/myMap.cmi \ - lwt/lwt_unix.cmi lwt/lwt.cmi lock.cmi globals.cmi fspath.cmi \ + system.cmi stasher.cmi ubase/safelist.cmi remote.cmi props.cmi \ + ubase/prefs.cmi pred.cmi path.cmi osx.cmi os.cmi name.cmi ubase/myMap.cmi \ + lwt/lwt_unix.cmi lwt/lwt.cmi lock.cmi globals.cmi fspath.cmi fs.cmi \ fingerprint.cmi fileinfo.cmi external.cmi common.cmi update.cmi update.cmx: xferhint.cmx uutil.cmx ubase/util.cmx tree.cmx ubase/trace.cmx \ - stasher.cmx ubase/safelist.cmx remote.cmx props.cmx ubase/prefs.cmx \ - pred.cmx path.cmx osx.cmx os.cmx name.cmx ubase/myMap.cmx \ - lwt/lwt_unix.cmx lwt/lwt.cmx lock.cmx globals.cmx fspath.cmx \ + system.cmx stasher.cmx ubase/safelist.cmx remote.cmx props.cmx \ + ubase/prefs.cmx pred.cmx path.cmx osx.cmx os.cmx name.cmx ubase/myMap.cmx \ + lwt/lwt_unix.cmx lwt/lwt.cmx lock.cmx globals.cmx fspath.cmx fs.cmx \ fingerprint.cmx fileinfo.cmx external.cmx common.cmx update.cmi uutil.cmo: ubase/util.cmi ubase/projectInfo.cmo uutil.cmi uutil.cmx: ubase/util.cmx ubase/projectInfo.cmx uutil.cmi @@ -275,9 +291,9 @@ lwt/pqueue.cmx: lwt/pqueue.cmi ubase/myMap.cmo: ubase/myMap.cmi ubase/myMap.cmx: ubase/myMap.cmi -ubase/prefs.cmo: ubase/util.cmi ubase/uarg.cmi ubase/safelist.cmi \ +ubase/prefs.cmo: ubase/util.cmi ubase/uarg.cmi system.cmi ubase/safelist.cmi \ ubase/prefs.cmi -ubase/prefs.cmx: ubase/util.cmx ubase/uarg.cmx ubase/safelist.cmx \ +ubase/prefs.cmx: ubase/util.cmx ubase/uarg.cmx system.cmx ubase/safelist.cmx \ ubase/prefs.cmi ubase/projectInfo.cmo: ubase/projectInfo.cmx: @@ -285,25 +301,27 @@ ubase/rx.cmx: ubase/rx.cmi ubase/safelist.cmo: ubase/safelist.cmi ubase/safelist.cmx: ubase/safelist.cmi -ubase/trace.cmo: ubase/util.cmi ubase/safelist.cmi ubase/prefs.cmi \ +ubase/trace.cmo: ubase/util.cmi system.cmi ubase/safelist.cmi ubase/prefs.cmi \ ubase/trace.cmi -ubase/trace.cmx: ubase/util.cmx ubase/safelist.cmx ubase/prefs.cmx \ +ubase/trace.cmx: ubase/util.cmx system.cmx ubase/safelist.cmx ubase/prefs.cmx \ ubase/trace.cmi -ubase/uarg.cmo: ubase/util.cmi ubase/safelist.cmi ubase/uarg.cmi -ubase/uarg.cmx: ubase/util.cmx ubase/safelist.cmx ubase/uarg.cmi +ubase/uarg.cmo: ubase/util.cmi system.cmi ubase/safelist.cmi ubase/uarg.cmi +ubase/uarg.cmx: ubase/util.cmx system.cmx ubase/safelist.cmx ubase/uarg.cmi ubase/uprintf.cmo: ubase/uprintf.cmi ubase/uprintf.cmx: ubase/uprintf.cmi -ubase/util.cmo: ubase/uprintf.cmi ubase/safelist.cmi ubase/util.cmi -ubase/util.cmx: ubase/uprintf.cmx ubase/safelist.cmx ubase/util.cmi +ubase/util.cmo: ubase/uprintf.cmi system.cmi ubase/safelist.cmi \ + ubase/util.cmi +ubase/util.cmx: ubase/uprintf.cmx system.cmx ubase/safelist.cmx \ + ubase/util.cmi lwt/lwt.cmi: lwt/lwt_unix.cmi: lwt/lwt.cmi lwt/lwt_util.cmi: lwt/lwt.cmi lwt/pqueue.cmi: ubase/myMap.cmi: -ubase/prefs.cmi: ubase/util.cmi +ubase/prefs.cmi: ubase/util.cmi system.cmi ubase/rx.cmi: ubase/safelist.cmi: ubase/trace.cmi: ubase/prefs.cmi ubase/uarg.cmi: ubase/uprintf.cmi: -ubase/util.cmi: +ubase/util.cmi: system.cmi Modified: trunk/src/Makefile.OCaml =================================================================== --- trunk/src/Makefile.OCaml 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/Makefile.OCaml 2009-05-13 18:02:17 UTC (rev 331) @@ -98,6 +98,8 @@ # issue." # CLIBS+=-cclib win32rc/unison.res # STATICLIBS+=-cclib win32rc/unison.res + COBJS+=system_win_stubs$(OBJ_EXT) + WINOBJS=system_win.cmo CLIBS+=-cclib "-link win32rc/unison.res" STATICLIBS+=-cclib "-link win32rc/unison.res" buildexecutable:: @@ -108,6 +110,8 @@ ifeq ($(OSARCH),win32gnuc) CWD=. EXEC_EXT=.exe + COBJS+=system_win_stubs$(OBJ_EXT) + WINOBJS=system_win.cmo CLIBS+=-cclib win32rc/unison.res.lib STATIC=false # Cygwin is not MinGW :-( buildexecutable:: @@ -176,14 +180,19 @@ # File extensions will be substituted for the native code version OCAMLOBJS += \ + ubase/rx.cmo \ + \ + unicode_tables.cmo unicode.cmo \ + $(WINOBJS) system_generic.cmo system.cmo \ + \ ubase/projectInfo.cmo ubase/myMap.cmo ubase/safelist.cmo \ - ubase/uprintf.cmo ubase/util.cmo ubase/rx.cmo ubase/uarg.cmo \ + ubase/uprintf.cmo ubase/util.cmo ubase/uarg.cmo \ ubase/prefs.cmo ubase/trace.cmo \ \ lwt/pqueue.cmo lwt/lwt.cmo lwt/lwt_util.cmo lwt/lwt_unix.cmo \ \ - unicode_tables.cmo unicode.cmo case.cmo pred.cmo uutil.cmo \ - fileutil.cmo name.cmo path.cmo fspath.cmo fingerprint.cmo \ + case.cmo pred.cmo uutil.cmo \ + fileutil.cmo name.cmo path.cmo fspath.cmo fs.cmo fingerprint.cmo \ abort.cmo osx.cmo external.cmo \ props.cmo fileinfo.cmo os.cmo lock.cmo clroot.cmo common.cmo \ tree.cmo checksum.cmo terminal.cmo \ Modified: trunk/src/RECENTNEWS =================================================================== --- trunk/src/RECENTNEWS 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/RECENTNEWS 2009-05-13 18:02:17 UTC (rev 331) @@ -1,5 +1,15 @@ CHANGES FROM VERSION 2.33.2 +* Added an abstraction layer over Unix/Sys modules in order to be able + to redefine all system calls involving filenames +* Implemented corresponding bindings for the Windows Unicode API + (not activated by default yet) +* Uses improved emulation of "select" call provided by Ocaml 3.11 + under Windows (the GUI should not freeze as much during synchronization) + +------------------------------- +CHANGES FROM VERSION 2.33.2 + * Fixed predicate matching in Unicode case-insensitive mode ------------------------------- Modified: trunk/src/case.mli =================================================================== --- trunk/src/case.mli 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/case.mli 2009-05-13 18:02:17 UTC (rev 331) @@ -1,6 +1,8 @@ (* Unison file synchronizer: src/case.mli *) (* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) +val unicodeEncoding : bool Prefs.t + type mode val ops : unit -> Modified: trunk/src/common.ml =================================================================== --- trunk/src/common.ml 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/common.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -38,8 +38,8 @@ let root2string root = match root with - (Local, fspath) -> Fspath.toString fspath - | (Remote host, fspath) -> "//"^host^"/"^(Fspath.toString fspath) + (Local, fspath) -> Fspath.toPrintString fspath + | (Remote host, fspath) -> "//"^host^"/"^(Fspath.toPrintString fspath) (* ------------------------------------------------------------------------- *) (* Root comparison *) @@ -50,7 +50,7 @@ (Local,fspath1), (Local,fspath2) -> (* FIX: This is a path comparison, should it take case sensitivity into account ? *) - compare (Fspath.toString fspath1) (Fspath.toString fspath2) + Fspath.compare fspath1 fspath2 | (Local,_), (Remote _,_) -> -1 | (Remote _,_), (Local,_) -> 1 | (Remote host1, fspath1), (Remote host2, fspath2) -> @@ -60,7 +60,7 @@ if result = 0 then (* FIX: This is a path comparison, should it take case sensitivity into account ? *) - compare (Fspath.toString fspath1) (Fspath.toString fspath2) + Fspath.compare fspath1 fspath2 else result Modified: trunk/src/copy.ml =================================================================== --- trunk/src/copy.ml 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/copy.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -24,30 +24,29 @@ let openFileIn fspath path kind = match kind with - `DATA -> open_in_gen [Open_rdonly; Open_binary] 0o444 - (Fspath.concatToString fspath path) + `DATA -> Fs.open_in_bin (Fspath.concat fspath path) | `RESS _ -> Osx.openRessIn fspath path let openFileOut fspath path kind = match kind with `DATA -> - let fullpath = Fspath.concatToString fspath path in + let fullpath = Fspath.concat fspath path in let flags = [Unix.O_WRONLY;Unix.O_CREAT] in let perm = 0o600 in begin match Util.osType with `Win32 -> - open_out_gen + Fs.open_out_gen [Open_wronly; Open_creat; Open_excl; Open_binary] perm fullpath | `Unix -> let fd = try - Unix.openfile fullpath (Unix.O_EXCL :: flags) perm + Fs.openfile fullpath (Unix.O_EXCL :: flags) perm with Unix.Unix_error ((Unix.EOPNOTSUPP | Unix.EUNKNOWNERR 524), _, _) -> (* O_EXCL not supported under a Netware NFS-mounted filesystem. Solaris and Linux report different errors. *) - Unix.openfile fullpath (Unix.O_TRUNC :: flags) perm + Fs.openfile fullpath (Unix.O_TRUNC :: flags) perm in Unix.out_channel_of_descr fd end @@ -83,8 +82,8 @@ use_id (fun id -> Uutil.showProgress id Uutil.Filesize.zero "l"); debug (fun () -> Util.msg "Copy.localFile %s / %s to %s / %s\n" - (Fspath.toString fspathFrom) (Path.toString pathFrom) - (Fspath.toString fspathTo) (Path.toString pathTo)); + (Fspath.toDebugString fspathFrom) (Path.toString pathFrom) + (Fspath.toDebugString fspathTo) (Path.toString pathTo)); let inFd = openFileIn fspathFrom pathFrom `DATA in protect (fun () -> Os.delete fspathTo pathTo; @@ -333,8 +332,8 @@ connFrom fspathFrom pathFrom fspathTo pathTo realPathTo update desc ressLength ressOnly id = debug (fun() -> Util.msg "reallyTransferFile(%s,%s) -> (%s,%s,%s,%s)%s\n" - (Fspath.toString fspathFrom) (Path.toString pathFrom) - (Fspath.toString fspathTo) (Path.toString pathTo) + (Fspath.toDebugString fspathFrom) (Path.toString pathFrom) + (Fspath.toDebugString fspathTo) (Path.toString pathTo) (Path.toString realPathTo) (Props.toString desc) (if ressOnly then " (ONLY RESOURCE FORK)" else "")); let srcFileSize = Props.length desc in @@ -347,7 +346,7 @@ (* Data fork *) if Os.exists fspathTo pathTo then begin debug (fun() -> Util.msg "Removing old temp file %s / %s\n" - (Fspath.toString fspathTo) (Path.toString pathTo)); + (Fspath.toDebugString fspathTo) (Path.toString pathTo)); Os.delete fspathTo pathTo end; startReceivingFile @@ -438,7 +437,7 @@ debug (fun () -> Util.msg "tryCopyMovedFile: found match at %s,%s. Try local copying\n" - (Fspath.toString candidateFspath) + (Fspath.toDebugString candidateFspath) (Path.toString candidatePath)); try if Os.exists candidateFspath candidatePath then begin @@ -562,25 +561,21 @@ Remote.registerRootCmdWithConnection "setFileinfo" setFileinfoLocal let targetExists checkSize fspathTo pathTo = - Os.exists fspathTo pathTo + let info = Fileinfo.get false fspathTo pathTo in + info.Fileinfo.typ = `FILE && (match checkSize with `MakeWriteableAndCheckNonempty -> - let n = Fspath.concatToString fspathTo pathTo in - let perms = (Unix.stat n).Unix.st_perm in + let n = Fspath.concat fspathTo pathTo in + let perms = Props.perms info.Fileinfo.desc in let perms' = perms lor 0o600 in - Unix.chmod n perms'; - let r = - Props.length (Fileinfo.get false fspathTo pathTo).Fileinfo.desc - > Uutil.Filesize.zero in - r + Fs.chmod n perms'; + Props.length info.Fileinfo.desc > Uutil.Filesize.zero | `CheckDataSize desc -> - Props.length (Fileinfo.get false fspathTo pathTo).Fileinfo.desc - = Props.length desc + Props.length info.Fileinfo.desc = Props.length desc | `CheckSize (desc,ress) -> - Props.length (Fileinfo.get false fspathTo pathTo).Fileinfo.desc - = Props.length desc - && Osx.ressLength (Osx.getFileInfos fspathTo pathTo `FILE).Osx.ressInfo - = Osx.ressLength ress) + Props.length info.Fileinfo.desc = Props.length desc + && Osx.ressLength info.Fileinfo.osX.Osx.ressInfo = + Osx.ressLength ress) let targetExistsLocal connFrom (checkSize, fspathTo, pathTo) = Lwt.return (targetExists checkSize fspathTo pathTo) @@ -629,16 +624,18 @@ let addquotes root s = match root with | Common.Local, _ -> s - | Common.Remote _, _ -> if extraquotes then Os.quotes s else s in + | Common.Remote _, _ -> if extraquotes then Uutil.quotes s else s in let fromSpec = (formatConnectionInfo rootFrom) - ^ (addquotes rootFrom (Fspath.concatToString (snd rootFrom) pathFrom)) in + ^ (addquotes rootFrom + (Fspath.toString (Fspath.concat (snd rootFrom) pathFrom))) in let toSpec = (formatConnectionInfo rootTo) - ^ (addquotes rootTo (Fspath.concatToString fspathTo pathTo)) in + ^ (addquotes rootTo + (Fspath.toString (Fspath.concat fspathTo pathTo))) in let cmd = prog ^ " " - ^ (Os.quotes fromSpec) ^ " " - ^ (Os.quotes toSpec) in + ^ (Uutil.quotes fromSpec) ^ " " + ^ (Uutil.quotes toSpec) in Trace.log (Printf.sprintf "%s\n" cmd); let _,log = External.runExternalProgram cmd in debug (fun() -> @@ -662,7 +659,7 @@ debug (fun() -> Util.msg "copyRegFile(%s,%s) -> (%s,%s,%s,%s,%s)\n" (Common.root2string rootFrom) (Path.toString pathFrom) (Common.root2string rootTo) (Path.toString realPathTo) - (Fspath.toString fspathTo) (Path.toString pathTo) + (Fspath.toDebugString fspathTo) (Path.toString pathTo) (Props.toString desc)); let timer = Trace.startTimer "Transmitting file" in begin match rootFrom, rootTo with @@ -679,7 +676,7 @@ if b then begin Trace.log (Printf.sprintf "%s/%s has already been transferred\n" - (Fspath.toString fspathTo) (Path.toString pathTo)); + (Fspath.toDebugString fspathTo) (Path.toString pathTo)); Lwt.return () (* Check whether we should use an external program to copy the file *) @@ -710,8 +707,8 @@ end else (* Just transfer the file in the usual way with Unison's built-in facilities *) - transferFile - rootFrom pathFrom rootTo fspathTo pathTo realPathTo + transferFile + rootFrom pathFrom rootTo fspathTo pathTo realPathTo update desc fp ress false id ) end >>= (fun () -> Trace.showTimer timer; Modified: trunk/src/fileinfo.ml =================================================================== --- trunk/src/fileinfo.ml 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/fileinfo.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -32,16 +32,16 @@ (* Stat function that pays attention to pref for following links *) let statFn fromRoot fspath path = let fullpath = Fspath.concat fspath path in - let stats = Fspath.lstat fullpath in + let stats = Fs.lstat fullpath in if stats.Unix.LargeFile.st_kind = Unix.S_LNK && fromRoot && Path.followLink path then - try Fspath.stat fullpath + try Fs.stat fullpath with Unix.Unix_error((Unix.ENOENT | Unix.ENOTDIR),_,_) -> raise (Util.Transient (Printf.sprintf "Path %s is marked 'follow' but its target is missing" - (Fspath.toString fullpath))) + (Fspath.toPrintString fullpath))) else stats @@ -52,7 +52,8 @@ try let stats = statFn fromRoot fspath path in debugV (fun () -> - Util.msg "%s: %b %f %f\n" (Fspath.concatToString fspath path) + Util.msg "%s: %b %f %f\n" + (Fspath.toDebugString (Fspath.concat fspath path)) fromRoot stats.Unix.LargeFile.st_ctime stats.Unix.LargeFile.st_mtime); let typ = match stats.Unix.LargeFile.st_kind with @@ -62,7 +63,7 @@ | _ -> raise (Util.Transient ("path " ^ - (Fspath.concatToString fspath path) ^ + (Fspath.toPrintString (Fspath.concat fspath path)) ^ " has unknown file type")) in let osxInfos = Osx.getFileInfos fspath path typ in @@ -82,7 +83,9 @@ osX = Osx.getFileInfos fspath path `ABSENT }) let check fspath path props = - Props.check fspath path (statFn false fspath path) props + Util.convertUnixErrorsToTransient + "checking file information" + (fun () -> Props.check fspath path (statFn false fspath path) props) let set fspath path action newDesc = let (kind, p) = @@ -159,3 +162,26 @@ (info', dataUnchanged, Osx.ressUnchanged info.osX.Osx.ressInfo info'.osX.Osx.ressInfo (Some t0) dataUnchanged) + +(****) + +let get' f = + Util.convertUnixErrorsToTransient + "querying file information" + (fun () -> + try + let stats = System.stat f in + let typ = `FILE in + let osxInfos = Osx.defaultInfos typ in + { typ = typ; + inode = stats.Unix.LargeFile.st_ino land 0x3FFFFFFF; + ctime = stats.Unix.LargeFile.st_ctime; + desc = Props.get stats osxInfos; + osX = osxInfos } + with + Unix.Unix_error((Unix.ENOENT | Unix.ENOTDIR),_,_) -> + { typ = `ABSENT; + inode = 0; + ctime = 0.0; + desc = Props.dummy; + osX = Osx.defaultInfos `ABSENT }) Modified: trunk/src/fileinfo.mli =================================================================== --- trunk/src/fileinfo.mli 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/fileinfo.mli 2009-05-13 18:02:17 UTC (rev 331) @@ -11,6 +11,7 @@ val set : Fspath.t -> Path.local -> [`Set of Props.t | `Copy of Path.local | `Update of Props.t] -> Props.t -> unit +val get' : System.fspath -> t (* IF THIS CHANGES, MAKE SURE TO INCREMENT THE ARCHIVE VERSION NUMBER! *) type stamp = Modified: trunk/src/files.ml =================================================================== --- trunk/src/files.ml 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/files.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -28,15 +28,15 @@ let commitLogName = Util.fileInHomeDir "DANGER.README" let writeCommitLog source target tempname = - let sourcename = Fspath.toString source in - let targetname = Fspath.toString target in + let sourcename = Fspath.toDebugString source in + let targetname = Fspath.toDebugString target in debug (fun() -> Util.msg "Writing commit log: renaming %s to %s via %s\n" sourcename targetname tempname); Util.convertUnixErrorsToFatal "writing commit log" (fun () -> let c = - open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_excl] + System.open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_excl] 0o600 commitLogName in Printf.fprintf c "Warning: the last run of %s terminated abnormally " Uutil.myName; @@ -50,16 +50,16 @@ debug (fun() -> (Util.msg "Deleting commit log\n")); Util.convertUnixErrorsToFatal "clearing commit log" - (fun () -> Unix.unlink commitLogName) + (fun () -> System.unlink commitLogName) let processCommitLog () = - if Sys.file_exists commitLogName then begin + if System.file_exists commitLogName then begin raise(Util.Fatal( Printf.sprintf "Warning: the previous run of %s terminated in a dangerous state. Please consult the file %s, delete it, and try again." Uutil.myName - commitLogName)) + (System.fspathToPrintString commitLogName))) end else Lwt.return () @@ -77,10 +77,10 @@ (* so we don't call the stasher in this case. *) begin match workingDirOpt with Some p -> - debug (fun () -> Util.msg "deleteLocal [%s] (%s, %s)\n" (Fspath.toString fspath) (Fspath.toString p) (Path.toString path)); + debug (fun () -> Util.msg "deleteLocal [%s] (%s, %s)\n" (Fspath.toDebugString fspath) (Fspath.toDebugString p) (Path.toString path)); Os.delete p path | None -> - debug (fun () -> Util.msg "deleteLocal [%s] (None, %s)\n" (Fspath.toString fspath) (Path.toString path)); + debug (fun () -> Util.msg "deleteLocal [%s] (None, %s)\n" (Fspath.toDebugString fspath) (Path.toString path)); Stasher.backup fspath path `AndRemove end; Lwt.return () @@ -162,13 +162,13 @@ debug (fun () -> Util.msg "Renaming %s to %s in %s; root is %s\n" (Path.toString pathFrom) (Path.toString pathTo) - (Fspath.toString fspath) - (Fspath.toString root)); + (Fspath.toDebugString fspath) + (Fspath.toDebugString root)); let source = Fspath.concat fspath pathFrom in let target = Fspath.concat fspath pathTo in Util.convertUnixErrorsToTransient (Printf.sprintf "renaming %s to %s" - (Fspath.toString source) (Fspath.toString target)) + (Fspath.toDebugString source) (Fspath.toDebugString target)) (fun () -> debugverbose (fun() -> Util.msg "calling Fileinfo.get from renameLocal\n"); @@ -178,7 +178,7 @@ Util.msg "back from Fileinfo.get from renameLocal\n"); if filetypeFrom = `ABSENT then raise (Util.Transient (Printf.sprintf "Error while renaming %s to %s -- source file has disappeared!" - (Fspath.toString source) (Fspath.toString target))); + (Fspath.toPrintString source) (Fspath.toPrintString target))); let filetypeTo = (Fileinfo.get false target Path.empty).Fileinfo.typ in @@ -199,9 +199,10 @@ debug (fun() -> Util.msg "rename: moveFirst=true\n"); let tmpPath = Os.tempPath fspath pathTo in let temp = Fspath.concat fspath tmpPath in - let temp' = Fspath.toString temp in + let temp' = Fspath.toDebugString temp in - debug (fun() -> Util.msg "moving %s to %s\n" (Fspath.toString target) temp'); + debug (fun() -> + Util.msg "moving %s to %s\n" (Fspath.toDebugString target) temp'); Stasher.backup root localTargetPath `ByCopying; writeCommitLog source target temp'; Util.finalize (fun() -> @@ -216,7 +217,8 @@ Util.convertUnixErrorsToFatal "renaming with commit log" (fun () -> debug (fun() -> Util.msg "rename %s to %s\n" - (Fspath.toString source) (Fspath.toString target)); + (Fspath.toDebugString source) + (Fspath.toDebugString target)); Os.rename "renameLocal(2)" source Path.empty target Path.empty)) (fun _ -> clearCommitLog()); @@ -231,7 +233,7 @@ if filetypeFrom = `FILE then Util.msg "Contents of %s after renaming = %s\n" - (Fspath.toString target) + (Fspath.toDebugString target) (Fingerprint.toString (Fingerprint.file target Path.empty))); end; Lwt.return ()) @@ -268,7 +270,7 @@ raise (Util.Transient (Printf.sprintf "The file %s\nhas been modified during synchronization. \ Transfer aborted." - (Fspath.concatToString currfspath path))); + (Fspath.toPrintString (Fspath.concat currfspath path)))); match archStamp with Fileinfo.InodeStamp inode when info.Fileinfo.inode = inode @@ -283,7 +285,7 @@ raise (Util.Transient (Printf.sprintf "The file %s\nhas been modified during synchronization. \ Transfer aborted.%s" - (Fspath.concatToString currfspath path) + (Fspath.toPrintString (Fspath.concat currfspath path)) (if Update.useFastChecking () && Props.same_time info.Fileinfo.desc archDesc then @@ -488,12 +490,12 @@ let cmd = if Util.findsubstring "CURRENT1" (Prefs.read diffCmd) = None then (Prefs.read diffCmd) - ^ " " ^ (Os.quotes (Fspath.toString fspath1)) - ^ " " ^ (Os.quotes (Fspath.toString fspath2)) + ^ " " ^ (Fspath.quotes fspath1) + ^ " " ^ (Fspath.quotes fspath2) else Util.replacesubstrings (Prefs.read diffCmd) - ["CURRENT1", Os.quotes (Fspath.toString fspath1); - "CURRENT2", Os.quotes (Fspath.toString fspath2)] in + ["CURRENT1", Fspath.quotes fspath1; + "CURRENT2", Fspath.quotes fspath2] in (* Doesn't seem to work well on Windows! let c = Lwt_unix.run (Lwt_unix.open_process_in cmd) in *) let c = Unix.open_process_in @@ -559,12 +561,12 @@ (* Taken from ocamltk/jpf/fileselect.ml *) let get_files_in_directory dir = - let dirh = Fspath.opendir (Fspath.canonize (Some dir)) in + let dirh = System.opendir dir in let files = ref [] in begin try - while true do files := Unix.readdir dirh :: !files done + while true do files := System.readdir dirh :: !files done with End_of_file -> - Unix.closedir dirh + System.closedir dirh end; Sort.list (<) !files @@ -750,12 +752,12 @@ let dig2 = Os.fingerprint workingDirForMerge working2 info2 in let cmd = formatMergeCmd path - (Os.quotes (Fspath.concatToString workingDirForMerge working1)) - (Os.quotes (Fspath.concatToString workingDirForMerge working2)) - (match arch with None -> None | Some f -> Some(Os.quotes (Fspath.toString f))) - (Os.quotes (Fspath.concatToString workingDirForMerge new1)) - (Os.quotes (Fspath.concatToString workingDirForMerge new2)) - (Os.quotes (Fspath.concatToString workingDirForMerge newarch)) in + (Fspath.quotes (Fspath.concat workingDirForMerge working1)) + (Fspath.quotes (Fspath.concat workingDirForMerge working2)) + (match arch with None -> None | Some f -> Some(Fspath.quotes f)) + (Fspath.quotes (Fspath.concat workingDirForMerge new1)) + (Fspath.quotes (Fspath.concat workingDirForMerge new2)) + (Fspath.quotes (Fspath.concat workingDirForMerge newarch)) in Trace.log (Printf.sprintf "Merge command: %s\n" cmd); let returnValue, mergeResultLog = External.runExternalProgram cmd in @@ -782,10 +784,10 @@ (* Check which files got created by the merge command and do something appropriate with them *) - debug (fun()-> Util.msg "New file 1 = %s\n" (Fspath.concatToString workingDirForMerge new1)); - let new1exists = Sys.file_exists (Fspath.concatToString workingDirForMerge new1) in - let new2exists = Sys.file_exists (Fspath.concatToString workingDirForMerge new2) in - let newarchexists = Sys.file_exists (Fspath.concatToString workingDirForMerge newarch) in + debug (fun()-> Util.msg "New file 1 = %s\n" (Fspath.toDebugString (Fspath.concat workingDirForMerge new1))); + let new1exists = Fs.file_exists (Fspath.concat workingDirForMerge new1) in + let new2exists = Fs.file_exists (Fspath.concat workingDirForMerge new2) in + let newarchexists = Fs.file_exists (Fspath.concat workingDirForMerge newarch) in if new1exists && new2exists then begin if newarchexists then @@ -828,8 +830,8 @@ else if (not new1exists) && (not new2exists) && (not newarchexists) then begin say (fun () -> Util.msg "No outputs detected \n"); - let working1_still_exists = Sys.file_exists (Fspath.concatToString workingDirForMerge working1) in - let working2_still_exists = Sys.file_exists (Fspath.concatToString workingDirForMerge working2) in + let working1_still_exists = Fs.file_exists (Fspath.concat workingDirForMerge working1) in + let working2_still_exists = Fs.file_exists (Fspath.concat workingDirForMerge working2) in if working1_still_exists && working2_still_exists then begin say (fun () -> Util.msg "No output from merge cmd and both original files are still present\n"); @@ -893,7 +895,7 @@ copyBack workingDirForMerge working1 root1 path desc1 ui1 id >>= (fun () -> copyBack workingDirForMerge working2 root2 path desc2 ui2 id >>= (fun () -> let arch_fspath = Fspath.concat workingDirForMerge workingarch in - if (Sys.file_exists (Fspath.toString arch_fspath)) then begin + if Fs.file_exists arch_fspath then begin debug (fun () -> Util.msg "Updating unison archives for %s to reflect results of merge\n" (Path.toString path)); if not (Stasher.shouldBackupCurrent path) then @@ -904,7 +906,7 @@ debug (fun () -> Util.msg "New digest is %s\n" (Os.fullfingerprint_to_string dig)); let new_archive_entry = Update.ArchiveFile - (Props.get (Fspath.stat arch_fspath) infoarch.osX, dig, + (Props.get (Fs.stat arch_fspath) infoarch.osX, dig, Fileinfo.stamp (Fileinfo.get true arch_fspath Path.empty), Osx.stamp infoarch.osX) in Update.transaction Modified: trunk/src/files.mli =================================================================== --- trunk/src/files.mli 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/files.mli 2009-05-13 18:02:17 UTC (rev 331) @@ -63,12 +63,9 @@ (* terminated) synchronizations *) val processCommitLogs : unit -> unit -(* List the files in a directory matching a pattern. (It would be better - to use fspath, etc., here instead of string) *) -val ls : string -> string -> string list +(* List the files in a directory matching a pattern. *) +val ls : System.fspath -> string -> string list -val get_files_in_directory : string -> string list - val merge : Common.root (* first root *) -> Common.root (* second root *) Modified: trunk/src/fingerprint.ml =================================================================== --- trunk/src/fingerprint.ml 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/fingerprint.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -23,20 +23,21 @@ (* Assumes that (fspath, path) is a file and gives its ``digest '', that is *) (* a short string of cryptographic quality representing it. *) let file fspath path = - let f = Fspath.toString (Fspath.concat fspath path) in + let f = Fspath.concat fspath path in Util.convertUnixErrorsToTransient - ("digesting " ^ f) - (fun () -> Digest.file f) + ("digesting " ^ Fspath.toPrintString f) + (fun () -> Fs.digestFile f) let maxLength = Uutil.Filesize.ofInt max_int let subfile path offset len = if len > maxLength then raise (Util.Transient - (Format.sprintf "File '%s' too big for fingerprinting" path)); + (Format.sprintf "File '%s' too big for fingerprinting" + (Fspath.toPrintString path))); Util.convertUnixErrorsToTransient "digesting subfile" (fun () -> - let inch = open_in_bin path in + let inch = Fs.open_in_bin path in begin try LargeFile.seek_in inch offset; let res = Digest.channel inch (Uutil.Filesize.toInt len) in @@ -47,7 +48,8 @@ close_in_noerr inch; raise (Util.Transient (Format.sprintf - "Error in digesting subfile '%s': truncated file" path)) + "Error in digesting subfile '%s': truncated file" + (Fspath.toPrintString path))) | e -> close_in_noerr inch; raise e Modified: trunk/src/fingerprint.mli =================================================================== --- trunk/src/fingerprint.mli 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/fingerprint.mli 2009-05-13 18:02:17 UTC (rev 331) @@ -5,7 +5,7 @@ (* Os.safeFingerprint should usually be used rather than these functions *) val file : Fspath.t -> Path.local -> t -val subfile : string -> Int64.t -> Uutil.Filesize.t -> t +val subfile : Fspath.t -> Int64.t -> Uutil.Filesize.t -> t val string : string -> t Added: trunk/src/fs.ml =================================================================== --- trunk/src/fs.ml (rev 0) +++ trunk/src/fs.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -0,0 +1,83 @@ +(* Unison file synchronizer: src/fs.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + +type fspath = Fspath.t +type dir_handle = System.dir_handle + +let symlink l f = System.symlink l (Fspath.toSysPath f) + +let readlink f = System.readlink (Fspath.toSysPath f) + +let chown f usr grp = System.chown (Fspath.toSysPath f) usr grp + +let chmod f mode = System.chmod (Fspath.toSysPath f) mode + +let utimes f t1 t2 = System.utimes (Fspath.toSysPath f) t1 t2 + +let unlink f = System.unlink (Fspath.toSysPath f) + +let rmdir f = System.rmdir (Fspath.toSysPath f) + +let mkdir f mode = System.mkdir (Fspath.toSysPath f) mode + +let rename f f' = System.rename (Fspath.toSysPath f) (Fspath.toSysPath f') + +let stat f = System.stat (Fspath.toSysPath f) + +let lstat f = System.lstat (Fspath.toSysPath f) + +let openfile f flags perms = System.openfile (Fspath.toSysPath f) flags perms + +let opendir f = System.opendir (Fspath.toSysPath f) + +let readdir = System.readdir + +let closedir = System.closedir + +let open_in_gen flags mode f = + System.open_in_gen flags mode (Fspath.toSysPath f) + +let open_out_gen flags mode f = + System.open_out_gen flags mode (Fspath.toSysPath f) + +(****) + +let open_in_bin f = open_in_gen [Open_rdonly; Open_binary] 0 f + +let file_exists f = + try + ignore (stat f); true + with Unix.Unix_error ((Unix.ENOENT | Unix.ENOTDIR), _, _) -> + false + +(****) + +let digestFile f = + let ic = open_in_bin f in + let d = Digest.channel ic (-1) in + close_in ic; + d + +let canSetTime f = + Util.osType <> `Win32 || + try + Unix.access (System.fspathToString (Fspath.toSysPath f)) [Unix.W_OK]; + true + with + Unix.Unix_error _ -> false + +let useUnicodeEncoding _ = () Added: trunk/src/fs.mli =================================================================== --- trunk/src/fs.mli (rev 0) +++ trunk/src/fs.mli 2009-05-13 18:02:17 UTC (rev 331) @@ -0,0 +1,11 @@ +(* Unison file synchronizer: src/fs.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +(* Operations on fspaths *) + +include System_intf.Core with type fspath = Fspath.t + +val digestFile : Fspath.t -> string +val canSetTime : Fspath.t -> bool + +val useUnicodeEncoding : bool -> unit Modified: trunk/src/fspath.ml =================================================================== --- trunk/src/fspath.ml 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/fspath.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -28,12 +28,21 @@ (* All fspaths are absolute *) (* - *) +module Fs = struct + let getcwd = System.getcwd + let chdir = System.chdir + let readlink = System.readlink +end + let debug = Util.debug "fspath" -let debugverbose = Util.debug "fspath+" +let debugverbose = Util.debug "fsspath+" type t = Fspath of string let toString (Fspath f) = f +let toPrintString (Fspath f) = f +let toDebugString (Fspath f) = String.escaped f +let toSysPath (Fspath f) = System.fspathFromString f (* Needed to hack around some ocaml/Windows bugs, see comment at stat, below *) let winRootRx = Rx.rx "(([a-zA-Z]:)?/|//[^/]+/[^/]+/)" @@ -84,13 +93,19 @@ let appleDouble (Fspath f) = if isRootDir f then raise(Invalid_argument "Fspath.appleDouble") else let len = String.length f in - let i = String.rindex f '/' in - let before = String.sub f 0 i in - let after = String.sub f (i+1) (len-i-1) in - Fspath(before^"/._"^after) + try + let i = 1 + String.rindex f '/' in + let res = String.create (len + 2) in + String.blit f 0 res 0 i; + res.[i] <- '.'; + res.[i + 1] <- '_'; + String.blit f i res (i + 2) (len - i); + Fspath res + with Not_found -> + assert false let rsrc (Fspath f) = - if isRootDir f then raise(Invalid_argument "Fspath.appleDouble") else + if isRootDir f then raise(Invalid_argument "Fspath.rsrc") else Fspath(f^"/..namedfork/rsrc") (* WRAPPED SYSTEM CALLS *) @@ -131,10 +146,9 @@ Unix.LargeFile.stat "c://" will fail. (The Unix version of ocaml handles either a trailing slash or no trailing slash.) + +Invariant on fspath will guarantee that argument is OK for stat *) -(* Invariant on fspath will guarantee that argument is OK for stat *) -let stat (Fspath f) = Unix.LargeFile.stat f -let lstat (Fspath f) = Unix.LargeFile.lstat f (* HACK: Under Windows 98, @@ -148,13 +162,14 @@ Unix.opendir "c:" works as well, but, this refers to the current working directory AFAIK. -*) + let opendir (Fspath d) = if Util.osType<>`Win32 || not(isRootDir d) then Unix.opendir d else try Unix.opendir d with Unix.Unix_error _ -> Unix.opendir (d^"*") +*) let child (Fspath f) n = (* Note, f is not "" by invariants on Fspath *) @@ -225,16 +240,18 @@ (* Filename, and Sys modules of ocaml have subtle differences under Windows *) (* and Unix. So, be very careful with any changes !!! *) let canonizeFspath p0 = - let p = match p0 with None -> "." | Some "" -> "." | Some s -> s in + let p = + System.fspathFromString + (match p0 with None -> "." | Some "" -> "." | Some s -> s) in let p' = begin - let original = Sys.getcwd() in + let original = Fs.getcwd() in try let newp = - (Sys.chdir p; (* This might raise Sys_error *) - Sys.getcwd()) in - Sys.chdir original; - newp + (Fs.chdir p; (* This might raise Sys_error *) + Fs.getcwd()) in + Fs.chdir original; + System.fspathToString newp with Sys_error why -> (* We could not chdir to p. Either *) @@ -247,18 +264,19 @@ (* fails, we just quit. This works nicely for most cases of (1), *) (* it works for (2), and on (3) it may leave a mess for someone *) (* else to pick up. *) + let p = System.fspathToString p in let p = if Util.osType = `Win32 then Fileutil.backslashes2forwardslashes p else p in if isRootDir p then raise (Util.Fatal (Printf.sprintf "Cannot find canonical name of root directory %s\n(%s)" p why)); let parent = myDirname p in let parent' = begin - (try Sys.chdir parent with + (try Fs.chdir (System.fspathFromString parent) with Sys_error why2 -> raise (Util.Fatal (Printf.sprintf "Cannot find canonical name of %s: unable to cd either to it\n (%s)\nor to its parent %s\n(%s)" p why parent why2))); - Sys.getcwd() end in - Sys.chdir original; + System.fspathToString (Fs.getcwd()) end in + Fs.chdir original; let bn = Filename.basename p in if bn="" then parent' else toString(child (localString2fspath parent') @@ -287,31 +305,32 @@ let canonize x = Util.convertUnixErrorsToFatal "canonizing path" (fun () -> canonizeFspath x) -let concatToString fspath path = toString (concat fspath path) - let maxlinks = 100 let findWorkingDir fspath path = - let abspath = concatToString fspath path in + let abspath = toSysPath (concat fspath path) in let realpath = if not (Path.followLink path) then abspath else let rec followlinks n p = if n>=maxlinks then raise (Util.Transient (Printf.sprintf - "Too many symbolic links from %s" abspath)); + "Too many symbolic links from %s" + (System.fspathToPrintString abspath))); try - let link = Unix.readlink p in + let link = Fs.readlink p in let linkabs = if Filename.is_relative link then - Filename.concat (Filename.dirname p) link - else link in + System.fspathConcat (System.fspathDirname p) link + else System.fspathFromString link in followlinks (n+1) linkabs with Unix.Unix_error _ -> p in followlinks 0 abspath in + let realpath = System.fspathToString realpath in if isRootDir realpath then raise (Util.Transient(Printf.sprintf - "The path %s is a root directory" abspath)); + "The path %s is a root directory" + (System.fspathToPrintString abspath))); let realpath = Fileutil.removeTrailingSlashes realpath in let p = Filename.basename realpath in debug @@ -322,3 +341,7 @@ (myDirname realpath) p); (localString2fspath (myDirname realpath), Path.fromString p) + +let quotes (Fspath f) = Uutil.quotes f +let compare (Fspath f1) (Fspath f2) = compare f1 f2 +let hash (Fspath f) = Hashtbl.hash f Modified: trunk/src/fspath.mli =================================================================== --- trunk/src/fspath.mli 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/fspath.mli 2009-05-13 18:02:17 UTC (rev 331) @@ -10,7 +10,9 @@ val canonize : string option -> t val toString : t -> string -val concatToString : t -> Path.local -> string +val toPrintString : t -> string +val toDebugString : t -> string +val toSysPath : t -> System.fspath (* If fspath+path refers to a (followed) symlink, then return the directory *) (* of the symlink's target; otherwise return the parent dir of path. If *) @@ -26,8 +28,10 @@ (* Return the resource fork filename; if root dir, raise Invalid_argument *) val rsrc : t -> t -(* Wrapped system calls that use invariants of the fspath internal rep *) -(* BE SURE TO USE ONLY THESE, NOT VERSIONS FROM THE UNIX MODULE! *) -val stat : t -> Unix.LargeFile.stats -val lstat : t -> Unix.LargeFile.stats -val opendir : t -> Unix.dir_handle +(* Escaped fspath (to pass as shell parameter) *) +val quotes : t -> string + +(* CASE-SENSITIVE comparison between fspaths *) +val compare : t -> t -> int +(* CASE-SENSITIVE hash of a fspath *) +val hash : t -> int Deleted: trunk/src/linktk.ml =================================================================== --- trunk/src/linktk.ml 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/linktk.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -1,19 +0,0 @@ -(* Unison file synchronizer: src/linktk.ml *) -(* Copyright 1999-2009, Benjamin C. Pierce - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . -*) - - -module TopLevel = Main.Body(Uitk.Body) Modified: trunk/src/lock.ml =================================================================== --- trunk/src/lock.ml 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/lock.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -17,23 +17,23 @@ let rename oldFile newFile = - begin try Unix.link oldFile newFile with Unix.Unix_error _ -> () end; - let res = try (Unix.LargeFile.stat oldFile).Unix.LargeFile.st_nlink = 2 + begin try System.link oldFile newFile with Unix.Unix_error _ -> () end; + let res = try (System.stat oldFile).Unix.LargeFile.st_nlink = 2 with Unix.Unix_error _ -> false in - Unix.unlink oldFile; + System.unlink oldFile; res let flags = [Unix.O_WRONLY; Unix.O_CREAT; Unix.O_EXCL] let create name mode = try - Unix.close (Unix.openfile name flags mode); + Unix.close (System.openfile name flags mode); true with Unix.Unix_error (Unix.EEXIST, _, _) -> false let rec unique name i mode = - let nm = name ^ string_of_int i in + let nm = System.fspathAddSuffixToFinalName name (string_of_int i) in if create nm mode then nm else (* highly unlikely *) unique name (i + 1) mode @@ -48,9 +48,9 @@ | _ -> create name 0o600) -let release name = try Unix.unlink name with Unix.Unix_error _ -> () +let release name = try System.unlink name with Unix.Unix_error _ -> () let is_locked name = Util.convertUnixErrorsToTransient "Lock.test" - (fun () -> Sys.file_exists name) + (fun () -> System.file_exists name) Modified: trunk/src/lock.mli =================================================================== --- trunk/src/lock.mli 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/lock.mli 2009-05-13 18:02:17 UTC (rev 331) @@ -4,6 +4,6 @@ (* A simple utility module for setting and releasing inter-process locks using entries in the filesystem. *) -val acquire : string -> bool -val release : string -> unit -val is_locked : string -> bool +val acquire : System.fspath -> bool +val release : System.fspath -> unit +val is_locked : System.fspath -> bool Modified: trunk/src/lwt/lwt_unix.ml =================================================================== --- trunk/src/lwt/lwt_unix.ml 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/lwt/lwt_unix.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -14,6 +14,9 @@ - [connect] is blocking *) let windows_hack = Sys.os_type <> "Unix" +let recent_ocaml = + Scanf.sscanf Sys.ocaml_version "%d.%d" + (fun maj min -> (maj = 3 && min >= 11) || maj > 3) module SleepQueue = Pqueue.Make (struct @@ -112,7 +115,7 @@ let infds = List.map fst !inputs in let outfds = List.map fst !outputs in let (readers, writers, _) = - if windows_hack then + if windows_hack && not recent_ocaml then let writers = outfds in let readers = if delay = 0. || writers <> [] then [] else infds in Modified: trunk/src/main.ml =================================================================== --- trunk/src/main.ml 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/main.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -186,7 +186,7 @@ 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 -> Fspath.toString (Os.fileInUnisonDir(n))); + (fun n -> Os.fileInUnisonDir(n)); (* Start a server if requested *) if Util.StringMap.mem serverPrefName argv then begin Modified: trunk/src/mkProjectInfo.ml =================================================================== --- trunk/src/mkProjectInfo.ml 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/mkProjectInfo.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -147,3 +147,4 @@ + Modified: trunk/src/os.ml =================================================================== --- trunk/src/os.ml 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/os.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -22,7 +22,7 @@ let debug = Util.debug "os" let myCanonicalHostName = - try Unix.getenv "UNISONLOCALHOSTNAME" + try System.getenv "UNISONLOCALHOSTNAME" with Not_found -> Unix.gethostname() let tempFilePrefix = ".unison." @@ -43,22 +43,7 @@ xferDelete := del; xferRename := ren - (*****************************************************************************) -(* ESCAPING SHELL PARAMETERS *) -(*****************************************************************************) - -(* Using single quotes is simpler under Unix but they are not accepted - by the Windows shell. Double quotes without further quoting is - sufficient with Windows as filenames are not allowed to contain - double quotes. *) -let quotes s = - if Util.osType = `Win32 && not Util.isCygwin then - "\"" ^ s ^ "\"" - else - "'" ^ Util.replacesubstring s "'" "'\\''" ^ "'" - -(*****************************************************************************) (* QUERYING THE FILESYSTEM *) (*****************************************************************************) @@ -69,8 +54,8 @@ Util.convertUnixErrorsToTransient "reading symbolic link" (fun () -> - let abspath = Fspath.concatToString fspath path in - Unix.readlink abspath) + let abspath = Fspath.concat fspath path in + Fs.readlink abspath) let rec isAppleDoubleFile file = Prefs.read Osx.rsrc && @@ -83,7 +68,7 @@ "scanning directory" (fun () -> let rec loop children directory = - let newFile = try Unix.readdir directory with End_of_file -> "" in + let newFile = try Fs.readdir directory with End_of_file -> "" in if newFile = "" then children else let newChildren = if newFile = "." || newFile = ".." then @@ -95,7 +80,7 @@ let absolutePath = Fspath.concat fspath path in let directory = try - Some (Fspath.opendir absolutePath) + Some (Fs.opendir absolutePath) with Unix.Unix_error (Unix.ENOENT, _, _) -> (* FIX (in Ocaml): under Windows, when a directory is empty (not even "." and ".."), FindFirstFile fails with @@ -107,11 +92,11 @@ Some directory -> begin try let result = loop [] directory in - Unix.closedir directory; + Fs.closedir directory; result with Unix.Unix_error _ as e -> begin try - Unix.closedir directory + Fs.closedir directory with Unix.Unix_error _ -> () end; raise e end @@ -143,12 +128,12 @@ if Props.time i.Fileinfo.desc +. secondsinthirtydays < Util.time() then begin debug (fun()-> Util.msg "deleting old temp file %s\n" - (Fspath.concatToString fspath p)); + (Fspath.toDebugString (Fspath.concat fspath p))); delete fspath p end else debug (fun()-> Util.msg "keeping temp file %s since it is less than 30 days old\n" - (Fspath.concatToString fspath p)); + (Fspath.toDebugString (Fspath.concat fspath p))); end; false end else @@ -164,55 +149,55 @@ Util.convertUnixErrorsToTransient "deleting" (fun () -> - let absolutePath = Fspath.concatToString fspath path in + let absolutePath = Fspath.concat fspath path in match (Fileinfo.get false fspath path).Fileinfo.typ with `DIRECTORY -> begin try - Unix.chmod absolutePath 0o700 + Fs.chmod absolutePath 0o700 with Unix.Unix_error _ -> () end; Safelist.iter (fun child -> delete fspath (Path.child path child)) (allChildrenOf fspath path); (!xferDelete) (fspath, path); - Unix.rmdir absolutePath + Fs.rmdir absolutePath | `FILE -> if Util.osType <> `Unix then begin try - Unix.chmod absolutePath 0o600; + Fs.chmod absolutePath 0o600; with Unix.Unix_error _ -> () end; (!xferDelete) (fspath, path); - Unix.unlink absolutePath; + Fs.unlink absolutePath; if Prefs.read Osx.rsrc then begin - let pathDouble = Osx.appleDoubleFile fspath path in - if Sys.file_exists pathDouble then - Unix.unlink pathDouble + let pathDouble = Fspath.appleDouble absolutePath in + if Fs.file_exists pathDouble then + Fs.unlink pathDouble end | `SYMLINK -> (* Note that chmod would not do the right thing on links *) - Unix.unlink absolutePath + Fs.unlink absolutePath | `ABSENT -> ()) let rename fname sourcefspath sourcepath targetfspath targetpath = let source = Fspath.concat sourcefspath sourcepath in - let source' = Fspath.toString source in + let source' = Fspath.toPrintString source in let target = Fspath.concat targetfspath targetpath in - let target' = Fspath.toString target in - if source' = target' then + let target' = Fspath.toPrintString target in + if source = target then raise (Util.Transient ("Rename ("^fname^"): identical source and target " ^ source')); Util.convertUnixErrorsToTransient ("renaming " ^ source' ^ " to " ^ target') (fun () -> debug (fun() -> Util.msg "rename %s to %s\n" source' target'); (!xferRename) (sourcefspath, sourcepath) (targetfspath, targetpath); - Unix.rename source' target'; + Fs.rename source target; if Prefs.read Osx.rsrc then begin - let sourceDouble = Osx.appleDoubleFile sourcefspath sourcepath in - let targetDouble = Osx.appleDoubleFile targetfspath targetpath in - if Sys.file_exists sourceDouble then - Unix.rename sourceDouble targetDouble - else if Sys.file_exists targetDouble then - Unix.unlink targetDouble + let sourceDouble = Fspath.appleDouble source in + let targetDouble = Fspath.appleDouble target in + if Fs.file_exists sourceDouble then + Fs.rename sourceDouble targetDouble + else if Fs.file_exists targetDouble then + Fs.unlink targetDouble end) let symlink = @@ -221,8 +206,8 @@ Util.convertUnixErrorsToTransient "writing symbolic link" (fun () -> - let abspath = Fspath.concatToString fspath path in - Unix.symlink l abspath) + let abspath = Fspath.concat fspath path in + Fs.symlink l abspath) else fun fspath path l -> raise (Util.Transient "symlink not supported under Win32") @@ -232,8 +217,8 @@ Util.convertUnixErrorsToTransient "creating directory" (fun () -> - let absolutePath = Fspath.concatToString fspath path in - Unix.mkdir absolutePath (Props.perms props)) + let absolutePath = Fspath.concat fspath path in + Fs.mkdir absolutePath (Props.perms props)) (*****************************************************************************) (* FINGERPRINTS *) @@ -254,7 +239,7 @@ (Printf.sprintf "Failed to fingerprint file \"%s\": \ the file keeps on changing" - (Fspath.concatToString fspath path))) + (Fspath.toPrintString (Fspath.concat fspath path)))) else let dig = match optDig with @@ -296,35 +281,35 @@ (* Gives the fspath of the archive directory on the machine, depending on *) (* which OS we use *) let unisonDir = - try Fspath.canonize (Some (Unix.getenv "UNISON")) + try + System.fspathFromString (System.getenv "UNISON") with Not_found -> - let genericName = Util.fileInHomeDir (Printf.sprintf ".%s" Uutil.myName) in - if Osx.isMacOSX then - let osxName = Util.fileInHomeDir "Library/Application Support/Unison" in - if Sys.file_exists genericName then Fspath.canonize (Some genericName) - else Fspath.canonize (Some osxName) + 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 - Fspath.canonize (Some genericName) + genericName (* build a fspath representing an archive child path whose name is given *) let fileInUnisonDir str = - let n = - try Name.fromString str - with Invalid_argument _ -> - raise (Util.Transient - ("Ill-formed name of file in UNISON directory: "^str)) - in - Fspath.child unisonDir n + begin try + ignore (Name.fromString str) + with Invalid_argument _ -> + raise (Util.Transient + ("Ill-formed name of file in UNISON directory: "^str)) + end; + System.fspathConcat unisonDir str (* Make sure archive directory exists *) let createUnisonDir() = - try ignore (Fspath.stat unisonDir) + try ignore (System.stat unisonDir) with Unix.Unix_error(_) -> Util.convertUnixErrorsToFatal (Printf.sprintf "creating unison directory %s" - (Fspath.toString unisonDir)) + (System.fspathToPrintString unisonDir)) (fun () -> - ignore (Unix.mkdir (Fspath.toString unisonDir) 0o700)) + ignore (System.mkdir unisonDir 0o700)) (*****************************************************************************) (* TEMPORARY FILES *) Modified: trunk/src/os.mli =================================================================== --- trunk/src/os.mli 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/os.mli 2009-05-13 18:02:17 UTC (rev 331) @@ -10,8 +10,8 @@ val exists : Fspath.t -> Path.local -> bool val createUnisonDir : unit -> unit -val fileInUnisonDir : string -> Fspath.t -val unisonDir : Fspath.t +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 @@ -54,5 +54,3 @@ (Fspath.t * Path.local -> unit) -> ((Fspath.t * Path.local) -> (Fspath.t * Path.local) -> unit) -> unit - -val quotes : string -> string Modified: trunk/src/osx.ml =================================================================== --- trunk/src/osx.ml 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/osx.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -48,20 +48,6 @@ (****) -let appleDoubleFile fspath path = - let f = Fspath.concatToString fspath path in - let len = String.length f in - try - let i = 1 + String.rindex f '/' in - let res = String.create (len + 2) in - String.blit f 0 res 0 i; - res.[i] <- '.'; - res.[i + 1] <- '_'; - String.blit f i res (i + 2) (len - i); - res - with Not_found -> - assert false - let doubleMagic = "\000\005\022\007" let doubleVersion = "\000\002\000\000" let doubleFiller = String.make 16 '\000' @@ -96,7 +82,8 @@ let fail path msg = raise (Util.Transient - (Format.sprintf "Malformed AppleDouble file '%s' (%s)" path msg)) + (Format.sprintf "Malformed AppleDouble file '%s' (%s)" + (Fspath.toPrintString path) msg)) let readDouble path inch len = let buf = String.create len in @@ -123,8 +110,8 @@ raise e let openDouble fspath path = - let path = appleDoubleFile fspath path in - let inch = try open_in_bin path with Sys_error _ -> raise Not_found in + let path = Fspath.appleDouble (Fspath.concat fspath path) in + let inch = try Fs.open_in_bin path with Sys_error _ -> raise Not_found in protect (fun () -> Util.convertUnixErrorsToTransient "opening AppleDouble file" (fun () -> let header = readDouble path inch 26 in @@ -166,12 +153,13 @@ ino mtime ctime (Uutil.Filesize.toString len) type info = - { ressInfo : (string * int64) ressInfo; + { ressInfo : (Fspath.t * int64) ressInfo; finfo : string } external getFileInfosInternal : - string -> bool -> string * int64 = "getFileInfos" -external setFileInfosInternal : string -> string -> unit = "setFileInfos" + System.fspath -> bool -> string * int64 = "getFileInfos" +external setFileInfosInternal : + System.fspath -> string -> unit = "setFileInfos" let defaultInfos typ = match typ with @@ -216,7 +204,7 @@ try let (fInfo, rsrcLength) = getFileInfosInternal - (Fspath.concatToString fspath path) (typ = `FILE) in + (Fspath.toSysPath (Fspath.concat fspath path)) (typ = `FILE) in { ressInfo = if rsrcLength = 0L then NoRess else HfsRess (Uutil.Filesize.ofInt64 rsrcLength); @@ -242,7 +230,7 @@ "") (fun () -> close_in_noerr inch) in - let stats = Unix.LargeFile.stat doublePath in + let stats = Fs.stat doublePath in { ressInfo = if rsrcLength = 0L then NoRess else AppleDoubleRess @@ -286,10 +274,9 @@ assert (finfo <> ""); Util.convertUnixErrorsToTransient "setting file informations" (fun () -> try - let (fullFinfo, _) = - getFileInfosInternal (Fspath.concatToString fspath path) false in - setFileInfosInternal (Fspath.concatToString fspath path) - (insertInfo fullFinfo finfo) + let p = Fspath.toSysPath (Fspath.concat fspath path) in + let (fullFinfo, _) = getFileInfosInternal p false in + setFileInfosInternal p (insertInfo fullFinfo finfo) with Unix.Unix_error ((Unix.EOPNOTSUPP | Unix.ENOSYS), _, _) -> (* Not an HFS volume. Look for an AppleDouble file *) let (fspath, path) = Fspath.findWorkingDir fspath path in @@ -307,7 +294,7 @@ (fun () -> close_in_noerr inch) in let outch = - open_out_gen [Open_wronly; Open_binary] 0o600 doublePath in + Fs.open_out_gen [Open_wronly; Open_binary] 0o600 doublePath in protect (fun () -> writeDoubleFromOffset doublePath outch ofs @@ -321,14 +308,14 @@ (Format.sprintf "Unable to set the file type and creator: \n\ The AppleDouble file '%s' has no fileinfo entry." - doublePath)) + (Fspath.toPrintString doublePath))) end with Not_found -> (* No AppleDouble file, create one if needed. *) if finfo <> "F" && finfo <> "D" then begin - let path = appleDoubleFile fspath path in + let path = Fspath.appleDouble (Fspath.concat fspath path) in let outch = - open_out_gen + Fs.open_out_gen [Open_wronly; Open_creat; Open_excl; Open_binary] 0o600 path in protect (fun () -> @@ -403,8 +390,8 @@ Util.convertUnixErrorsToTransient "reading resource fork" (fun () -> try Unix.in_channel_of_descr - (Unix.openfile - (Fspath.concatToString fspath (ressPath path)) + (Fs.openfile + (Fspath.concat fspath (ressPath path)) [Unix.O_RDONLY] 0o444) with Unix.Unix_error ((Unix.ENOENT | Unix.ENOTDIR), _, _) -> let (doublePath, inch, entries) = openDouble fspath path in @@ -421,13 +408,13 @@ Util.convertUnixErrorsToTransient "writing resource fork" (fun () -> try Unix.out_channel_of_descr - (Unix.openfile - (Fspath.concatToString fspath (ressPath path)) + (Fs.openfile + (Fspath.concat fspath (ressPath path)) [Unix.O_WRONLY;Unix.O_TRUNC] 0o600) with Unix.Unix_error ((Unix.ENOENT | Unix.ENOTDIR), _, _) -> - let path = appleDoubleFile fspath path in + let path = Fspath.appleDouble (Fspath.concat fspath path) in let outch = - open_out_gen + Fs.open_out_gen [Open_wronly; Open_creat; Open_excl; Open_binary] 0o600 path in protect (fun () -> Modified: trunk/src/osx.mli =================================================================== --- trunk/src/osx.mli 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/osx.mli 2009-05-13 18:02:17 UTC (rev 331) @@ -9,9 +9,11 @@ type 'a ressInfo type ressStamp = unit ressInfo type info = - { ressInfo : (string * int64) ressInfo; + { ressInfo : (Fspath.t * int64) ressInfo; finfo : string } +val defaultInfos : [> `DIRECTORY | `FILE ] -> info + val getFileInfos : Fspath.t -> Path.local -> [> `DIRECTORY | `FILE ] -> info val setFileInfos : Fspath.t -> Path.local -> string -> unit @@ -26,7 +28,5 @@ val stamp : info -> ressStamp -val appleDoubleFile : Fspath.t -> Path.local -> string - val openRessIn : Fspath.t -> Path.local -> in_channel val openRessOut : Fspath.t -> Path.local -> Uutil.Filesize.t -> out_channel Modified: trunk/src/props.ml =================================================================== --- trunk/src/props.ml 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/props.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -199,13 +199,13 @@ Util.convertUnixErrorsToTransient "setting permissions" (fun () -> - let abspath = Fspath.concatToString fspath path in + let abspath = Fspath.concat fspath path in debug (fun() -> Util.msg "Setting permissions for %s to %s (%s)\n" - abspath (toString (fileperm2perm fp)) + (Fspath.toDebugString abspath) (toString (fileperm2perm fp)) (Printf.sprintf "%o/%o" fp mask)); - Unix.chmod abspath fp) + Fs.chmod abspath fp) let get stats _ = (stats.Unix.LargeFile.st_perm, Prefs.read permMask) @@ -220,7 +220,7 @@ The filesystem probably does not support all permission bits. \ You should probably set the \"perms\" option to 0o%o \ (or to 0 if you don't need to synchronize permissions)." - (Fspath.concatToString fspath path) + (Fspath.toPrintString (Fspath.concat fspath path)) (syncedPartsToString (fp, mask)) (syncedPartsToString (fp', mask)) (mask land (lnot (fp lxor fp'))))) @@ -261,7 +261,7 @@ val to_num : string -> int val toString : int -> string val syncedPartsToString : int -> string - val set : string -> int -> unit + val set : Fspath.t -> int -> unit val get : Unix.LargeFile.stats -> int end) : S = struct @@ -328,7 +328,7 @@ Util.convertUnixErrorsToTransient "setting file ownership" (fun () -> - let abspath = Fspath.concatToString fspath path in + let abspath = Fspath.concat fspath path in M.set abspath id) let tbl = Hashtbl.create 17 @@ -366,7 +366,7 @@ let toString id = (Unix.getpwuid id).Unix.pw_name let syncedPartsToString = toString -let set path id = Unix.chown path id (-1) +let set path id = Fs.chown path id (-1) let get stats = stats.Unix.LargeFile.st_uid end) @@ -387,7 +387,7 @@ let toString id = (Unix.getgrgid id).Unix.gr_name let syncedPartsToString = toString -let set path id = Unix.chown path (-1) id +let set path id = Fs.chown path (-1) id let get stats = stats.Unix.LargeFile.st_gid end) @@ -488,13 +488,6 @@ Synced _ -> toString t | NotSynced _ -> "" -let iCanWrite p = - try - Unix.access p [Unix.W_OK]; - true - with - Unix.Unix_error _ -> false - (* FIX: Probably there should be a check here that prevents us from ever *) (* setting a file's modtime into the future. *) let set fspath path kind t = @@ -503,8 +496,8 @@ Util.convertUnixErrorsToTransient "setting modification time" (fun () -> - let abspath = Fspath.concatToString fspath path in - if Util.osType = `Win32 && not (iCanWrite abspath) then + let abspath = Fspath.concat fspath path in + if not (Fs.canSetTime abspath) then begin (* Nb. This workaround was proposed by Dmitry Bely, to work around the fact that Unix.utimes fails on readonly @@ -518,12 +511,12 @@ certainly don't want to make it WORLD-writable, even briefly!). *) let oldPerms = - (Unix.LargeFile.lstat abspath).Unix.LargeFile.st_perm in + (Fs.lstat abspath).Unix.LargeFile.st_perm in Util.finalize (fun()-> - Unix.chmod abspath 0o600; - Unix.utimes abspath v v) - (fun()-> Unix.chmod abspath oldPerms) + Fs.chmod abspath 0o600; + Fs.utimes abspath v v) + (fun()-> Fs.chmod abspath oldPerms) end else if false then begin (* A special hack for Rasmus, who has a special situation that @@ -540,12 +533,12 @@ time.Unix.tm_min time.Unix.tm_sec in let cmd = "/usr/local/bin/sudo -u root /usr/bin/touch -m -a -t " - ^ tstr ^ " '" ^ abspath ^ "'" in + ^ tstr ^ " " ^ Fspath.quotes abspath in Util.msg "Running external program to set utimes:\n %s\n" cmd; let (r,_) = External.runExternalProgram cmd in if r<>(Unix.WEXITED 0) then raise (Util.Transient "External time-setting command failed") end else - Unix.utimes abspath v v) + Fs.utimes abspath v v) | _ -> () @@ -568,7 +561,7 @@ (Format.sprintf "Failed to set modification time of file %s to %s: \ the time was set to %s instead" - (Fspath.concatToString fspath path) + (Fspath.toPrintString (Fspath.concat fspath path)) (syncedPartsToString t) (syncedPartsToString t'))) Modified: trunk/src/remote.ml =================================================================== --- trunk/src/remote.ml 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/remote.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -923,7 +923,7 @@ goes into text mode; this does not happen if unison is invoked from cygwin's bash. By setting CYGWIN=binmode we force the pipe to remain in binary mode. *) - Unix.putenv "CYGWIN" "binmode"; + System.putenv "CYGWIN" "binmode"; debug (fun ()-> Util.msg "Shell connection: %s (%s)\n" shellCmd (String.concat ", " args)); let term = @@ -1059,7 +1059,7 @@ goes into text mode; this does not happen if unison is invoked from cygwin's bash. By setting CYGWIN=binmode we force the pipe to remain in binary mode. *) - Unix.putenv "CYGWIN" "binmode"; + System.putenv "CYGWIN" "binmode"; debug (fun ()-> Util.msg "Shell connection: %s (%s)\n" shellCmd (String.concat ", " args)); let (term,pid) = @@ -1203,7 +1203,9 @@ let beAServer () = begin try - Sys.chdir (Sys.getenv "HOME") + Util.convertUnixErrorsToFatal + "changing working directory" + (fun () -> System.chdir (System.fspathFromString (System.getenv "HOME"))) with Not_found -> Util.msg "Environment variable HOME unbound: \ Modified: trunk/src/stasher.ml =================================================================== --- trunk/src/stasher.ml 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/stasher.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -133,13 +133,14 @@ let backupDirectory () = Util.convertUnixErrorsToTransient "backupDirectory()" (fun () -> - try Fspath.canonize (Some (Unix.getenv "UNISONBACKUPDIR")) + try Fspath.canonize (Some (System.getenv "UNISONBACKUPDIR")) with Not_found -> - try Fspath.canonize (Some (Unix.getenv "UNISONMIRRORDIR")) + try Fspath.canonize (Some (System.getenv "UNISONMIRRORDIR")) with Not_found -> if Prefs.read backupdir <> "" then Fspath.canonize (Some (Prefs.read backupdir)) - else Os.fileInUnisonDir "backup") + else Fspath.canonize + (Some (System.fspathToString (Os.fileInUnisonDir "backup")))) let backupcurrent = Pred.create "backupcurr" ~advanced:true @@ -315,7 +316,8 @@ let rec mkdirectories backdir = verbose (fun () -> Util.msg - "mkdirectories %s %s\n" (Fspath.toString sFspath) (Path.toString backdir)); + "mkdirectories %s %s\n" + (Fspath.toDebugString sFspath) (Path.toString backdir)); if not (Os.exists sFspath Path.empty) then Os.createDir sFspath Path.empty Props.dirDefault; match Path.deconstructRev backdir with @@ -336,16 +338,16 @@ then begin debug (fun()-> Util.msg "[%s / %s] = [%s / %s] = %s: no need to back up\n" - (Fspath.toString sFspath) (Path.toString path0) - (Fspath.toString fspath) (Path.toString path) + (Fspath.toDebugString sFspath) (Path.toString path0) + (Fspath.toDebugString fspath) (Path.toString path) (showContent sourceTyp fspath path)); None end else begin debug (fun()-> Util.msg "stashed [%s / %s] = %s is not equal to new [%s / %s] = %s (or one is a dir): stash!\n" - (Fspath.toString sFspath) (Path.toString path0) + (Fspath.toDebugString sFspath) (Path.toString path0) (showContent path0Typ sFspath path0) - (Fspath.toString fspath) (Path.toString path) + (Fspath.toDebugString fspath) (Path.toString path) (showContent sourceTyp fspath path)); let sPath = f 0 in (* Make sure the parent directory exists *) @@ -361,7 +363,7 @@ let backup fspath path (finalDisposition : [`AndRemove | `ByCopying]) = debug (fun () -> Util.msg "backup: %s / %s\n" - (Fspath.toString fspath) + (Fspath.toDebugString fspath) (Path.toString path)); Util.convertUnixErrorsToTransient "backup" (fun () -> let disposeIfNeeded() = @@ -370,41 +372,41 @@ if not (Os.exists fspath path) then debug (fun () -> Util.msg "File %s in %s does not exist, so no need to back up\n" - (Path.toString path) (Fspath.toString fspath)) + (Path.toString path) (Fspath.toDebugString fspath)) else if shouldBackup path then begin match backupPath fspath path with None -> disposeIfNeeded() | Some (backRoot, backPath) -> debug (fun () -> Util.msg "Backing up %s / %s to %s in %s\n" - (Fspath.toString fspath) (Path.toString path) - (Path.toString backPath) (Fspath.toString backRoot)); + (Fspath.toDebugString fspath) (Path.toString path) + (Path.toString backPath) (Fspath.toDebugString backRoot)); let byCopying() = let rec copy p backp = let info = Fileinfo.get true fspath p in match info.Fileinfo.typ with | `SYMLINK -> debug (fun () -> Util.msg " Copying link %s / %s to %s / %s\n" - (Fspath.toString fspath) (Path.toString p) - (Fspath.toString backRoot) (Path.toString backp)); + (Fspath.toDebugString fspath) (Path.toString p) + (Fspath.toDebugString backRoot) (Path.toString backp)); Os.symlink backRoot backp (Os.readLink fspath p) | `FILE -> debug (fun () -> Util.msg " Copying file %s / %s to %s / %s\n" - (Fspath.toString fspath) (Path.toString p) - (Fspath.toString backRoot) (Path.toString backp)); + (Fspath.toDebugString fspath) (Path.toString p) + (Fspath.toDebugString backRoot) (Path.toString backp)); Copy.localFile fspath p backRoot backp backp `Copy info.Fileinfo.desc (Osx.ressLength info.Fileinfo.osX.Osx.ressInfo) None | `DIRECTORY -> debug (fun () -> Util.msg " Copying directory %s / %s to %s / %s\n" - (Fspath.toString fspath) (Path.toString p) - (Fspath.toString backRoot) (Path.toString backp)); + (Fspath.toDebugString fspath) (Path.toString p) + (Fspath.toDebugString backRoot) (Path.toString backp)); Os.createDir backRoot backp info.Fileinfo.desc; let ch = Os.childrenOf fspath p in Safelist.iter (fun n -> copy (Path.child p n) (Path.child backp n)) ch | `ABSENT -> assert false in copy path backPath; debug (fun () -> Util.msg " Finished copying; deleting %s / %s\n" - (Fspath.toString fspath) (Path.toString path)); + (Fspath.toDebugString fspath) (Path.toString path)); disposeIfNeeded() in try if finalDisposition = `AndRemove then @@ -416,7 +418,7 @@ byCopying() end else begin debug (fun () -> Util.msg "Path %s / %s does not need to be backed up\n" - (Fspath.toString fspath) + (Fspath.toDebugString fspath) (Path.toString path)); disposeIfNeeded() end) @@ -428,7 +430,7 @@ Util.convertUnixErrorsToTransient "stashCurrentVersion" (fun () -> let sourcePath = match sourcePathOpt with None -> path | Some p -> p in debug (fun () -> Util.msg "stashCurrentVersion of %s (drawn from %s) in %s\n" - (Path.toString path) (Path.toString sourcePath) (Fspath.toString fspath)); + (Path.toString path) (Path.toString sourcePath) (Fspath.toDebugString fspath)); let stat = Fileinfo.get true fspath sourcePath in match stat.Fileinfo.typ with `ABSENT -> () @@ -469,7 +471,7 @@ debug (fun () -> Util.msg "getRecentVersion of %s in %s\n" (Path.toString path) - (Fspath.toString fspath)); + (Fspath.toDebugString fspath)); Util.convertUnixErrorsToTransient "getRecentVersion" (fun () -> let dir = stashDirectory fspath in let rec aux_find i = @@ -481,13 +483,13 @@ debug (fun () -> Util.msg "recent version %s found in %s\n" (Path.toString path) - (Fspath.toString dir)); + (Fspath.toDebugString dir)); Some (Fspath.concat dir path) end else if i = Prefs.read maxbackups then begin debug (fun () -> Util.msg "No recent version was available for %s on this root.\n" - (Fspath.toString (Fspath.concat fspath path))); + (Fspath.toDebugString (Fspath.concat fspath path))); None end else aux_find (i+1) Added: trunk/src/system.ml =================================================================== --- trunk/src/system.ml (rev 0) +++ trunk/src/system.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -0,0 +1,19 @@ +(* Unison file synchronizer: src/system.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + +include System_generic +(*include System_win*) Added: trunk/src/system.mli =================================================================== --- trunk/src/system.mli (rev 0) +++ trunk/src/system.mli 2009-05-13 18:02:17 UTC (rev 331) @@ -0,0 +1,6 @@ +(* Unison file synchronizer: src/system.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +(* Operations on filesystem path *) + +include System_intf.Full Added: trunk/src/system_generic.ml =================================================================== --- trunk/src/system_generic.ml (rev 0) +++ trunk/src/system_generic.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -0,0 +1,63 @@ +(* Unison file synchronizer: src/system_generic.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + +type fspath = string + +let fspathFromString f = f +let fspathToPrintString f = f +let fspathToString f = f +let fspathToDebugString f = String.escaped f + +let fspathConcat = Filename.concat +let fspathDirname = Filename.dirname +let fspathAddSuffixToFinalName f suffix = f ^ suffix + +(****) + +let getenv = Sys.getenv +let putenv = Unix.putenv +let argv () = Sys.argv + +(****) + +type dir_handle = Unix.dir_handle + +let stat = Unix.LargeFile.stat +let lstat = Unix.LargeFile.lstat +let rmdir = Unix.rmdir +let mkdir = Unix.mkdir +let unlink = Unix.unlink +let rename = Unix.rename +let open_in_gen = open_in_gen +let open_out_gen = open_out_gen +let chmod = Unix.chmod +let chown = Unix.chown +let utimes = Unix.utimes +let link = Unix.link +let openfile = Unix.openfile +let opendir = Unix.opendir +let readdir = Unix.readdir +let closedir = Unix.closedir +let readlink = Unix.readlink +let symlink = Unix.symlink +let chdir = Sys.chdir +let getcwd = Sys.getcwd + +(****) + +let file_exists = Sys.file_exists +let open_in_bin = open_in_bin Property changes on: trunk/src/system_generic.ml ___________________________________________________________________ Name: svn:executable + * Added: trunk/src/system_intf.ml =================================================================== --- trunk/src/system_intf.ml (rev 0) +++ trunk/src/system_intf.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -0,0 +1,70 @@ +(* Unison file synchronizer: src/system_intf.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + +module type Core = sig + +type fspath +type dir_handle + +val symlink : string -> fspath -> unit +val readlink : fspath -> string +val chown : fspath -> int -> int -> unit +val chmod : fspath -> int -> unit +val utimes : fspath -> float -> float -> unit +val unlink : fspath -> unit +val rmdir : fspath -> unit +val mkdir : fspath -> Unix.file_perm -> unit +val rename : fspath -> fspath -> unit +val stat : fspath -> Unix.LargeFile.stats +val lstat : fspath -> Unix.LargeFile.stats +val opendir : fspath -> dir_handle +val readdir : dir_handle -> string +val closedir : dir_handle -> unit +val openfile : + fspath -> Unix.open_flag list -> Unix.file_perm -> Unix.file_descr + +(****) + +val open_out_gen : open_flag list -> int -> fspath -> out_channel +val open_in_bin : fspath -> in_channel +val file_exists : fspath -> bool + +end + +module type Full = sig + +include Core + +val putenv : string -> string -> unit +val getenv : string -> string +val argv : unit -> string array + +val fspathFromString : string -> fspath +val fspathToPrintString : fspath -> string +val fspathToDebugString : fspath -> string +val fspathToString : fspath -> string +val fspathConcat : fspath -> string -> fspath +val fspathDirname : fspath -> fspath +val fspathAddSuffixToFinalName : fspath -> string -> fspath + +val open_in_gen : open_flag list -> int -> fspath -> in_channel + +val link : fspath -> fspath -> unit +val chdir : fspath -> unit +val getcwd : unit -> fspath + +end Added: trunk/src/system_win.ml =================================================================== --- trunk/src/system_win.ml (rev 0) +++ trunk/src/system_win.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -0,0 +1,194 @@ +(* Unison file synchronizer: src/system_win.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + +(*XXXX +Compilation/configuration issues + +Adapt fspath.ml to use Unix rather than Sys variants of getcwd and chdir? + +XXX Do not forget operations in fspath.ml... + +We have to propagate the encoding mode when canonizing roots +===> new major version + +TO CONVERT +========== +Unix.open_process_in +Unix.open_process_out +Unix.create_process +Unix.execvp +Lwt_unix.open_process_full +Lwt_unix.open_process_in + +- Try to hide the console when not using ssh +- Use SetConsoleOutputCP/SetConsoleCP in text mode + +copy icons to 2.32 ? +*) + +type fspath = string + +let fspathFromString f = f +let fspathToPrintString f = f +let fspathToString f = f +let fspathToDebugString f = String.escaped f + +let fspathConcat = Filename.concat +let fspathDirname = Filename.dirname +let fspathAddSuffixToFinalName f suffix = f ^ suffix + +(****) + +let fixPath f = + for i = 0 to String.length f - 1 do + if f.[i] = '/' then f.[i] <- '\\' + done; + f +let winRootRx = Rx.rx "[a-zA-Z]:[/\\].*" +let winUncRx = Rx.rx "//[^/]+/[^/]+/.*" +(* FIX: we could also handle UNC paths *) +let extendedPath f = + if Rx.match_string winRootRx f then + fixPath ("\\\\?\\" ^ f) + else + f + +let utf16 s = Unicode.to_utf_16 s +let utf8 s = Unicode.from_utf_16 s +let path16 = utf16 +let epath f = utf16 (extendedPath f) + +let sys_error e = + match e with + Unix.Unix_error (err, _, "") -> + raise (Sys_error (Unix.error_message err)) + | Unix.Unix_error (err, _, s) -> + raise (Sys_error (Format.sprintf "%s: %s" s (Unix.error_message err))) + | _ -> + raise e + +(****) + +external getenv_impl : string -> string = "win_getenv" +external putenv_impl : string -> string -> string -> unit = "win_putenv" +external argv_impl : unit -> string array = "win_argv" + +let getenv nm = utf8 (getenv_impl (utf16 nm)) +let putenv nm v = putenv_impl nm (utf16 nm) (utf16 v) +let argv () = Array.map utf8 (argv_impl ()) + +(****) + +type dir_entry = Dir_empty | Dir_read of string | Dir_toread +type dir_handle = + { handle : int; mutable entry_read: dir_entry } + +external stat_impl : string -> string -> Unix.LargeFile.stats = "win_stat" +external rmdir_impl : string -> string -> unit = "win_rmdir" +external mkdir_impl : string -> string -> unit = "win_mkdir" +external unlink_impl : string -> string -> unit = "win_unlink" +external rename_impl : string -> string -> string -> unit = "win_rename" +external chmod_impl : string -> string -> int -> unit = "win_chmod" +external utimes_impl : + string -> string -> float -> float -> unit = "win_utimes" +external open_impl : + string -> string -> Unix.open_flag list -> Unix.file_perm -> Unix.file_descr = "win_open" +external chdir_impl : string -> string -> unit = "win_chdir" +external getcwd_impl : unit -> string = "win_getcwd" +external findfirst : string -> string * int = "win_findfirstw" +external findnext : int -> string = "win_findnextw" +external findclose : int -> unit = "win_findclosew" + +let stat f = stat_impl f (epath f) +let lstat = stat +let rmdir f = rmdir_impl f (epath f) +let mkdir f perms = mkdir_impl f (epath f) +let unlink f = unlink_impl f (epath f) +let rename f1 f2 = rename_impl f1 (epath f1) (epath f2) +let chmod f perm = chmod_impl f (epath f) perm +let chown _ _ _ = raise (Unix.Unix_error (Unix.ENOSYS, "chown", "")) +let utimes f t1 t2 = utimes_impl f (epath f) t1 t2 +let link _ _ = raise (Unix.Unix_error (Unix.ENOSYS, "link", "")) +let openfile f flags perm = open_impl f (epath f) flags perm +let readlink _ = raise (Unix.Unix_error (Unix.ENOSYS, "readlink", "")) +let symlink _ _ = raise (Unix.Unix_error (Unix.ENOSYS, "symlink", "")) + +let chdir f = + try + chdir_impl f (path16 f) (* Better not to use [epath] here *) + with e -> sys_error e +let getcwd () = + try + utf8 (getcwd_impl ()) + with e -> sys_error e + +let badFileRx = Rx.rx ".*[?*].*" + +let opendir d = + if Rx.match_string badFileRx d then + raise (Unix.Unix_error (Unix.ENOENT, "opendir", d)); + try + let (first_entry, handle) = findfirst (epath (fspathConcat d "*")) in + { handle = handle; entry_read = Dir_read first_entry } + with End_of_file -> + { handle = 0; entry_read = Dir_empty } +let readdir d = + match d.entry_read with + Dir_empty -> raise End_of_file + | Dir_read name -> d.entry_read <- Dir_toread; utf8 name + | Dir_toread -> utf8 (findnext d.handle) +let closedir d = + match d.entry_read with + Dir_empty -> () + | _ -> findclose d.handle + +let rec conv_flags fl = + match fl with + Open_rdonly :: rem -> Unix.O_RDONLY :: conv_flags rem + | Open_wronly :: rem -> Unix.O_WRONLY :: conv_flags rem + | Open_append :: rem -> Unix.O_APPEND :: conv_flags rem + | Open_creat :: rem -> Unix.O_CREAT :: conv_flags rem + | Open_trunc :: rem -> Unix.O_TRUNC :: conv_flags rem + | Open_excl :: rem -> Unix.O_EXCL :: conv_flags rem + | Open_binary :: rem -> conv_flags rem + | Open_text :: rem -> conv_flags rem + | Open_nonblock :: rem -> Unix.O_NONBLOCK :: conv_flags rem + | [] -> [] + +let open_in_gen flags perms f = + try + Unix.in_channel_of_descr (openfile f (conv_flags flags) perms) + with e -> + sys_error e +let open_out_gen flags perms f = + try + Unix.out_channel_of_descr (openfile f (conv_flags flags) perms) + with e -> + sys_error e + +(****) + +let file_exists f = + try + ignore (stat f); true + with + Unix.Unix_error ((Unix.ENOENT | Unix.ENOTDIR), _, _) -> + false + | e -> + sys_error e + +let open_in_bin f = open_in_gen [Open_rdonly; Open_binary] 0 f Property changes on: trunk/src/system_win.ml ___________________________________________________________________ Name: svn:executable + * Added: trunk/src/system_win_stubs.c =================================================================== --- trunk/src/system_win_stubs.c (rev 0) +++ trunk/src/system_win_stubs.c 2009-05-13 18:02:17 UTC (rev 331) @@ -0,0 +1,464 @@ +#include +#include +#include +#include + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#define Nothing ((value) 0) + +struct filedescr { + union { + HANDLE handle; + SOCKET socket; + } fd; + enum { KIND_HANDLE, KIND_SOCKET } kind; + int crt_fd; +}; +#define Handle_val(v) (((struct filedescr *) Data_custom_val(v))->fd.handle) + +static value copy_wstring(LPCWSTR s) +{ + int len; + value res; + + len = 2 * wcslen(s) + 2; /* NULL character included */ + res = caml_alloc_string(len); + memmove(String_val(res), s, len); + return res; +} + +extern void win32_maperr (DWORD errcode); +extern void uerror (char * cmdname, value arg); +extern value win_alloc_handle (HANDLE h); +extern value cst_to_constr (int n, int * tbl, int size, int deflt); + +static int open_access_flags[12] = { + GENERIC_READ, GENERIC_WRITE, GENERIC_READ|GENERIC_WRITE, + 0, 0, 0, 0, 0, 0, 0, 0, 0 +}; + +static int open_create_flags[12] = { + 0, 0, 0, 0, 0, O_CREAT, O_TRUNC, O_EXCL, 0, 0, 0, 0 +}; + +static int open_flag_table[12] = { + _O_RDONLY, _O_WRONLY, _O_RDWR, 0, _O_APPEND, _O_CREAT, _O_TRUNC, + _O_EXCL, 0, 0, 0, 0 +}; + +/****/ + +CAMLprim value win_rmdir(value path, value wpath) +{ + CAMLparam2(path, wpath); + if (!RemoveDirectoryW((LPWSTR)String_val(wpath))) { + win32_maperr (GetLastError ()); + uerror("rmdir", path); + } + CAMLreturn (Val_unit); +} + +CAMLprim value win_mkdir(value path, value wpath) +{ + CAMLparam2(path, wpath); + if (!CreateDirectoryW((LPWSTR)String_val(wpath), NULL)) { + win32_maperr (GetLastError ()); + uerror("mkdir", path); + } + CAMLreturn (Val_unit); +} + +CAMLprim value win_unlink(value path, value wpath) +{ + CAMLparam2(path, wpath); + if (!DeleteFileW((LPWSTR)String_val(wpath))) { + win32_maperr (GetLastError ()); + uerror("unlink", path); + } + CAMLreturn (Val_unit); +} + +CAMLprim value win_rename(value path1, value wpath1, value wpath2) +{ + CAMLparam3(path1, wpath1, wpath2); + if (!MoveFileExW((LPWSTR)String_val(wpath1), (LPWSTR)String_val(wpath2), + MOVEFILE_REPLACE_EXISTING)) { + win32_maperr (GetLastError ()); + uerror("rename", path1); + } + CAMLreturn (Val_unit); +} + +CAMLprim value win_chmod (value path, value wpath, value perm) { + DWORD attr; + CAMLparam3(path, wpath, perm); + + attr = GetFileAttributesW ((LPCWSTR)String_val (wpath)); + if (attr == INVALID_FILE_ATTRIBUTES) { + win32_maperr (GetLastError ()); + uerror("chmod", path); + } + if (Int_val(perm) & _S_IWRITE) + attr &= ~FILE_ATTRIBUTE_READONLY; + else + attr |= FILE_ATTRIBUTE_READONLY; + + if (!SetFileAttributesW ((LPCWSTR)String_val (wpath), attr)) { + win32_maperr (GetLastError ()); + uerror("chmod", path); + } + + CAMLreturn (Val_unit); +} + +CAMLprim value win_utimes (value path, value wpath, value atime, value mtime) { + HANDLE h; + BOOL res; + ULARGE_INTEGER iatime, imtime; + FILETIME fatime, fmtime; + + CAMLparam4(path, wpath, atime, mtime); + + iatime.QuadPart = Double_val(atime); + imtime.QuadPart = Double_val(mtime); + + /* http://www.filewatcher.com/p/Win32-UTCFileTime-1.44.tar.gz.93147/Win32-UTCFileTime-1.44/UTCFileTime.xs.html */ + /* http://savannah.nongnu.org/bugs/?22781#comment0 */ + if (iatime.QuadPart || imtime.QuadPart) { + iatime.QuadPart += 11644473600ull; + iatime.QuadPart *= 10000000ull; + fatime.dwLowDateTime = iatime.LowPart; + fatime.dwHighDateTime = iatime.HighPart; + imtime.QuadPart += 11644473600ull; + imtime.QuadPart *= 10000000ull; + fmtime.dwLowDateTime = imtime.LowPart; + fmtime.dwHighDateTime = imtime.HighPart; + } else { + GetSystemTimeAsFileTime (&fatime); + fmtime = fatime; + } + h = CreateFileW ((LPWSTR) wpath, FILE_WRITE_ATTRIBUTES, + FILE_SHARE_READ | FILE_SHARE_WRITE, + NULL, OPEN_EXISTING, 0, NULL); + if (h == INVALID_HANDLE_VALUE) { + win32_maperr (GetLastError ()); + uerror("utimes", path); + } + res = SetFileTime (h, NULL, &fatime, &fmtime); + if (res == 0) { + win32_maperr (GetLastError ()); + (void)CloseHandle (h); + uerror("utimes", path); + } + res = CloseHandle (h); + if (res == 0) { + win32_maperr (GetLastError ()); + uerror("utimes", path); + } + CAMLreturn (Val_unit); +} + +CAMLprim value win_open (value path, value wpath, value flags, value perm) { + int fileaccess, createflags, fileattrib, filecreate; + SECURITY_ATTRIBUTES attr; + HANDLE h; + + CAMLparam4 (path, wpath, flags, perm); + + fileaccess = convert_flag_list(flags, open_access_flags); + + createflags = convert_flag_list(flags, open_create_flags); + if ((createflags & (O_CREAT | O_EXCL)) == (O_CREAT | O_EXCL)) + filecreate = CREATE_NEW; + else if ((createflags & (O_CREAT | O_TRUNC)) == (O_CREAT | O_TRUNC)) + filecreate = CREATE_ALWAYS; + else if (createflags & O_TRUNC) + filecreate = TRUNCATE_EXISTING; + else if (createflags & O_CREAT) + filecreate = OPEN_ALWAYS; + else + filecreate = OPEN_EXISTING; + + if ((createflags & O_CREAT) && (Int_val(perm) & 0200) == 0) + fileattrib = FILE_ATTRIBUTE_READONLY; + else + fileattrib = FILE_ATTRIBUTE_NORMAL; + + attr.nLength = sizeof(attr); + attr.lpSecurityDescriptor = NULL; + attr.bInheritHandle = TRUE; + + h = CreateFileW((LPCWSTR) String_val(wpath), fileaccess, + FILE_SHARE_READ | FILE_SHARE_WRITE, &attr, + filecreate, fileattrib, NULL); + + if (h == INVALID_HANDLE_VALUE) { + win32_maperr (GetLastError ()); + uerror("open", path); + } + + CAMLreturn(win_alloc_handle(h)); +} + +/* +static int file_kind_table[] = { + S_IFREG, S_IFDIR, S_IFCHR, S_IFBLK, 0, S_IFIFO, 0 +}; + +static value stat_aux(int use_64, struct _stati64 *buf) +{ + CAMLparam0 (); + CAMLlocal1 (v); + + v = caml_alloc (12, 0); + Store_field (v, 0, Val_int (buf->st_dev)); + Store_field (v, 1, Val_int (buf->st_ino)); + Store_field (v, 2, cst_to_constr (buf->st_mode & S_IFMT, file_kind_table, + sizeof(file_kind_table) / sizeof(int), 0)); + Store_field (v, 3, Val_int(buf->st_mode & 07777)); + Store_field (v, 4, Val_int (buf->st_nlink)); + Store_field (v, 5, Val_int (buf->st_uid)); + Store_field (v, 6, Val_int (buf->st_gid)); + Store_field (v, 7, Val_int (buf->st_rdev)); + Store_field (v, 8, + use_64 ? copy_int64(buf->st_size) : Val_int (buf->st_size)); + Store_field (v, 9, copy_double((double) buf->st_atime)); + Store_field (v, 10, copy_double((double) buf->st_mtime)); + Store_field (v, 11, copy_double((double) buf->st_ctime)); + CAMLreturn (v); +} +*/ +#define MAKEDWORDLONG(a,b) ((DWORDLONG)(((DWORD)(a))|(((DWORDLONG)((DWORD)(b)))<<32))) +#define FILETIME_TO_TIME(ft) (((((ULONGLONG) ft.dwHighDateTime) << 32) + ft.dwLowDateTime) / 10000000ull - 11644473600ull) + +CAMLprim value win_stat(value path, value wpath) +{ + int res, mode; + HANDLE h; + BY_HANDLE_FILE_INFORMATION info; + CAMLparam2(path,wpath); + CAMLlocal1 (v); + + h = CreateFileW ((LPCWSTR) String_val (wpath), 0, 0, NULL, OPEN_EXISTING, + FILE_FLAG_BACKUP_SEMANTICS | FILE_ATTRIBUTE_READONLY, NULL); + + if (h == INVALID_HANDLE_VALUE) { + win32_maperr (GetLastError ()); + uerror("stat", path); + } + + res = GetFileInformationByHandle (h, &info); + if (res == 0) { + win32_maperr (GetLastError ()); + (void) CloseHandle (h); + uerror("stat", path); + } + + res = CloseHandle (h); + if (res == 0) { + win32_maperr (GetLastError ()); + uerror("stat", path); + } + + v = caml_alloc (12, 0); + Store_field (v, 0, Val_int (info.dwVolumeSerialNumber)); + Store_field + (v, 1, Val_int (MAKEDWORDLONG(info.nFileIndexLow,info.nFileIndexHigh))); + Store_field + (v, 2, Val_int (info.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY + ? 1: 0)); + mode = 0000444; + if (info.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) + mode |= 0000111; + if (!(info.dwFileAttributes & FILE_ATTRIBUTE_READONLY)) + mode |= 0000222; + Store_field (v, 3, Val_int(mode)); + Store_field (v, 4, Val_int (1)); + Store_field (v, 5, Val_int (0)); + Store_field (v, 6, Val_int (0)); + Store_field (v, 7, Val_int (0)); + Store_field + (v, 8, copy_int64(MAKEDWORDLONG(info.nFileSizeLow,info.nFileSizeHigh))); + Store_field + (v, 9, copy_double((double) FILETIME_TO_TIME(info.ftLastAccessTime))); + Store_field + (v, 10, copy_double((double) FILETIME_TO_TIME(info.ftLastWriteTime))); + Store_field + (v, 11, copy_double((double) FILETIME_TO_TIME(info.ftCreationTime))); + + CAMLreturn (v); +} + +/* +CAMLprim value win_stat(value path, value wpath) +{ + CAMLparam2(path,wpath); + int ret; + struct _stati64 buf; + ret = _wstati64((const wchar_t *)String_val(wpath), &buf); + if (ret == -1) uerror("stat", path); + CAMLreturn(stat_aux(1, &buf)); +} +*/ + +CAMLprim value win_chdir (value path, value wpath) +{ + CAMLparam2(path,wpath); + if (!SetCurrentDirectoryW ((LPWSTR)wpath)) { + win32_maperr(GetLastError()); + uerror("chdir", path); + } + CAMLreturn (Val_unit); +} + +CAMLprim value win_getcwd (value unit) +{ + int len; + LPWSTR s; + CAMLparam0(); + CAMLlocal1 (res); + + len = GetCurrentDirectoryW (0, NULL); + if (len == 0) { + win32_maperr(GetLastError()); + uerror("getcwd", Nothing); + } + s = stat_alloc (len * 2 + 2); + len = GetCurrentDirectoryW (len, s); + if (len == 0) { + stat_free (s); + win32_maperr(GetLastError()); + uerror("getcwd", Nothing); + } + res = copy_wstring(s); + stat_free (s); + CAMLreturn (res); +} + +CAMLprim value win_findfirstw(value name) +{ + HANDLE h; + WIN32_FIND_DATAW fileinfo; + + CAMLparam1(name); + CAMLlocal3(v, valname, valh); + + h = FindFirstFileW((LPCWSTR) String_val(name),&fileinfo); + if (h == INVALID_HANDLE_VALUE) { + DWORD err = GetLastError(); + if (err == ERROR_NO_MORE_FILES) + raise_end_of_file(); + else { + win32_maperr(err); + uerror("opendir", Nothing); + } + } + valname = copy_wstring(fileinfo.cFileName); + valh = win_alloc_handle(h); + v = alloc_small(2, 0); + Field(v,0) = valname; + Field(v,1) = valh; + CAMLreturn (v); +} + +CAMLprim value win_findnextw(value valh) +{ + WIN32_FIND_DATAW fileinfo; + BOOL retcode; + + CAMLparam1(valh); + + retcode = FindNextFileW(Handle_val(valh), &fileinfo); + if (!retcode) { + DWORD err = GetLastError(); + if (err == ERROR_NO_MORE_FILES) + raise_end_of_file(); + else { + win32_maperr(err); + uerror("readdir", Nothing); + } + } + CAMLreturn (copy_wstring(fileinfo.cFileName)); +} + +CAMLprim value win_findclosew(value valh) +{ + CAMLparam1(valh); + + if (! FindClose(Handle_val(valh))) { + win32_maperr(GetLastError()); + uerror("closedir", Nothing); + } + CAMLreturn (Val_unit); +} + +CAMLprim value win_getenv(value var) +{ + LPWSTR s; + DWORD len; + CAMLparam1(var); + CAMLlocal1(res); + + s = stat_alloc (65536); + + len = GetEnvironmentVariableW((LPCWSTR) String_val(var), s, 65536); + if (len == 0) { stat_free (s); raise_not_found(); } + + res = copy_wstring(s); + stat_free (s); + CAMLreturn (res); + +} + +CAMLprim value win_putenv(value var, value wvar, value v) +{ + BOOL res; + CAMLparam3(var, wvar, v); + + res = SetEnvironmentVariableW((LPCWSTR) String_val(wvar), (LPCWSTR) v); + if (res == 0) { + win32_maperr (GetLastError ()); + uerror("putenv", var); + } + CAMLreturn (Val_unit); +} + +CAMLprim value win_argv(value unit) +{ + int n, i; + LPWSTR * l; + + CAMLparam0(); + CAMLlocal2(v,res); + + l = CommandLineToArgvW (GetCommandLineW (), &n); + + if (l == NULL) { + win32_maperr (GetLastError ()); + uerror("argv", Nothing); + } + res = caml_alloc (n, 0); + for (i = 0; i < n; i++) { + v = copy_wstring (l[i]); + Store_field (res, i, v); + } + LocalFree (l); + CAMLreturn (res); +} Property changes on: trunk/src/system_win_stubs.c ___________________________________________________________________ Name: svn:executable + * Modified: trunk/src/test.ml =================================================================== --- trunk/src/test.ml 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/test.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -25,25 +25,25 @@ let verbose = Trace.debug "test" let rec remove_file_or_dir d = - match try Some(Unix.lstat d) with Unix.Unix_error((Unix.ENOENT | Unix.ENOTDIR),_,_) -> None with + match try Some(Fs.lstat d) with Unix.Unix_error((Unix.ENOENT | Unix.ENOTDIR),_,_) -> None with | Some(s) -> - if s.Unix.st_kind = Unix.S_DIR then begin - let handle = Unix.opendir d in + if s.Unix.LargeFile.st_kind = Unix.S_DIR then begin + let handle = Fs.opendir d in let rec loop () = - let r = try Some(Unix.readdir handle) with End_of_file -> None in + let r = try Some(Fs.readdir handle) with End_of_file -> None in match r with | Some f -> if f="." || f=".." then loop () else begin - remove_file_or_dir (d^"/"^f); + remove_file_or_dir (Fspath.concat d (Path.fromString f)); loop () end | None -> - Unix.closedir handle; - Unix.rmdir d + Fs.closedir handle; + Fs.rmdir d in loop () end else - Sys.remove d + Fs.unlink d | None -> () let read_chan chan = @@ -53,10 +53,12 @@ string let read file = +(* if file = "-" then read_chan stdin - else - let chan = open_in_bin file in + else +*) + let chan = Fs.open_in_bin file in try let r = read_chan chan in close_in chan; @@ -66,10 +68,14 @@ raise exn let write file s = +(* if file = "-" then output_string stdout s - else - let chan = open_out_bin file in + else +*) + let chan = + Fs.open_out_gen + [Open_wronly; Open_creat; Open_trunc; Open_binary] 0o600 file in try output_string chan s; close_out chan @@ -79,20 +85,19 @@ let read_dir d = let ignored = ["."; ".."] in - let d = Unix.opendir d in + let d = Fs.opendir d in let rec do_read acc = try - (match (Unix.readdir d) with + (match (Fs.readdir d) with | s when Safelist.mem s ignored -> do_read acc | f -> do_read (f :: acc)) with End_of_file -> acc in let files = do_read [] in - Unix.closedir d; + Fs.closedir d; files -let extend p file = - p ^ "/" ^ file +let extend p file = Fspath.concat p (Path.fromString file) type fs = | File of string @@ -124,10 +129,10 @@ let readfs p = let rec loop p = - let s = Unix.lstat p in - match s.Unix.st_kind with + let s = Fs.lstat p in + match s.Unix.LargeFile.st_kind with | Unix.S_REG -> File (read p) - | Unix.S_LNK -> Link (Unix.readlink p) + | Unix.S_LNK -> Link (Fs.readlink p) | Unix.S_DIR -> Dir (Safelist.map (fun x -> (x, loop (extend p x))) (read_dir p)) | _ -> assert false in try Some(loop p) with @@ -140,11 +145,11 @@ let rec loop p = function | File s -> verbose (fun() -> Util.msg "Writing %s with contents %s (fingerprint %s)\n" - p s (Fingerprint.toString (Fingerprint.string s))); + (Fspath.toDebugString p) s (Fingerprint.toString (Fingerprint.string s))); write p s - | Link s -> Unix.symlink s p + | Link s -> Fs.symlink s p | Dir files -> - Unix.mkdir p default_perm; + Fs.mkdir p default_perm; Safelist.iter (fun (x,cont) -> loop (extend p x) cont) files in remove_file_or_dir p; @@ -157,41 +162,41 @@ if Os.exists fspath Path.empty then raise (Util.Fatal (Printf.sprintf "Path %s is not empty at start of tests!" - (Fspath.toString fspath))); + (Fspath.toPrintString fspath))); Lwt.return ()) let makeRootEmpty : Common.root -> unit -> unit Lwt.t = Remote.registerRootCmd "makeRootEmpty" (fun (fspath, ()) -> - remove_file_or_dir (Fspath.toString fspath); + remove_file_or_dir fspath; Lwt.return ()) let getfs : Common.root -> unit -> (fs option) Lwt.t = Remote.registerRootCmd "getfs" (fun (fspath, ()) -> - Lwt.return (readfs (Fspath.toString fspath))) + Lwt.return (readfs fspath)) let getbackup : Common.root -> unit -> (fs option) Lwt.t = Remote.registerRootCmd "getbackup" (fun (fspath, ()) -> - Lwt.return (readfs (Fspath.toString (Stasher.backupDirectory ())))) + Lwt.return (readfs (Stasher.backupDirectory ()))) let makeBackupEmpty : Common.root -> unit -> unit Lwt.t = Remote.registerRootCmd "makeBackupEmpty" (fun (fspath, ()) -> - let b = Fspath.toString (Stasher.backupDirectory ()) in - debug (fun () -> Util.msg "Removing %s\n" b); + let b = Stasher.backupDirectory () in + debug (fun () -> Util.msg "Removing %s\n" (Fspath.toDebugString b)); Lwt.return (remove_file_or_dir b)) let putfs : Common.root -> fs -> unit Lwt.t = Remote.registerRootCmd "putfs" (fun (fspath, fs) -> - writefs (Fspath.toString fspath) fs; + writefs fspath fs; Lwt.return ()) let loadPrefs l = @@ -257,7 +262,7 @@ (Globals.rawRoots())) then raise (Util.Fatal "Self-tests can only be run if both roots include the string 'test'"); - if Util.findsubstring "test" (Fspath.toString (Stasher.backupDirectory())) = None then + if Util.findsubstring "test" (Fspath.toPrintString (Stasher.backupDirectory())) = None then raise (Util.Fatal ("Self-tests can only be run if the 'backupdir' preference (or wherever the backup " ^ "directory name is coming from, e.g. the UNISONBACKUPDIR environment variable) " Modified: trunk/src/ubase/prefs.ml =================================================================== --- trunk/src/ubase/prefs.ml 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/ubase/prefs.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -19,7 +19,7 @@ let profilePathname n = let f = Util.fileInUnisonDir n in - if Sys.file_exists f then f + if System.file_exists f then f else Util.fileInUnisonDir (n ^ ".prf") let thePrefsFile () = @@ -146,6 +146,11 @@ (fun v -> [v]) (fun cell -> Uarg.String (fun s -> set cell s)) +let createFspath name default doc fulldoc = + createPrefInternal name default doc fulldoc + (fun v -> [System.fspathToString v]) + (fun cell -> Uarg.String (fun s -> set cell (System.fspathFromString s))) + let createStringList name doc fulldoc = createPrefInternal name [] doc fulldoc (fun v -> v) @@ -260,7 +265,7 @@ in the same order as in the file. *) let rec readAFile filename : (string * int * string * string) list = let chan = - try open_in (profilePathname filename) + try System.open_in_bin (profilePathname filename) with Sys_error _ -> raise(Util.Fatal(Printf.sprintf "Preference file %s not found" filename)) in let rec loop lines = @@ -370,10 +375,12 @@ then profilePathname (read addprefsto) else thePrefsFile() in try - debug (fun() -> Util.msg "Adding '%s' to %s\n" l filename); - let resultmsg = l ^ "' added to profile " ^ filename in + debug (fun() -> + Util.msg "Adding '%s' to %s\n" l (System.fspathToDebugString filename)); + let resultmsg = + l ^ "' added to profile " ^ System.fspathToPrintString filename in let ochan = - open_out_gen [Open_wronly; Open_append; Open_creat] 0o600 filename + System.open_out_gen [Open_wronly; Open_creat; Open_append] 0o600 filename in output_string ochan l; output_string ochan "\n"; Modified: trunk/src/ubase/prefs.mli =================================================================== --- trunk/src/ubase/prefs.mli 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/ubase/prefs.mli 2009-05-13 18:02:17 UTC (rev 331) @@ -32,6 +32,13 @@ -> string (* full (tex) documentation string *) -> string t (* -> new preference value *) +val createFspath : + string (* preference name *) + -> System.fspath (* initial value *) + -> string (* documentation string *) + -> string (* full (tex) documentation string *) + -> System.fspath t (* -> new preference value *) + val createStringList : string (* preference name *) -> string (* documentation string *) @@ -81,7 +88,7 @@ val profileName : string option ref (* Calculate the full pathname of a preference file *) -val profilePathname : string -> string +val profilePathname : string -> System.fspath (* Add a new preference to the file on disk (the result is a diagnostic *) (* message that can be displayed to the user to verify where the new pref *) Modified: trunk/src/ubase/trace.ml =================================================================== --- trunk/src/ubase/trace.ml 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/ubase/trace.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -112,7 +112,7 @@ on a file." let logfile = - Prefs.createString "logfile" + Prefs.createFspath "logfile" (Util.fileInHomeDir "unison.log") "!logfile name" "By default, logging messages will be appended to the file @@ -127,7 +127,7 @@ None -> let file = Prefs.read logfile in let ch = - open_out_gen [Open_wronly; Open_append; Open_creat] 0o600 file in + System.open_out_gen [Open_wronly; Open_creat; Open_append] 0o600 file in logch := Some (ch, file); ch | Some(ch, file) -> Modified: trunk/src/ubase/uarg.ml =================================================================== --- trunk/src/ubase/uarg.ml 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/ubase/uarg.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -44,10 +44,11 @@ let current = ref 0;; let parse speclist anonfun errmsg = + let argv = System.argv () in let initpos = !current in let stop error = let progname = - if initpos < Array.length Sys.argv then Sys.argv.(initpos) else "(?)" in + if initpos < Array.length argv then argv.(initpos) else "(?)" in begin match error with | Unknown s when s = "-help" -> () | Unknown s -> @@ -63,10 +64,10 @@ usage speclist errmsg; exit 2; in - let l = Array.length Sys.argv in + let l = Array.length argv in incr current; while !current < l do - let ss = Sys.argv.(!current) in + let ss = argv.(!current) in if String.length ss >= 1 & String.get ss 0 = '-' then begin let args = Util.splitIntoWords ss '=' in let s = Safelist.nth args 0 in @@ -74,7 +75,7 @@ match args with [_] -> if !current + 1 >= l then stop (Missing s) else - let a = Sys.argv.(!current+1) in + let a = argv.(!current+1) in incr current; (try conv a with Failure _ -> stop (Wrong (s, a, mesg))) | [_;a] -> (try conv a with Failure _ -> stop (Wrong (s, a, mesg))) @@ -98,7 +99,7 @@ | Float f -> f (arg float_of_string "a float") | Rest f -> while !current < l-1 do - f Sys.argv.(!current+1); + f argv.(!current+1); incr current; done; with Bad m -> stop (Message m); Modified: trunk/src/ubase/util.ml =================================================================== --- trunk/src/ubase/util.ml 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/ubase/util.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -257,7 +257,7 @@ convertUnixErrorsToFatal "querying environment" (fun () -> - try Unix.getenv var + try System.getenv var with Not_found -> raise (Fatal ("Environment variable " ^ var ^ " not found"))) @@ -423,22 +423,23 @@ (* Building pathnames in the user's home dir *) (*****************************************************************************) -let fileInHomeDir n = - if (osType = `Unix) || isCygwin then - Filename.concat (safeGetenv "HOME") n - else if osType = `Win32 then - let dirString = - try Unix.getenv "HOME" (* Windows 9x with Cygwin HOME set *) - with Not_found -> - try Unix.getenv "USERPROFILE" (* Windows NT/2K standard *) - with Not_found -> - try Unix.getenv "UNISON" (* Use UNISON dir if it is set *) - with Not_found -> - "c:/" (* Default *) in - Filename.concat dirString n - else - assert false (* osType can't be anything else *) +let homeDir () = + System.fspathFromString + (if (osType = `Unix) || isCygwin then + safeGetenv "HOME" + else if osType = `Win32 then + try System.getenv "HOME" (* Windows 9x with Cygwin HOME set *) + with Not_found -> + try System.getenv "USERPROFILE" (* Windows NT/2K standard *) + with Not_found -> + try System.getenv "UNISON" (* Use UNISON dir if it is set *) + with Not_found -> + "c:/" (* Default *) + else + assert false (* osType can't be anything else *)) +let fileInHomeDir n = System.fspathConcat (homeDir ()) n + (*****************************************************************************) (* "Upcall" for building pathnames in the .unison dir *) (*****************************************************************************) Modified: trunk/src/ubase/util.mli =================================================================== --- trunk/src/ubase/util.mli 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/ubase/util.mli 2009-05-13 18:02:17 UTC (rev 331) @@ -77,7 +77,7 @@ int (* percentage of total *) val monthname : int -> string val percent2string : float -> string -val fileInHomeDir : string -> string +val fileInHomeDir : string -> System.fspath (* Just like the versions in the Unix module, but raising Transient instead of Unix_error *) @@ -96,9 +96,9 @@ (* Someone should supply a function here that will convert a simple filename to a filename in the unison directory *) -val supplyFileInUnisonDirFn : (string -> string) -> unit +val supplyFileInUnisonDirFn : (string -> System.fspath) -> unit (* Use it like this: *) -val fileInUnisonDir : string -> string +val fileInUnisonDir : string -> System.fspath (* Printing and formatting functions *) Modified: trunk/src/uicommon.ml =================================================================== --- trunk/src/uicommon.ml 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/uicommon.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -492,7 +492,7 @@ (* If the profile does not exist, create an empty one (this should only happen if the profile is 'default', since otherwise we will already have checked that the named one exists). *) - if not(Sys.file_exists (Prefs.profilePathname profileName)) then + if not(System.file_exists (Prefs.profilePathname profileName)) then Prefs.addComment "Unison preferences file"; (* Load the profile *) @@ -663,7 +663,7 @@ let profileName = begin match !clprofile with None -> - let dirString = Fspath.toString Os.unisonDir in + let dirString = Os.unisonDir in let profiles_exist = (Files.ls dirString "*.prf")<>[] in let clroots_given = (Globals.rawRoots() <> []) in let n = @@ -683,8 +683,9 @@ n | Some n -> let f = Prefs.profilePathname n in - if not(Sys.file_exists f) - then (reportError (Printf.sprintf "Profile %s does not exist" f); + if not(System.file_exists f) + then (reportError (Printf.sprintf "Profile %s does not exist" + (System.fspathToPrintString f)); exit 1); n end in Modified: trunk/src/uigtk.ml =================================================================== --- trunk/src/uigtk.ml 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/uigtk.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -758,8 +758,7 @@ (f, info)) (Safelist.filter (fun name -> not ( Util.startswith name ".#" || Util.startswith name Os.tempFilePrefix)) - (Files.ls (Fspath.toString Os.unisonDir) - "*.prf"))) + (Files.ls Os.unisonDir "*.prf"))) let getProfile () = (* The selected profile *) @@ -852,7 +851,7 @@ let profile = prof#text in if profile <> "" then let filename = Prefs.profilePathname profile in - if Sys.file_exists filename then + if System.file_exists filename then okBox ~title:(Uutil.myName ^ " error") ~message:("Profile \"" @@ -861,7 +860,7 @@ else (* Make an empty file *) let ch = - open_out_gen + System.open_out_gen [Open_wronly; Open_creat; Open_trunc] 0o600 filename in close_out ch; fillLst profile; @@ -2020,7 +2019,7 @@ grAdd grRestart (fileMenu#add_item ~key:key ~callback:(fun _ -> - if Sys.file_exists (Prefs.profilePathname name) then begin + if System.file_exists (Prefs.profilePathname name) then begin Trace.status ("Loading profile " ^ name); loadProfile name; detectCmd() end else @@ -2146,7 +2145,7 @@ let displayAvailable = Util.osType = `Win32 || - try Unix.getenv "DISPLAY" <> "" with Not_found -> false + try System.getenv "DISPLAY" <> "" with Not_found -> false in if displayAvailable then Private.start Uicommon.Graphic else Uitext.Body.start Uicommon.Text Modified: trunk/src/uigtk2.ml =================================================================== --- trunk/src/uigtk2.ml 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/uigtk2.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -170,7 +170,7 @@ non-ASCII characters. *) let code = - [| 0x0000; 0x0001; 0x0002; 0x0003; 0x0004; 0x0005; 0x0006; 0x0007; + [| 0x0020; 0x0001; 0x0002; 0x0003; 0x0004; 0x0005; 0x0006; 0x0007; 0x0008; 0x0009; 0x000A; 0x000B; 0x000C; 0x000D; 0x000E; 0x000F; 0x0010; 0x0011; 0x0012; 0x0013; 0x0014; 0x0015; 0x0016; 0x0017; 0x0018; 0x0019; 0x001A; 0x001B; 0x001C; 0x001D; 0x001E; 0x001F; @@ -227,7 +227,7 @@ (****) let wf_utf8 = - [[('\x00', '\x7F')]; + [[('\x01', '\x7F')]; [('\xC2', '\xDF'); ('\x80', '\xBF')]; [('\xE0', '\xE0'); ('\xA0', '\xBF'); ('\x80', '\xBF')]; [('\xE1', '\xEC'); ('\x80', '\xBF'); ('\x80', '\xBF')]; @@ -273,7 +273,9 @@ (****) let protect_char buf c = - if c < '\x80' then + if c = '\x00' then + Buffer.add_char buf ' ' + else if c < '\x80' then Buffer.add_char buf c else let c = Char.code c in @@ -303,13 +305,18 @@ let escapeMarkup s = Glib.Markup.escape_text s let transcode s = + if Prefs.read Case.unicodeEncoding then + protect s + else try Glib.Convert.locale_to_utf8 s with Glib.Convert.Error _ -> protect s let transcodeFilename s = - if Util.osType = `Win32 then transcode s else + if Prefs.read Case.unicodeEncoding then + protect s + else if Util.osType = `Win32 then transcode s else try Glib.Convert.filename_to_utf8 s with Glib.Convert.Error _ -> @@ -901,16 +908,17 @@ None -> profileKeymap.(i) <- Some(profile,info) | Some(otherProfile,_) -> raise (Util.Fatal - ("Error scanning profile "^filename^":\n" + ("Error scanning profile "^ + System.fspathToPrintString filename ^":\n" ^ "shortcut key "^k^" is already bound to profile " ^ otherProfile)) else raise (Util.Fatal - ("Error scanning profile "^filename^":\n" + ("Error scanning profile "^ System.fspathToPrintString filename ^":\n" ^ "Value of 'key' preference must be a single digit (0-9), " ^ "not " ^ k)) with int_of_string -> raise (Util.Fatal - ("Error scanning profile "^filename^":\n" + ("Error scanning profile "^ System.fspathToPrintString filename ^":\n" ^ "Value of 'key' preference must be a single digit (0-9), " ^ "not " ^ k)) @@ -941,8 +949,7 @@ (f, info)) (Safelist.filter (fun name -> not ( Util.startswith name ".#" || Util.startswith name Os.tempFilePrefix)) - (Files.ls (Fspath.toString Os.unisonDir) - "*.prf"))) + (Files.ls Os.unisonDir "*.prf"))) let getProfile () = (* The selected profile *) @@ -1038,7 +1045,7 @@ let profile = prof#text in if profile <> "" then let filename = Prefs.profilePathname profile in - if Sys.file_exists filename then + if System.file_exists filename then okBox ~title:"Error" ~typ:`ERROR ~message:("Profile \"" @@ -1047,8 +1054,8 @@ else (* Make an empty file *) let ch = - open_out_gen - [Open_wronly; Open_creat; Open_trunc] 0o600 filename in + System.open_out_gen + [Open_wronly; Open_creat; Open_excl] 0o600 filename in close_out ch; fillLst profile; exit () in @@ -1585,9 +1592,11 @@ let greenPixel = "00dd00" in let redPixel = "ff2040" in + let lightbluePixel = "8888FF" in +(* let yellowPixel = "999900" in - let lightbluePixel = "8888FF" in let blackPixel = "000000" in +*) let buildPixmap p = GDraw.pixmap_from_xpm_d ~window:toplevelWindow ~data:p () in let buildPixmaps f c1 = @@ -1598,10 +1607,12 @@ let ignoreAct = buildPixmaps Pixmaps.ignore redPixel in let doneIcon = buildPixmap Pixmaps.success in let failedIcon = buildPixmap Pixmaps.failure in + let mergeLogo = buildPixmaps Pixmaps.mergeLogo greenPixel in +(* let rightArrowBlack = buildPixmap (Pixmaps.copyAB blackPixel) in let leftArrowBlack = buildPixmap (Pixmaps.copyBA blackPixel) in - let mergeLogo = buildPixmaps Pixmaps.mergeLogo greenPixel in let mergeLogoBlack = buildPixmap (Pixmaps.mergeLogo blackPixel) in +*) let displayArrow i j action = let changedFromDefault = match !theState.(j).ri.replicas with @@ -2362,7 +2373,7 @@ grAdd grRestart (fileMenu#add_item ~key:key ~callback:(fun _ -> - if Sys.file_exists (Prefs.profilePathname name) then begin + if System.file_exists (Prefs.profilePathname name) then begin Trace.status ("Loading profile " ^ name); loadProfile name; detectCmd () end else @@ -2496,7 +2507,7 @@ let displayAvailable = Util.osType = `Win32 || - try Unix.getenv "DISPLAY" <> "" with Not_found -> false + try System.getenv "DISPLAY" <> "" with Not_found -> false in if displayAvailable then Private.start Uicommon.Graphic else Uitext.Body.start Uicommon.Text Modified: trunk/src/uimacbridge.ml =================================================================== --- trunk/src/uimacbridge.ml 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/uimacbridge.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -18,7 +18,7 @@ mutable statusMessage : string option };; let theState = ref [| |];; -let unisonDirectory() = Fspath.toString Os.unisonDir +let unisonDirectory() = System.fspathToPrintString Os.unisonDir ;; Callback.register "unisonDirectory" unisonDirectory;; @@ -61,7 +61,7 @@ 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 -> Fspath.toString (Os.fileInUnisonDir(n))); + (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; @@ -107,8 +107,9 @@ None -> () | Some n -> let f = Prefs.profilePathname n in - if not(Sys.file_exists f) - then (Printf.eprintf "Profile %s does not exist" f; + if not(System.file_exists f) + then (Printf.eprintf "Profile %s does not exist" + (System.fspathToPrintString f); exit 1) end; !clprofile @@ -132,7 +133,7 @@ (* If the profile does not exist, create an empty one (this should only happen if the profile is 'default', since otherwise we will already have checked that the named one exists). *) - if not(Sys.file_exists (Prefs.profilePathname profileName)) then + if not(System.file_exists (Prefs.profilePathname profileName)) then Prefs.addComment "Unison preferences file"; (* Load the profile *) Modified: trunk/src/uimacbridgenew.ml =================================================================== --- trunk/src/uimacbridgenew.ml 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/uimacbridgenew.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -18,7 +18,7 @@ mutable statusMessage : string option };; let theState = ref [| |];; -let unisonDirectory() = Fspath.toString Os.unisonDir +let unisonDirectory() = System.fspathToPrintString Os.unisonDir ;; Callback.register "unisonDirectory" unisonDirectory;; @@ -107,7 +107,7 @@ 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 -> Fspath.toString (Os.fileInUnisonDir(n))); + (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; @@ -155,8 +155,9 @@ None -> () | Some n -> let f = Prefs.profilePathname n in - if not(Sys.file_exists f) - then (Printf.eprintf "Profile %s does not exist" f; + if not(System.file_exists f) + then (Printf.eprintf "Profile %s does not exist" + (System.fspathToPrintString f); exit 1) end; !clprofile @@ -180,7 +181,7 @@ (* If the profile does not exist, create an empty one (this should only happen if the profile is 'default', since otherwise we will already have checked that the named one exists). *) - if not(Sys.file_exists (Prefs.profilePathname profileName)) then + if not(System.file_exists (Prefs.profilePathname profileName)) then Prefs.addComment "Unison preferences file"; (* Load the profile *) Modified: trunk/src/uitext.ml =================================================================== --- trunk/src/uitext.ml 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/uitext.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -27,7 +27,7 @@ Prefs.createBool "dumbtty" (match Util.osType with `Unix -> - (try (Unix.getenv "EMACS" <> "") with + (try (System.getenv "EMACS" <> "") with Not_found -> false) | _ -> true) @@ -215,7 +215,7 @@ begin match !Prefs.profileName with None -> assert false | Some(n) -> display (" To un-ignore, edit " - ^ (Prefs.profilePathname n) + ^ System.fspathToPrintString (Prefs.profilePathname n) ^ " and restart " ^ Uutil.myName ^ "\n") end; let nukeIgnoredRis = Safelist.filter (fun ri -> not (Globals.shouldIgnore ri.path)) in @@ -284,7 +284,7 @@ Uicommon.showDiffs ri (fun title text -> try - let pager = Sys.getenv "PAGER" in + let pager = System.getenv "PAGER" in restoreTerminal (); let out = Unix.open_process_out pager in Printf.fprintf out "\n%s\n\n%s\n\n" title text; @@ -614,7 +614,8 @@ let suckOnWatcherFileLocal n = Util.convertUnixErrorsToFatal - ("Reading changes from watcher process in file " ^ n) + ("Reading changes from watcher process in file " ^ + System.fspathToPrintString n) (fun () -> (* The main loop, invoked from two places below *) let rec loop ch = @@ -636,15 +637,15 @@ (* Make sure there's a file to watch, then read from it *) match !watcherchan with None -> - if Sys.file_exists n then begin - let ch = open_in n in + if System.file_exists n then begin + let ch = System.open_in_bin n in watcherchan := Some(ch); loop ch end else [] | Some(ch) -> loop ch ) -let suckOnWatcherFileRoot: Common.root -> string -> (string list) Lwt.t = +let suckOnWatcherFileRoot: Common.root -> System.fspath -> (string list) Lwt.t = Remote.registerRootCmd "suckOnWatcherFile" (fun (fspath, n) -> @@ -656,7 +657,7 @@ Globals.allRootsMap (fun r -> suckOnWatcherFileRoot r n))) let synchronizePathsFromFilesystemWatcher () = - let watcherfilename = "" in + let watcherfilename = System.fspathFromString "" in (* STOPPED HERE -- need to find the program using watcherosx preference and invoke it using a redirect to get the output into a temp file... *) let rec loop failedPaths = let newpaths = suckOnWatcherFiles watcherfilename in Modified: trunk/src/unicode.ml =================================================================== --- trunk/src/unicode.ml 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/unicode.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -775,7 +775,7 @@ cont s' j s (i + 4) l v end end else - String.sub s' 0 j + String.sub s' 0 (j + 2) and cont s' j s i l v = if v < 0x10000 then begin @@ -790,7 +790,7 @@ let to_utf_16 s = let l = String.length s in - let s' = String.create (2 * l) in + let s' = String.make (2 * l + 2) '\000' in scan s' 0 s 0 l (****) @@ -798,21 +798,29 @@ let rec scan s' i' l' s i l = if i + 2 <= l then begin let v = get_2 s i in - if v < 0xD800 || v > 0xDFFF then + if v = 0 then + String.sub s' 0 i' (* null *) + else if v < 0xD800 || v > 0xDFFF then let i' = encode_char s' i' l' v in scan s' i' l' s (i + 2) l else if v >= 0xdc00 || i + 4 > l then - fail () + let i' = encode_char s' i' l' v in + scan s' i' l' s (i + 2) l +(* fail () *) else begin let v' = get_2 s (i + 2) in - if v' < 0xDC00 || v' > 0XDFFF then fail () else - let i' = - encode_char s' i' l' ((v - 0xD800) lsl 10 + (v' - 0xDC00) + 0x10000) - in - scan s' i' l' s (i + 4) l + if v' < 0xDC00 || v' > 0XDFFF then + let i' = encode_char s' i' l' v in + scan s' i' l' s (i + 2) l +(* fail ()*) + else + let i' = + encode_char s' i' l' ((v - 0xD800) lsl 10 + (v' - 0xDC00) + 0x10000) + in + scan s' i' l' s (i + 4) l end end else if i < l then - fail () + fail () (* Odd number of chars *) else String.sub s' 0 i' @@ -842,7 +850,7 @@ let c2 = get s (i + 2) in (c1 lor c2) land 0xc0 = 0x80 && let v = c lsl 12 + c1 lsl 6 + c2 - 0xe2080 in - v >= 0x800 && + v >= 0x800 && (v < 0xd800 || v > 0xdfff) && scan s (i + 3) l end else begin (* 10000 - 10FFFF *) Modified: trunk/src/unicode.mli =================================================================== --- trunk/src/unicode.mli 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/unicode.mli 2009-05-13 18:02:17 UTC (rev 331) @@ -14,8 +14,9 @@ by Mac OS X. *) val compose : string -> string -(* Convert to and from little-endian UTF-16 encoding *) -(*XXX What about null-termination? *) +(* Convert to and from a null-terminated little-endian UTF-16 string *) +(* Do not fail on isolated surrogate but rather generate ill-formed + UTF-8 characters, so that the conversion never fails. *) val to_utf_16 : string -> string val from_utf_16 : string -> string Modified: trunk/src/update.ml =================================================================== --- trunk/src/update.ml 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/update.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -265,13 +265,13 @@ (* Load in the archive in [fspath]; check that archiveFormat (first line) and roots (second line) match skip the third line (time stamp), and read in the archive *) -let loadArchiveLocal (fspath: Fspath.t) (thisRoot: string) : +let loadArchiveLocal fspath (thisRoot: string) : (archive * int * string) option = - let f = Fspath.toString fspath in - debug (fun() -> Util.msg "Loading archive from %s\n" f); + debug (fun() -> + Util.msg "Loading archive from %s\n" (System.fspathToDebugString fspath)); Util.convertUnixErrorsToFatal "loading archive" (fun () -> - if Sys.file_exists f then - let c = open_in_bin f in + if System.file_exists fspath then + let c = System.open_in_bin fspath in let header = input_line c in (* Sanity check on archive format *) if header<>formatString then begin @@ -306,16 +306,19 @@ "Archive file seems damaged (%s): \ throw away archives on both machines and try again" s)) else - (debug (fun() -> Util.msg "Archive %s not found\n" f); + (debug (fun() -> + Util.msg "Archive %s not found\n" + (System.fspathToDebugString fspath)); None)) (* Inverse to loadArchiveLocal *) let storeArchiveLocal fspath thisRoot archive hash magic = - let f = Fspath.toString fspath in - debug (fun() -> Util.msg "Saving archive in %s\n" f); + debug (fun() -> + Util.msg "Saving archive in %s\n" (System.fspathToDebugString fspath)); Util.convertUnixErrorsToFatal "saving archive" (fun () -> let c = - open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_binary] 0o600 f + System.open_out_gen + [Open_wronly; Open_creat; Open_trunc; Open_binary] 0o600 fspath in output_string c formatString; output_string c "\n"; @@ -330,10 +333,11 @@ let removeArchiveLocal ((fspath: Fspath.t), (v: archiveVersion)): unit Lwt.t = Lwt.return (let (name,_) = archiveName fspath v in - let f = Fspath.toString (Os.fileInUnisonDir name) in - debug (fun() -> Util.msg "Removing archive %s\n" f); + let fspath = Os.fileInUnisonDir name in + debug (fun() -> + Util.msg "Removing archive %s\n" (System.fspathToDebugString fspath)); Util.convertUnixErrorsToFatal "removing archive" (fun () -> - if Sys.file_exists f then Sys.remove f)) + if System.file_exists fspath then System.unlink fspath)) (* [removeArchiveOnRoot root v] invokes [removeArchive fspath v] on the server, where [fspath] is the path to root on the server *) @@ -347,11 +351,11 @@ Lwt.return (let (fromname,_) = archiveName fspath ScratchArch in let (toname,_) = archiveName fspath NewArch in - let ffrom = Fspath.toString (Os.fileInUnisonDir fromname) in - let fto = Fspath.toString (Os.fileInUnisonDir toname) in + let ffrom = Os.fileInUnisonDir fromname in + let fto = Os.fileInUnisonDir toname in Util.convertUnixErrorsToFatal "committing" - (fun () -> Unix.rename ffrom fto)) + (fun () -> System.rename ffrom fto)) (* [commitArchiveOnRoot root v] invokes [commitArchive fspath v] on the server, where [fspath] is the path to root on the server *) @@ -366,20 +370,23 @@ Lwt.return (let (fromname,_) = archiveName fspath NewArch in let (toname, thisRoot) = archiveName fspath MainArch in - let ffrom = Fspath.toString (Os.fileInUnisonDir fromname) in - let fto = Fspath.toString (Os.fileInUnisonDir toname) in - debug (fun() -> Util.msg "Copying archive %s to %s\n" ffrom fto); + let ffrom = Os.fileInUnisonDir fromname in + let fto = Os.fileInUnisonDir toname in + debug (fun() -> + Util.msg "Copying archive %s to %s\n" + (System.fspathToDebugString ffrom) + (System.fspathToDebugString fto)); Util.convertUnixErrorsToFatal "copying archive" (fun () -> let outFd = - open_out_gen + System.open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_binary] 0o600 fto in - Unix.chmod fto 0o600; (* In case the file already existed *) - let inFd = open_in_gen [Open_rdonly; Open_binary] 0o444 ffrom in + System.chmod fto 0o600; (* In case the file already existed *) + let inFd = System.open_in_bin ffrom in Uutil.readWrite inFd outFd (fun _ -> ()); close_in inFd; close_out outFd; let arcFspath = Os.fileInUnisonDir toname in - let info = Fileinfo.get false arcFspath Path.empty in + let info = Fileinfo.get' arcFspath in Hashtbl.replace archiveInfoCache thisRoot info)) (* [postCommitArchiveOnRoot root v] invokes [postCommitArchive fspath v] on @@ -450,8 +457,9 @@ let (name, root) = archiveName fspath MainArch in let archive = getArchive root in let f = Util.fileInHomeDir "unison.dump" in - debug (fun () -> Printf.eprintf "Dumping archive into `%s'\n" f); - let ch = open_out_gen [Open_wronly; Open_trunc; Open_creat] 0o600 f in + debug (fun () -> Printf.eprintf "Dumping archive into `%s'\n" + (System.fspathToDebugString f)); + let ch = System.open_out_gen [Open_wronly; Open_creat; Open_trunc] 0o600 f in let (outfn,flushfn) = Format.get_formatter_output_functions () in Format.set_formatter_out_channel ch; Format.printf "Contents of archive for %s\n" root; @@ -483,17 +491,17 @@ (* If the archive is not in a stable state, we need to perform archive recovery. So, the optimistic loading fails. *) - Sys.file_exists (Fspath.toString (Os.fileInUnisonDir newArcName)) + Sys.file_exists newArcName || let (lockFilename, _) = archiveName fspath Lock in - let lockFile = Fspath.toString (Os.fileInUnisonDir lockFilename) in + let lockFile = Os.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 info = Fileinfo.get false arcFspath Path.empty in + let info = Fileinfo.get' arcFspath in if archiveUnchanged fspath info then (* The archive is unchanged. So, we don't need to do anything. *) @@ -501,7 +509,7 @@ else begin match loadArchiveLocal arcFspath thisRoot with Some (arch, hash, magic) -> - let info' = Fileinfo.get false arcFspath Path.empty in + let info' = Fileinfo.get' arcFspath in if fileUnchanged info info' then begin setArchiveLocal thisRoot arch; Hashtbl.replace archiveInfoCache thisRoot info; @@ -517,7 +525,7 @@ match loadArchiveLocal arcFspath thisRoot with Some (arch, hash, magic) -> setArchiveLocal thisRoot arch; - let info = Fileinfo.get false arcFspath Path.empty in + let info = Fileinfo.get' arcFspath in Hashtbl.replace archiveInfoCache thisRoot info; Lwt.return (Some (hash, magic)) | None -> @@ -551,7 +559,8 @@ ^ " b) Move the archive files on each machine to some other directory\n" ^ " (in case they may be useful for debugging).\n" ^ " The archive files on this machine are in the directory\n" - ^ (Printf.sprintf " %s\n" (Fspath.toString Os.unisonDir)) + ^ (Printf.sprintf " %s\n" + (System.fspathToPrintString Os.unisonDir)) ^ " and have names of the form\n" ^ " arXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX\n" ^ " where the X's are a hexidecimal number .\n" @@ -641,12 +650,12 @@ let lockArchiveLocal fspath = let (lockFilename, _) = archiveName fspath Lock in - let lockFile = Fspath.toString (Os.fileInUnisonDir lockFilename) in + let lockFile = Os.fileInUnisonDir lockFilename in if Lock.acquire lockFile then None else Some (Printf.sprintf "The file %s on host %s should be deleted" - lockFile Os.myCanonicalHostName) + (System.fspathToPrintString lockFile) Os.myCanonicalHostName) let lockArchiveOnRoot: Common.root -> unit -> string option Lwt.t = Remote.registerRootCmd @@ -654,7 +663,7 @@ let unlockArchiveLocal fspath = Lock.release - (Fspath.toString (Os.fileInUnisonDir (fst (archiveName fspath Lock)))) + (Os.fileInUnisonDir (fst (archiveName fspath Lock))) let unlockArchiveOnRoot: Common.root -> unit -> unit Lwt.t = Remote.registerRootCmd @@ -746,10 +755,10 @@ (fun (fspath,rootsName) -> let (oldname,_) = archiveName fspath MainArch in let oldexists = - Sys.file_exists (Fspath.toString (Os.fileInUnisonDir oldname)) in + System.file_exists (Os.fileInUnisonDir oldname) in let (newname,_) = archiveName fspath NewArch in let newexists = - Sys.file_exists (Fspath.toString (Os.fileInUnisonDir newname)) in + System.file_exists (Os.fileInUnisonDir newname) in Lwt.return (oldexists, newexists)) let (archiveNameOnRoot @@ -762,7 +771,7 @@ Lwt.return (name, Os.myCanonicalHostName, - Sys.file_exists (Fspath.toString (Os.fileInUnisonDir name)))) + System.file_exists (Os.fileInUnisonDir name))) let forall = Safelist.for_all (fun x -> x) let exists = Safelist.exists (fun x -> x) @@ -863,7 +872,7 @@ debugverbose (fun() -> Printf.eprintf "updatePathInArchive %s %s [%s] [%s]\n" - (archive2string archive) (Fspath.toString fspath) + (archive2string archive) (Fspath.toDebugString fspath) (Path.toString here) (Path.toString rest)); match Path.deconstruct rest with None -> @@ -926,7 +935,7 @@ let isDir fspath path = let fullFspath = Fspath.concat fspath path in try - (Fspath.stat fullFspath).Unix.LargeFile.st_kind = Unix.S_DIR + (Fs.stat fullFspath).Unix.LargeFile.st_kind = Unix.S_DIR with Unix.Unix_error _ -> false (*********************************************************************** @@ -949,7 +958,7 @@ if not (Os.exists fspath path) then raise (Util.Fatal (Printf.sprintf "Path %s / %s is designated as a mountpoint, but points to nothing on host %s\n" - (Fspath.toString fspath) (Path.toString path) Os.myCanonicalHostName))) + (Fspath.toPrintString fspath) (Path.toString path) Os.myCanonicalHostName))) (Prefs.read mountpoints) @@ -1341,7 +1350,7 @@ try debug (fun() -> Util.msg "buildUpdate: %s\n" - (Fspath.concatToString currfspath path)); + (Fspath.toDebugString (Fspath.concat currfspath path))); let info = Fileinfo.get true currfspath path in match (info.Fileinfo.typ, archive) with (`ABSENT, NoArchive) -> @@ -1512,7 +1521,7 @@ items; as a side effect, update the local archive w.r.t. time-stamps for unchanged files *) let findLocal fspath pathList: Common.updateItem list = - debug (fun() -> Util.msg "findLocal %s\n" (Fspath.toString fspath)); + debug (fun() -> Util.msg "findLocal %s\n" (Fspath.toDebugString fspath)); addHashToTempNames fspath; (* Maybe we should remember the device number where the root lives at the beginning of update detection, so that we can check, below, that @@ -1721,7 +1730,7 @@ let updateArchiveLocal fspath path ui id = debug (fun() -> Util.msg "updateArchiveLocal %s %s\n" - (Fspath.toString fspath) (Path.toString path)); + (Fspath.toDebugString fspath) (Path.toString path)); let root = thisRootsGlobalName fspath in let archive = getArchive root in let (localPath, subArch) = getPathInArchive archive Path.empty path in @@ -1756,7 +1765,7 @@ (fun path uc -> debug (fun() -> Util.msg "markEqualLocal %s %s\n" - (Fspath.toString fspath) (Path.toString path)); + (Fspath.toDebugString fspath) (Path.toString path)); let arch, (subArch, localPath) = updatePathInArchive !archive fspath Path.empty path (fun archive _ localPath -> @@ -1824,7 +1833,7 @@ let replaceArchiveLocal fspath pathTo location arch id paranoid deleteBadTempFiles = debug (fun() -> Util.msg "replaceArchiveLocal %s %s\n" - (Fspath.toString fspath) + (Fspath.toDebugString fspath) (Path.toString pathTo) ); let root = thisRootsGlobalName fspath in @@ -1901,7 +1910,7 @@ let updatePropsLocal fspath path propOpt ui id = debug (fun() -> Util.msg "updatePropsLocal %s %s\n" - (Fspath.toString fspath) (Path.toString path)); + (Fspath.toDebugString fspath) (Path.toString path)); let root = thisRootsGlobalName fspath in let commit () = let archive = getArchive root in @@ -1929,7 +1938,7 @@ let checkNoUpdatesLocal fspath pathInArchive ui = debug (fun() -> Util.msg "checkNoUpdatesLocal %s %s\n" - (Fspath.toString fspath) (Path.toString pathInArchive)); + (Fspath.toDebugString fspath) (Path.toString pathInArchive)); let archive = getArchive (thisRootsGlobalName fspath) in let (localPath, archive) = getPathInArchive archive Path.empty pathInArchive in Modified: trunk/src/uutil.ml =================================================================== --- trunk/src/uutil.ml 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/uutil.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -141,3 +141,17 @@ notify !l in Util.convertUnixErrorsToTransient "readWriteBounded" (fun () -> read len) + +(*****************************************************************************) +(* ESCAPING SHELL PARAMETERS *) +(*****************************************************************************) + +(* Using single quotes is simpler under Unix but they are not accepted + by the Windows shell. Double quotes without further quoting is + sufficient with Windows as filenames are not allowed to contain + double quotes. *) +let quotes s = + if Util.osType = `Win32 && not Util.isCygwin then + "\"" ^ s ^ "\"" + else + "'" ^ Util.replacesubstring s "'" "'\\''" ^ "'" Modified: trunk/src/uutil.mli =================================================================== --- trunk/src/uutil.mli 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/uutil.mli 2009-05-13 18:02:17 UTC (rev 331) @@ -63,3 +63,6 @@ -> Filesize.t -> (int -> unit) (* progress notification *) -> unit + +(* Escape shell parameters *) +val quotes : string -> string Modified: trunk/src/xferhint.ml =================================================================== --- trunk/src/xferhint.ml 2009-05-07 10:01:25 UTC (rev 330) +++ trunk/src/xferhint.ml 2009-05-13 18:02:17 UTC (rev 331) @@ -32,7 +32,7 @@ (struct type t = Fspath.t * Path.local let hash (fspath, path) = - (Hashtbl.hash (Fspath.toString fspath) + 13217 * Path.hash path) + (Fspath.hash fspath + 13217 * Path.hash path) land 0x3FFFFFFF let equal = (=) @@ -71,7 +71,7 @@ debug (fun () -> let (fspath, path) = p in Util.msg "insertEntry: fspath=%s, path=%s, fp=%s\n" - (Fspath.toString fspath) + (Fspath.toDebugString fspath) (Path.toString path) (Os.fullfingerprint_to_string fp)); (* Neither of these should be able to raise Not_found *) PathMap.replace path2fingerprintMap p fp; @@ -83,7 +83,7 @@ debug (fun () -> let (fspath, path) = p in Util.msg "deleteEntry: fspath=%s, path=%s\n" - (Fspath.toString fspath) (Path.toString path)); + (Fspath.toDebugString fspath) (Path.toString path)); try let fp = PathMap.find path2fingerprintMap p in PathMap.remove path2fingerprintMap p; @@ -100,8 +100,8 @@ let (fspathOrig, pathOrig) = pOrig in let (fspathNew, pathNew) = pNew in Util.msg "renameEntry: fsOrig=%s, pOrig=%s, fsNew=%s, pNew=%s\n" - (Fspath.toString fspathOrig) (Path.toString pathOrig) - (Fspath.toString fspathNew) (Path.toString pathNew)); + (Fspath.toDebugString fspathOrig) (Path.toString pathOrig) + (Fspath.toDebugString fspathNew) (Path.toString pathNew)); try let fp = PathMap.find path2fingerprintMap pOrig in PathMap.remove path2fingerprintMap pOrig; From Jerome.Vouillon at pps.jussieu.fr Wed May 13 14:11:22 2009 From: Jerome.Vouillon at pps.jussieu.fr (Jerome Vouillon) Date: Wed, 13 May 2009 20:11:22 +0200 Subject: [Unison-hackers] Experimental Unicode support for Windows In-Reply-To: <200905131802.n4DI2dKb017387@yaws.seas.upenn.edu> References: <200905131802.n4DI2dKb017387@yaws.seas.upenn.edu> Message-ID: <20090513181122.GA26650@pps.jussieu.fr> I have just implemented some experimental Unicode support for Windows. This is not activated by default yet (I need to find a way to make it a preference option). But it can be actived by editing file src/system.ml, replacing the line: include System_generic by: include System_win and recompiling. Also, the directive "unicode" has to be set to true in the profile. Testers are welcome. The changes are quite intrusive, so I hope I have not broken too much stuff in the process... -- Jerome From bcpierce at cis.upenn.edu Wed May 13 21:03:48 2009 From: bcpierce at cis.upenn.edu (Benjamin Pierce) Date: Wed, 13 May 2009 21:03:48 -0400 Subject: [Unison-hackers] Experimental Unicode support for Windows In-Reply-To: <20090513181122.GA26650@pps.jussieu.fr> References: <200905131802.n4DI2dKb017387@yaws.seas.upenn.edu> <20090513181122.GA26650@pps.jussieu.fr> Message-ID: <613E1539-7A33-4236-85EA-39C304B03FCC@cis.upenn.edu> Cool. I can report that it compiles, at least. :-) I'll start using it now (with unicode turned off, still) and let you know if anything seems broken... - B On May 13, 2009, at 2:11 PM, Jerome Vouillon wrote: > I have just implemented some experimental Unicode support for > Windows. This is not activated by default yet (I need to find > a way to make it a preference option). But it can be actived by > editing file src/system.ml, replacing the line: > include System_generic > by: > include System_win > and recompiling. > Also, the directive "unicode" has to be set to true in the profile. > > Testers are welcome. > > The changes are quite intrusive, so I hope I have not broken too much > stuff in the process... > > -- Jerome > _______________________________________________ > Unison-hackers mailing list > Unison-hackers at lists.seas.upenn.edu > http://lists.seas.upenn.edu/mailman/listinfo/unison-hackers From vouillon at seas.upenn.edu Thu May 14 11:59:37 2009 From: vouillon at seas.upenn.edu (vouillon@seas.upenn.edu) Date: Thu, 14 May 2009 11:59:37 -0400 Subject: [Unison-hackers] [unison-svn] r332 - in branches/2.32/src: . lwt win32rc Message-ID: <200905141559.n4EFxbov030830@yaws.seas.upenn.edu> Author: vouillon Date: 2009-05-14 11:59:33 -0400 (Thu, 14 May 2009) New Revision: 332 Modified: branches/2.32/src/RECENTNEWS branches/2.32/src/lwt/lwt_unix.ml branches/2.32/src/mkProjectInfo.ml branches/2.32/src/os.ml branches/2.32/src/uigtk2.ml branches/2.32/src/win32rc/U.ico branches/2.32/src/win32rc/unison.rc branches/2.32/src/win32rc/unison.res branches/2.32/src/win32rc/unison.res.lib Log: * Fixed bug in GTK UI: buttons could be incorrectly activated back during synchronization * Improved error message when trying to synchronize a symlink to a Windows machine * Uses improved emulation of "select" call provided by Ocaml 3.11 under Windows (the GUI should not freeze as much during synchronization) * Improved Unison icon Modified: branches/2.32/src/RECENTNEWS =================================================================== --- branches/2.32/src/RECENTNEWS 2009-05-13 18:02:17 UTC (rev 331) +++ branches/2.32/src/RECENTNEWS 2009-05-14 15:59:33 UTC (rev 332) @@ -1,3 +1,14 @@ +CHANGES FROM VERSION 2.32.12 + +* Fixed bug in GTK UI: buttons could be incorrectly activated back during + synchronization +* Improved error message when trying to synchronize a symlink to a + Windows machine +* Uses improved emulation of "select" call provided by Ocaml 3.11 + under Windows (the GUI should not freeze as much during synchronization) +* Improved Unison icon + +------------------------------- CHANGES FROM VERSION 2.32.11 * Fix up docs. Modified: branches/2.32/src/lwt/lwt_unix.ml =================================================================== --- branches/2.32/src/lwt/lwt_unix.ml 2009-05-13 18:02:17 UTC (rev 331) +++ branches/2.32/src/lwt/lwt_unix.ml 2009-05-14 15:59:33 UTC (rev 332) @@ -14,6 +14,9 @@ - [connect] is blocking *) let windows_hack = Sys.os_type <> "Unix" +let recent_ocaml = + Scanf.sscanf Sys.ocaml_version "%d.%d" + (fun maj min -> (maj = 3 && min >= 11) || maj > 3) module SleepQueue = Pqueue.Make (struct @@ -112,7 +115,7 @@ let infds = List.map fst !inputs in let outfds = List.map fst !outputs in let (readers, writers, _) = - if windows_hack then + if windows_hack && not recent_ocaml then let writers = outfds in let readers = if delay = 0. || writers <> [] then [] else infds in Modified: branches/2.32/src/mkProjectInfo.ml =================================================================== --- branches/2.32/src/mkProjectInfo.ml 2009-05-13 18:02:17 UTC (rev 331) +++ branches/2.32/src/mkProjectInfo.ml 2009-05-14 15:59:33 UTC (rev 332) @@ -108,3 +108,4 @@ + Modified: branches/2.32/src/os.ml =================================================================== --- branches/2.32/src/os.ml 2009-05-13 18:02:17 UTC (rev 331) +++ branches/2.32/src/os.ml 2009-05-14 15:59:33 UTC (rev 332) @@ -225,7 +225,11 @@ Unix.symlink l abspath) else fun fspath path l -> - raise (Util.Transient "symlink not supported under Win32") + raise (Util.Transient + (Format.sprintf + "Cannot create symlink \"%s\": \ + symlinks are not supported under Windows" + (Fspath.concatToString fspath path))) (* Create a new directory, using the permissions from the given props *) let createDir fspath path props = Modified: branches/2.32/src/uigtk2.ml =================================================================== --- branches/2.32/src/uigtk2.ml 2009-05-13 18:02:17 UTC (rev 331) +++ branches/2.32/src/uigtk2.ml 2009-05-14 15:59:33 UTC (rev 332) @@ -1443,8 +1443,10 @@ ) | None, _ -> (false, true, false) in - grSet grAction activate1; - grSet grDiff activate2; + if not !busy then begin + grSet grAction activate1; + grSet grDiff activate2 + end; if details then showDetailsButton#misc#show () else Modified: branches/2.32/src/win32rc/U.ico =================================================================== (Binary files differ) Modified: branches/2.32/src/win32rc/unison.rc =================================================================== --- branches/2.32/src/win32rc/unison.rc 2009-05-13 18:02:17 UTC (rev 331) +++ branches/2.32/src/win32rc/unison.rc 2009-05-14 15:59:33 UTC (rev 332) @@ -1,80 +1,3 @@ #include UNISON_ICON ICON "U.ico" -X_cursor CURSOR DISCARDABLE "cursor00.cur" -arrow CURSOR DISCARDABLE "cursor02.cur" -based_arrow_down CURSOR DISCARDABLE "cursor04.cur" -based_arrow_up CURSOR DISCARDABLE "cursor06.cur" -boat CURSOR DISCARDABLE "cursor08.cur" -bogosity CURSOR DISCARDABLE "cursor0a.cur" -bottom_left_corner CURSOR DISCARDABLE "cursor0c.cur" -bottom_right_corner CURSOR DISCARDABLE "cursor0e.cur" -bottom_side CURSOR DISCARDABLE "cursor10.cur" -bottom_tee CURSOR DISCARDABLE "cursor12.cur" -box_spiral CURSOR DISCARDABLE "cursor14.cur" -center_ptr CURSOR DISCARDABLE "cursor16.cur" -circle CURSOR DISCARDABLE "cursor18.cur" -clock CURSOR DISCARDABLE "cursor1a.cur" -coffee_mug CURSOR DISCARDABLE "cursor1c.cur" -cross CURSOR DISCARDABLE "cursor1e.cur" -cross_reverse CURSOR DISCARDABLE "cursor20.cur" -crosshair CURSOR DISCARDABLE "cursor22.cur" -diamond_cross CURSOR DISCARDABLE "cursor24.cur" -dot CURSOR DISCARDABLE "cursor26.cur" -dotbox CURSOR DISCARDABLE "cursor28.cur" -double_arrow CURSOR DISCARDABLE "cursor2a.cur" -draft_large CURSOR DISCARDABLE "cursor2c.cur" -draft_small CURSOR DISCARDABLE "cursor2e.cur" -draped_box CURSOR DISCARDABLE "cursor30.cur" -exchange CURSOR DISCARDABLE "cursor32.cur" -fleur CURSOR DISCARDABLE "cursor34.cur" -gobbler CURSOR DISCARDABLE "cursor36.cur" -gumby CURSOR DISCARDABLE "cursor38.cur" -hand1 CURSOR DISCARDABLE "cursor3a.cur" -hand2 CURSOR DISCARDABLE "cursor3c.cur" -heart CURSOR DISCARDABLE "cursor3e.cur" -icon CURSOR DISCARDABLE "cursor40.cur" -iron_cross CURSOR DISCARDABLE "cursor42.cur" -left_ptr CURSOR DISCARDABLE "cursor44.cur" -left_side CURSOR DISCARDABLE "cursor46.cur" -left_tee CURSOR DISCARDABLE "cursor48.cur" -leftbutton CURSOR DISCARDABLE "cursor4a.cur" -ll_angle CURSOR DISCARDABLE "cursor4c.cur" -lr_angle CURSOR DISCARDABLE "cursor4e.cur" -man CURSOR DISCARDABLE "cursor50.cur" -middlebutton CURSOR DISCARDABLE "cursor52.cur" -mouse CURSOR DISCARDABLE "cursor54.cur" -pencil CURSOR DISCARDABLE "cursor56.cur" -pirate CURSOR DISCARDABLE "cursor58.cur" -plus CURSOR DISCARDABLE "cursor5a.cur" -question_arrow CURSOR DISCARDABLE "cursor5c.cur" -right_ptr CURSOR DISCARDABLE "cursor5e.cur" -right_side CURSOR DISCARDABLE "cursor60.cur" -right_tee CURSOR DISCARDABLE "cursor62.cur" -rightbutton CURSOR DISCARDABLE "cursor64.cur" -rtl_logo CURSOR DISCARDABLE "cursor66.cur" -sailboat CURSOR DISCARDABLE "cursor68.cur" -sb_down_arrow CURSOR DISCARDABLE "cursor6a.cur" -sb_h_double_arrow CURSOR DISCARDABLE "cursor6c.cur" -sb_left_arrow CURSOR DISCARDABLE "cursor6e.cur" -sb_right_arrow CURSOR DISCARDABLE "cursor70.cur" -sb_up_arrow CURSOR DISCARDABLE "cursor72.cur" -sb_v_double_arrow CURSOR DISCARDABLE "cursor74.cur" -shuttle CURSOR DISCARDABLE "cursor76.cur" -sizing CURSOR DISCARDABLE "cursor78.cur" -spider CURSOR DISCARDABLE "cursor7a.cur" -spraycan CURSOR DISCARDABLE "cursor7c.cur" -star CURSOR DISCARDABLE "cursor7e.cur" -target CURSOR DISCARDABLE "cursor80.cur" -tcross CURSOR DISCARDABLE "cursor82.cur" -top_left_arrow CURSOR DISCARDABLE "cursor84.cur" -top_left_corner CURSOR DISCARDABLE "cursor86.cur" -top_right_corner CURSOR DISCARDABLE "cursor88.cur" -top_side CURSOR DISCARDABLE "cursor8a.cur" -top_tee CURSOR DISCARDABLE "cursor8c.cur" -trek CURSOR DISCARDABLE "cursor8e.cur" -ul_angle CURSOR DISCARDABLE "cursor90.cur" -umbrella CURSOR DISCARDABLE "cursor92.cur" -ur_angle CURSOR DISCARDABLE "cursor94.cur" -xterm CURSOR DISCARDABLE "cursor98.cur" -watch CURSOR DISCARDABLE "cursor96.cur" Modified: branches/2.32/src/win32rc/unison.res =================================================================== (Binary files differ) Modified: branches/2.32/src/win32rc/unison.res.lib =================================================================== (Binary files differ) From vouillon at seas.upenn.edu Fri May 15 10:34:52 2009 From: vouillon at seas.upenn.edu (vouillon@seas.upenn.edu) Date: Fri, 15 May 2009 10:34:52 -0400 Subject: [Unison-hackers] [unison-svn] r333 - in trunk/src: . lwt system system/generic system/win ubase Message-ID: <200905151434.n4FEYqSs029993@yaws.seas.upenn.edu> Author: vouillon Date: 2009-05-15 10:34:43 -0400 (Fri, 15 May 2009) New Revision: 333 Added: trunk/src/system.ml trunk/src/system/ trunk/src/system/generic/ trunk/src/system/generic/system_impl.ml trunk/src/system/system_generic.ml trunk/src/system/system_intf.ml trunk/src/system/system_win.ml trunk/src/system/system_win_stubs.c trunk/src/system/win/ trunk/src/system/win/system_impl.ml Removed: trunk/src/system.ml trunk/src/system_generic.ml trunk/src/system_intf.ml trunk/src/system_win.ml trunk/src/system_win_stubs.c Modified: trunk/src/.depend trunk/src/Makefile.OCaml trunk/src/RECENTNEWS trunk/src/case.ml trunk/src/case.mli trunk/src/copy.ml trunk/src/fs.ml trunk/src/fs.mli trunk/src/fspath.ml trunk/src/lwt/lwt_unix.ml trunk/src/mkProjectInfo.ml trunk/src/os.ml trunk/src/osx.ml trunk/src/pty.c trunk/src/remote.ml trunk/src/terminal.ml trunk/src/ubase/depend trunk/src/uigtk2.ml Log: * Bumped minor version: incompatible protocol changes * The use of the Windows Unicode API is now controlled via the "unicode" directive * Fixed bug in GTK UI: buttons could be incorrectly reenabled during synchronization * Improved error message when trying to synchronize a symlink to a Windows machine * Fixed compilation warnings in lwt_unix.ml and pty.c * Added some missing convertUnixErrorsToTransient Modified: trunk/src/.depend =================================================================== --- trunk/src/.depend 2009-05-14 15:59:33 UTC (rev 332) +++ trunk/src/.depend 2009-05-15 14:34:43 UTC (rev 333) @@ -12,7 +12,7 @@ lwt/lwt.cmi common.cmi fileutil.cmi: fingerprint.cmi: uutil.cmi path.cmi fspath.cmi -fs.cmi: system_intf.cmo fspath.cmi +fs.cmi: system/system_intf.cmo fspath.cmi fspath.cmi: system.cmi path.cmi name.cmi globals.cmi: ubase/prefs.cmi path.cmi lwt/lwt.cmi common.cmi lock.cmi: system.cmi @@ -27,7 +27,7 @@ sortri.cmi: common.cmi stasher.cmi: ubase/prefs.cmi path.cmi os.cmi fspath.cmi strings.cmi: -system.cmi: system_intf.cmo +system.cmi: system/system_intf.cmo terminal.cmi: test.cmi: transfer.cmi: uutil.cmi lwt/lwt.cmi @@ -87,8 +87,8 @@ fileutil.cmx: fileutil.cmi fingerprint.cmo: uutil.cmi ubase/util.cmi fspath.cmi fs.cmi fingerprint.cmi fingerprint.cmx: uutil.cmx ubase/util.cmx fspath.cmx fs.cmx fingerprint.cmi -fs.cmo: ubase/util.cmi system.cmi fspath.cmi fs.cmi -fs.cmx: ubase/util.cmx system.cmx fspath.cmx fs.cmi +fs.cmo: ubase/util.cmi fspath.cmi fs.cmi +fs.cmx: ubase/util.cmx fspath.cmx fs.cmi fspath.cmo: uutil.cmi ubase/util.cmi system.cmi ubase/rx.cmi path.cmi \ name.cmi fileutil.cmi fspath.cmi fspath.cmx: uutil.cmx ubase/util.cmx system.cmx ubase/rx.cmx path.cmx \ @@ -167,14 +167,8 @@ fileutil.cmx fileinfo.cmx copy.cmx common.cmx stasher.cmi strings.cmo: strings.cmi strings.cmx: strings.cmi -system_generic.cmo: -system_generic.cmx: -system_intf.cmo: -system_intf.cmx: -system.cmo: system_win.cmo system.cmi -system.cmx: system_win.cmx system.cmi -system_win.cmo: unicode.cmi ubase/rx.cmi -system_win.cmx: unicode.cmx ubase/rx.cmx +system.cmo: system.cmi +system.cmx: system.cmi terminal.cmo: ubase/safelist.cmi ubase/rx.cmi lwt/lwt_unix.cmi lwt/lwt.cmi \ terminal.cmi terminal.cmx: ubase/safelist.cmx ubase/rx.cmx lwt/lwt_unix.cmx lwt/lwt.cmx \ @@ -289,6 +283,12 @@ lwt/lwt_util.cmx: lwt/lwt.cmx lwt/lwt_util.cmi lwt/pqueue.cmo: lwt/pqueue.cmi lwt/pqueue.cmx: lwt/pqueue.cmi +system/system_generic.cmo: +system/system_generic.cmx: +system/system_intf.cmo: +system/system_intf.cmx: +system/system_win.cmo: unicode.cmi ubase/rx.cmi +system/system_win.cmx: unicode.cmx ubase/rx.cmx ubase/myMap.cmo: ubase/myMap.cmi ubase/myMap.cmx: ubase/myMap.cmi ubase/prefs.cmo: ubase/util.cmi ubase/uarg.cmi system.cmi ubase/safelist.cmi \ @@ -325,3 +325,11 @@ ubase/uarg.cmi: ubase/uprintf.cmi: ubase/util.cmi: system.cmi +lwt/example/editor.cmo: lwt/lwt_unix.cmi +lwt/example/editor.cmx: lwt/lwt_unix.cmx +lwt/example/relay.cmo: lwt/lwt_unix.cmi lwt/lwt.cmi +lwt/example/relay.cmx: lwt/lwt_unix.cmx lwt/lwt.cmx +system/generic/system_impl.cmo: system/system_generic.cmo +system/generic/system_impl.cmx: system/system_generic.cmx +system/win/system_impl.cmo: system/system_win.cmo system/system_generic.cmo +system/win/system_impl.cmx: system/system_win.cmx system/system_generic.cmx Modified: trunk/src/Makefile.OCaml =================================================================== --- trunk/src/Makefile.OCaml 2009-05-14 15:59:33 UTC (rev 332) +++ trunk/src/Makefile.OCaml 2009-05-15 14:34:43 UTC (rev 333) @@ -83,8 +83,9 @@ #################################################################### ### Default parameters -INCLFLAGS=-I lwt -I ubase +INCLFLAGS=-I lwt -I ubase -I system CAMLFLAGS+=$(INCLFLAGS) +CAMLFLAGS+=-I system/$(SYSTEM) ifeq ($(OSARCH),win32) # Win32 system @@ -98,8 +99,9 @@ # issue." # CLIBS+=-cclib win32rc/unison.res # STATICLIBS+=-cclib win32rc/unison.res - COBJS+=system_win_stubs$(OBJ_EXT) - WINOBJS=system_win.cmo + COBJS+=system/system_win_stubs$(OBJ_EXT) + WINOBJS=system/system_win.cmo + SYSTEM=win CLIBS+=-cclib "-link win32rc/unison.res" STATICLIBS+=-cclib "-link win32rc/unison.res" buildexecutable:: @@ -110,8 +112,9 @@ ifeq ($(OSARCH),win32gnuc) CWD=. EXEC_EXT=.exe - COBJS+=system_win_stubs$(OBJ_EXT) - WINOBJS=system_win.cmo + COBJS+=system/system_win_stubs$(OBJ_EXT) + WINOBJS=system/system_win.cmo + SYSTEM=win CLIBS+=-cclib win32rc/unison.res.lib STATIC=false # Cygwin is not MinGW :-( buildexecutable:: @@ -119,6 +122,8 @@ else CWD=$(shell pwd) EXEC_EXT= + WINOBJS= + SYSTEM=generic # openpty is in the libutil library ifneq ($(OSARCH),solaris) ifneq ($(OSARCH),osx) @@ -183,7 +188,9 @@ ubase/rx.cmo \ \ unicode_tables.cmo unicode.cmo \ - $(WINOBJS) system_generic.cmo system.cmo \ + $(WINOBJS) system/system_generic.cmo \ + system/$(SYSTEM)/system_impl.cmo \ + system.cmo \ \ ubase/projectInfo.cmo ubase/myMap.cmo ubase/safelist.cmo \ ubase/uprintf.cmo ubase/util.cmo ubase/uarg.cmo \ @@ -275,6 +282,9 @@ # Include an automatically generated list of dependencies include .depend +# Additional dependencied depending on the system +system.cmo fs.cmo: system/$(SYSTEM)/system_impl.cmo +system.cmx fs.cmx: system/$(SYSTEM)/system_impl.cmx ifeq ($(OSARCH), OpenBSD) ifeq ($(shell echo type ocamldot | ksh), file) @@ -293,7 +303,7 @@ # Rebuild dependencies (must be invoked manually) .PHONY: depend depend:: - ocamldep $(INCLFLAGS) *.mli *.ml */*.ml */*.mli > .depend + ocamldep $(INCLFLAGS) *.mli *.ml */*.ml */*.mli */*/*.ml */*/*.mli > .depend ifdef OCAMLDOT echo 'digraph G {' > dot.tmp echo '{ rank = same; "Fileinfo"; "Props"; "Fspath"; "Os"; "Path"; }'\ @@ -377,7 +387,7 @@ %.o %.obj: %.c @echo "$(OCAMLOPT): $< ---> $@" - $(CAMLC) $(CAMLFLAGS) -c $(CWD)/$< + $(CAMLC) $(CAMLFLAGS) -ccopt -o -ccopt $(CWD)/$@ -c $(CWD)/$< $(NAME)$(EXEC_EXT): $(CAMLOBJS) $(COBJS) @echo Linking $@ @@ -402,6 +412,7 @@ -$(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} .PHONY: paths paths: Modified: trunk/src/RECENTNEWS =================================================================== --- trunk/src/RECENTNEWS 2009-05-14 15:59:33 UTC (rev 332) +++ trunk/src/RECENTNEWS 2009-05-15 14:34:43 UTC (rev 333) @@ -1,3 +1,16 @@ +CHANGES FROM VERSION 2.34.0 + +* Bumped minor version: incompatible protocol changes +* The use of the Windows Unicode API is now controlled via the + "unicode" directive +* Fixed bug in GTK UI: buttons could be incorrectly reenabled during + synchronization +* Improved error message when trying to synchronize a symlink to a + Windows machine +* Fixed compilation warnings in lwt_unix.ml and pty.c +* Added some missing convertUnixErrorsToTransient + +------------------------------- CHANGES FROM VERSION 2.33.2 * Added an abstraction layer over Unix/Sys modules in order to be able Modified: trunk/src/case.ml =================================================================== --- trunk/src/case.ml 2009-05-14 15:59:33 UTC (rev 332) +++ trunk/src/case.ml 2009-05-15 14:34:43 UTC (rev 333) @@ -34,18 +34,33 @@ ^ "useful to set the flag manually (e.g. when running Unison on a " ^ "Unix system with a FAT [Windows] volume mounted).") -let unicodeEncoding = - Prefs.createBool "unicode" false - "!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" - (* Defining this variable as a preference ensures that it will be propagated to the other host during initialization *) let someHostIsInsensitive = Prefs.createBool "someHostIsInsensitive" false "*Pseudo-preference for internal use only" "" +let unicodePref = + Prefs.createString "unicode" "default" + "!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" + +let unicodeEncoding = + Prefs.createBool "unicodeEncoding" false + "*Pseudo-preference for internal use only" "" + +(* Whether we default to Unicode encoding on OSX and Windows *) +(* !!! the minor version should be increased whenever *) +(* !!! this default is changed *) +let defaultToUnicode = false + +let useUnicode pref b = + pref = "yes" || pref = "true" || + (defaultToUnicode && pref = "default" && b) + +let useUnicodeAPI pref = useUnicode pref (Util.osType = `Win32) + (* 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 *) (* by storing the information in a pref so that it is propagated to the *) @@ -54,7 +69,8 @@ Prefs.set someHostIsInsensitive (Prefs.read caseInsensitiveMode = "yes" || Prefs.read caseInsensitiveMode = "true" || - (Prefs.read caseInsensitiveMode = "default" && b)) + (Prefs.read caseInsensitiveMode = "default" && b)); + Prefs.set unicodeEncoding (useUnicode (Prefs.read unicodePref) b) (****) Modified: trunk/src/case.mli =================================================================== --- trunk/src/case.mli 2009-05-14 15:59:33 UTC (rev 332) +++ trunk/src/case.mli 2009-05-15 14:34:43 UTC (rev 333) @@ -1,7 +1,9 @@ (* Unison file synchronizer: src/case.mli *) (* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) +val unicodePref : string Prefs.t val unicodeEncoding : bool Prefs.t +val useUnicodeAPI : string -> bool type mode Modified: trunk/src/copy.ml =================================================================== --- trunk/src/copy.ml 2009-05-14 15:59:33 UTC (rev 332) +++ trunk/src/copy.ml 2009-05-15 14:34:43 UTC (rev 333) @@ -565,10 +565,11 @@ info.Fileinfo.typ = `FILE && (match checkSize with `MakeWriteableAndCheckNonempty -> - let n = Fspath.concat fspathTo pathTo in let perms = Props.perms info.Fileinfo.desc in let perms' = perms lor 0o600 in - Fs.chmod n perms'; + Util.convertUnixErrorsToTransient + "making target writable" + (fun () -> Fs.chmod (Fspath.concat fspathTo pathTo) perms'); Props.length info.Fileinfo.desc > Uutil.Filesize.zero | `CheckDataSize desc -> Props.length info.Fileinfo.desc = Props.length desc Modified: trunk/src/fs.ml =================================================================== --- trunk/src/fs.ml 2009-05-14 15:59:33 UTC (rev 332) +++ trunk/src/fs.ml 2009-05-15 14:34:43 UTC (rev 333) @@ -15,44 +15,46 @@ along with this program. If not, see . *) +module System = System_impl.Fs + type fspath = Fspath.t type dir_handle = System.dir_handle -let symlink l f = System.symlink l (Fspath.toSysPath f) +let symlink l f = System.symlink l (Fspath.toString f) -let readlink f = System.readlink (Fspath.toSysPath f) +let readlink f = System.readlink (Fspath.toString f) -let chown f usr grp = System.chown (Fspath.toSysPath f) usr grp +let chown f usr grp = System.chown (Fspath.toString f) usr grp -let chmod f mode = System.chmod (Fspath.toSysPath f) mode +let chmod f mode = System.chmod (Fspath.toString f) mode -let utimes f t1 t2 = System.utimes (Fspath.toSysPath f) t1 t2 +let utimes f t1 t2 = System.utimes (Fspath.toString f) t1 t2 -let unlink f = System.unlink (Fspath.toSysPath f) +let unlink f = System.unlink (Fspath.toString f) -let rmdir f = System.rmdir (Fspath.toSysPath f) +let rmdir f = System.rmdir (Fspath.toString f) -let mkdir f mode = System.mkdir (Fspath.toSysPath f) mode +let mkdir f mode = System.mkdir (Fspath.toString f) mode -let rename f f' = System.rename (Fspath.toSysPath f) (Fspath.toSysPath f') +let rename f f' = System.rename (Fspath.toString f) (Fspath.toString f') -let stat f = System.stat (Fspath.toSysPath f) +let stat f = System.stat (Fspath.toString f) -let lstat f = System.lstat (Fspath.toSysPath f) +let lstat f = System.lstat (Fspath.toString f) -let openfile f flags perms = System.openfile (Fspath.toSysPath f) flags perms +let openfile f flags perms = System.openfile (Fspath.toString f) flags perms -let opendir f = System.opendir (Fspath.toSysPath f) +let opendir f = System.opendir (Fspath.toString f) let readdir = System.readdir let closedir = System.closedir let open_in_gen flags mode f = - System.open_in_gen flags mode (Fspath.toSysPath f) + System.open_in_gen flags mode (Fspath.toString f) let open_out_gen flags mode f = - System.open_out_gen flags mode (Fspath.toSysPath f) + System.open_out_gen flags mode (Fspath.toString f) (****) @@ -73,11 +75,6 @@ d let canSetTime f = - Util.osType <> `Win32 || - try - Unix.access (System.fspathToString (Fspath.toSysPath f)) [Unix.W_OK]; - true - with - Unix.Unix_error _ -> false + System.canSetTime (Util.osType <> `Win32) (Fspath.toString f) -let useUnicodeEncoding _ = () +let setUnicodeEncoding = System.setUnicodeEncoding Modified: trunk/src/fs.mli =================================================================== --- trunk/src/fs.mli 2009-05-14 15:59:33 UTC (rev 332) +++ trunk/src/fs.mli 2009-05-15 14:34:43 UTC (rev 333) @@ -8,4 +8,4 @@ val digestFile : Fspath.t -> string val canSetTime : Fspath.t -> bool -val useUnicodeEncoding : bool -> unit +val setUnicodeEncoding : bool -> unit Modified: trunk/src/fspath.ml =================================================================== --- trunk/src/fspath.ml 2009-05-14 15:59:33 UTC (rev 332) +++ trunk/src/fspath.ml 2009-05-15 14:34:43 UTC (rev 333) @@ -28,11 +28,7 @@ (* All fspaths are absolute *) (* - *) -module Fs = struct - let getcwd = System.getcwd - let chdir = System.chdir - let readlink = System.readlink -end +module Fs = System_impl.Fs let debug = Util.debug "fspath" let debugverbose = Util.debug "fsspath+" @@ -240,9 +236,7 @@ (* Filename, and Sys modules of ocaml have subtle differences under Windows *) (* and Unix. So, be very careful with any changes !!! *) let canonizeFspath p0 = - let p = - System.fspathFromString - (match p0 with None -> "." | Some "" -> "." | Some s -> s) in + let p = match p0 with None -> "." | Some "" -> "." | Some s -> s in let p' = begin let original = Fs.getcwd() in @@ -251,7 +245,7 @@ (Fs.chdir p; (* This might raise Sys_error *) Fs.getcwd()) in Fs.chdir original; - System.fspathToString newp + newp with Sys_error why -> (* We could not chdir to p. Either *) @@ -264,18 +258,17 @@ (* fails, we just quit. This works nicely for most cases of (1), *) (* it works for (2), and on (3) it may leave a mess for someone *) (* else to pick up. *) - let p = System.fspathToString p in let p = if Util.osType = `Win32 then Fileutil.backslashes2forwardslashes p else p in if isRootDir p then raise (Util.Fatal (Printf.sprintf "Cannot find canonical name of root directory %s\n(%s)" p why)); let parent = myDirname p in let parent' = begin - (try Fs.chdir (System.fspathFromString parent) with + (try Fs.chdir parent with Sys_error why2 -> raise (Util.Fatal (Printf.sprintf "Cannot find canonical name of %s: unable to cd either to it\n (%s)\nor to its parent %s\n(%s)" p why parent why2))); - System.fspathToString (Fs.getcwd()) end in + Fs.getcwd() end in Fs.chdir original; let bn = Filename.basename p in if bn="" then parent' @@ -307,30 +300,27 @@ let maxlinks = 100 let findWorkingDir fspath path = - let abspath = toSysPath (concat fspath path) in + let abspath = toString (concat fspath path) in let realpath = if not (Path.followLink path) then abspath else let rec followlinks n p = if n>=maxlinks then raise (Util.Transient (Printf.sprintf - "Too many symbolic links from %s" - (System.fspathToPrintString abspath))); + "Too many symbolic links from %s" abspath)); try let link = Fs.readlink p in let linkabs = if Filename.is_relative link then - System.fspathConcat (System.fspathDirname p) link - else System.fspathFromString link in + Fs.fspathConcat (Fs.fspathDirname p) link + else link in followlinks (n+1) linkabs with Unix.Unix_error _ -> p in followlinks 0 abspath in - let realpath = System.fspathToString realpath in if isRootDir realpath then raise (Util.Transient(Printf.sprintf - "The path %s is a root directory" - (System.fspathToPrintString abspath))); + "The path %s is a root directory" abspath)); let realpath = Fileutil.removeTrailingSlashes realpath in let p = Filename.basename realpath in debug Modified: trunk/src/lwt/lwt_unix.ml =================================================================== --- trunk/src/lwt/lwt_unix.ml 2009-05-14 15:59:33 UTC (rev 332) +++ trunk/src/lwt/lwt_unix.ml 2009-05-15 14:34:43 UTC (rev 333) @@ -280,8 +280,7 @@ let system cmd = match Unix.fork () with 0 -> begin try - Unix.execv "/bin/sh" [| "/bin/sh"; "-c"; cmd |]; - assert false + Unix.execv "/bin/sh" [| "/bin/sh"; "-c"; cmd |] with _ -> exit 127 end @@ -380,8 +379,7 @@ Unix.close output end; List.iter Unix.close toclose; - Unix.execv "/bin/sh" [| "/bin/sh"; "-c"; cmd |]; - exit 127 + Unix.execv "/bin/sh" [| "/bin/sh"; "-c"; cmd |] | id -> Hashtbl.add popen_processes proc id let open_process_in cmd = @@ -423,8 +421,7 @@ Unix.dup2 output Unix.stdout; Unix.close output; Unix.dup2 error Unix.stderr; Unix.close error; List.iter Unix.close toclose; - Unix.execve "/bin/sh" [| "/bin/sh"; "-c"; cmd |] env; - exit 127 + Unix.execve "/bin/sh" [| "/bin/sh"; "-c"; cmd |] env | id -> Hashtbl.add popen_processes proc id let open_process_full cmd env = Modified: trunk/src/mkProjectInfo.ml =================================================================== --- trunk/src/mkProjectInfo.ml 2009-05-14 15:59:33 UTC (rev 332) +++ trunk/src/mkProjectInfo.ml 2009-05-15 14:34:43 UTC (rev 333) @@ -5,8 +5,8 @@ let projectName = "unison" let majorVersion = 2 -let minorVersion = 33 -let pointVersionOrigin = 325 (* Revision that corresponds to point version 0 *) +let minorVersion = 34 +let pointVersionOrigin = 332 (* Revision that corresponds to point version 0 *) (* Documentation: This is a program to construct a version of the form Major.Minor.Point, @@ -65,7 +65,7 @@ Str.matched_group 1 str;; let extract_int re str = int_of_string (extract_str re str);; -let revisionString = "$Rev: 327$";; +let revisionString = "$Rev: 332$";; let pointVersion = if String.length revisionString > 5 then Scanf.sscanf revisionString "$Rev: %d " (fun x -> x) - pointVersionOrigin else (* Determining the pointVersionOrigin in bzr is kind of tricky: @@ -148,3 +148,4 @@ + Modified: trunk/src/os.ml =================================================================== --- trunk/src/os.ml 2009-05-14 15:59:33 UTC (rev 332) +++ trunk/src/os.ml 2009-05-15 14:34:43 UTC (rev 333) @@ -210,7 +210,11 @@ Fs.symlink l abspath) else fun fspath path l -> - raise (Util.Transient "symlink not supported under Win32") + raise (Util.Transient + (Format.sprintf + "Cannot create symlink \"%s\": \ + symlinks are not supported under Windows" + (Fspath.toPrintString (Fspath.concat fspath path)))) (* Create a new directory, using the permissions from the given props *) let createDir fspath path props = Modified: trunk/src/osx.ml =================================================================== --- trunk/src/osx.ml 2009-05-14 15:59:33 UTC (rev 332) +++ trunk/src/osx.ml 2009-05-15 14:34:43 UTC (rev 333) @@ -230,7 +230,9 @@ "") (fun () -> close_in_noerr inch) in - let stats = Fs.stat doublePath in + let stats = + Util.convertUnixErrorsToTransient "stating AppleDouble file" + (fun () -> Fs.stat doublePath) in { ressInfo = if rsrcLength = 0L then NoRess else AppleDoubleRess Modified: trunk/src/pty.c =================================================================== --- trunk/src/pty.c 2009-05-14 15:59:33 UTC (rev 332) +++ trunk/src/pty.c 2009-05-15 14:34:43 UTC (rev 333) @@ -52,12 +52,14 @@ #else // not HAS_OPENPTY +#define Nothing ((value) 0) + CAMLprim value setControllingTerminal(value fdVal) { - unix_error (ENOSYS, "setControllingTerminal", NULL); + unix_error (ENOSYS, "setControllingTerminal", Nothing); } CAMLprim value c_openpty() { - unix_error (ENOSYS, "openpty", NULL); + unix_error (ENOSYS, "openpty", Nothing); } #endif Modified: trunk/src/remote.ml =================================================================== --- trunk/src/remote.ml 2009-05-14 15:59:33 UTC (rev 332) +++ trunk/src/remote.ml 2009-05-15 14:34:43 UTC (rev 333) @@ -15,14 +15,6 @@ along with this program. If not, see . *) - -(* -XXX -- Check exception handling -- Use Lwt_unix.system for the merge function - (Unix.open_process_in for diff) -*) - let (>>=) = Lwt.bind let debug = Trace.debug "remote" @@ -474,21 +466,17 @@ (* List containing the connected hosts and the file descriptors of the communication. *) -(* -(* Perhaps the list would be better indexed by root - (host name [+ user name] [+ socket]) ... *) -let connectedHosts = ref [] +let connectionsByHosts = ref [] (* Gets the Read/Write file descriptors for a host; the connection must have been set up by canonizeRoot before calling *) let hostConnection host = - try Safelist.assoc host !connectedHosts + try Safelist.assoc host !connectionsByHosts with Not_found -> - raise(Util.Fatal "hostConnection") -*) + raise(Util.Fatal "Remote.hostConnection") -(* connectedHosts is a list of command-line roots, their corresponding - canonical host names and canonical fspaths, and their connections. +(* connectedHosts is a list of command-line roots and their corresponding + canonical host names. Local command-line roots are not in the list. Although there can only be one remote host per sync, it's possible connectedHosts to hold more than one hosts if more than one sync is @@ -497,23 +485,7 @@ same canonical root. *) let connectedHosts = ref [] -let hostConnection host = (* host must be canonical *) - let rec loop = function - [] -> raise(Util.Fatal "Remote.hostConnection") - | (cl,h,fspath,conn)::tl -> if h=host then conn else loop tl in - loop !connectedHosts -let canonize clroot = (* connection for clroot must have been set up already *) - match clroot with - Clroot.ConnectLocal s -> (Common.Local, Fspath.canonize s) - | _ -> - let rec loop = function - [] -> raise(Util.Fatal "Remote.canonize") - | (cl,h,fspath,conn)::tl -> - if cl=clroot then (Common.Remote h,fspath) else loop tl in - loop !connectedHosts - - (********************************************************************** CLIENT/SERVER PROTOCOLS **********************************************************************) @@ -943,37 +915,66 @@ end; initConnection i2 o1 +let canonizeLocally s unicode = + (* We need to select the proper API in order to compute correctly the + canonical fspath *) + Fs.setUnicodeEncoding (Case.useUnicodeAPI unicode); + Fspath.canonize s + let canonizeOnServer = registerServerCmd "canonizeOnServer" - (fun _ s -> Lwt.return (Os.myCanonicalHostName, Fspath.canonize s)) + (fun _ (s, unicode) -> + Lwt.return (Os.myCanonicalHostName, canonizeLocally s unicode)) +let canonize clroot = (* connection for clroot must have been set up already *) + match clroot with + Clroot.ConnectLocal s -> + (Common.Local, canonizeLocally s (Prefs.read Case.unicodePref)) + | _ -> + match + try + Some (Safelist.assoc clroot !connectedHosts) + with Not_found -> + None + with + None -> raise (Util.Fatal "Remote.canonize") + | Some (h, fspath, _) -> (Common.Remote h, fspath) + +let listReplace v l = v :: Safelist.remove_assoc (fst v) l + +let rec hostFspath clroot = + try + let (_, _, ioServer) = Safelist.assoc clroot !connectedHosts in + Some (Lwt.return ioServer) + with Not_found -> + None + let canonizeRoot rootName clroot termInteract = + let unicode = Prefs.read Case.unicodePref in let finish ioServer s = - canonizeOnServer ioServer s >>= (fun (host, fspath) -> - connectedHosts := (clroot,host,fspath,ioServer)::(!connectedHosts); + (* We need to always compute the fspath as it depends on + unicode settings *) + canonizeOnServer ioServer (s, unicode) >>= (fun (host, fspath) -> + connectedHosts := + listReplace (clroot, (host, fspath, ioServer)) !connectedHosts; + connectionsByHosts := listReplace (host, ioServer) !connectionsByHosts; Lwt.return (Common.Remote host,fspath)) in - let rec hostfspath = function - [] -> None - | (clroot',host,fspath,_)::tl -> - if clroot=clroot' - then Some(Lwt.return(Common.Remote host,fspath)) - else hostfspath tl in match clroot with Clroot.ConnectLocal s -> - Lwt.return (Common.Local, Fspath.canonize s) + Lwt.return (Common.Local, canonizeLocally s unicode) | Clroot.ConnectBySocket(host,port,s) -> - (match hostfspath !connectedHosts with + begin match hostFspath clroot with Some x -> x - | None -> - buildSocketConnection host port >>= (fun ioServer -> - finish ioServer s)) + | None -> buildSocketConnection host port + end >>= fun ioServer -> + finish ioServer s | Clroot.ConnectByShell(shell,host,userOpt,portOpt,s) -> - (match hostfspath !connectedHosts with + begin match hostFspath clroot with Some x -> x - | None -> - buildShellConnection - shell host userOpt portOpt rootName termInteract >>= - (fun ioServer -> finish ioServer s)) + | None -> buildShellConnection + shell host userOpt portOpt rootName termInteract + end >>= fun ioServer -> + finish ioServer s (* A new interface, useful for terminal interaction, it should eventually replace canonizeRoot and buildShellConnection *) @@ -993,80 +994,97 @@ Clroot.ConnectLocal s -> None | Clroot.ConnectBySocket(host,port,s) -> - (* This check isn't foolproof as the host in the clroot might not be canonical *) - if (Safelist.exists (fun (clroot',_,_,_) -> clroot=clroot') !connectedHosts) - then None - else begin - let ioServer = Lwt_unix.run(buildSocketConnection host port) in - let (host,fspath) = Lwt_unix.run(canonizeOnServer ioServer s) in - connectedHosts := (clroot,host,fspath,ioServer)::(!connectedHosts); - None - end + Lwt_unix.run + (begin match hostFspath clroot with + Some x -> x + | None -> buildSocketConnection host port + end >>= fun ioServer -> + (* We need to always compute the fspath as it depends on + unicode settings *) + let unicode = Prefs.read Case.unicodePref in + canonizeOnServer ioServer (s, unicode) >>= fun (host, fspath) -> + connectedHosts := + listReplace (clroot, (host, fspath, ioServer)) !connectedHosts; + connectionsByHosts := + listReplace (host, ioServer) !connectionsByHosts; + Lwt.return ()); + None | Clroot.ConnectByShell(shell,host,userOpt,portOpt,s) -> - if (Safelist.exists (fun (clroot',_,_,_) -> clroot=clroot') !connectedHosts) - then None - else begin - let remoteCmd = - (if Prefs.read serverCmd="" then Uutil.myName - else Prefs.read serverCmd) - ^ (if Prefs.read addversionno then "-" ^ Uutil.myMajorVersion else "") - ^ " -server" in - let userArgs = - match userOpt with - None -> [] - | Some user -> ["-l"; user] in - let portArgs = - match portOpt with - None -> [] - | Some port -> ["-p"; port] in - let shellCmd = - (if shell = "ssh" then - Prefs.read sshCmd - else if shell = "rsh" then - Prefs.read rshCmd - else - shell) in - let shellCmdArgs = - (if shell = "ssh" then - Prefs.read sshargs - else if shell = "rsh" then - Prefs.read rshargs - else - "") in - let preargs = - ([shellCmd]@userArgs at portArgs@ - [host]@ - (if shell="ssh" then ["-e none"] else [])@ - [shellCmdArgs;remoteCmd]) in - (* Split compound arguments at space chars, to make - create_process happy *) - let args = - Safelist.concat - (Safelist.map (fun s -> Util.splitIntoWords s ' ') preargs) in - let argsarray = Array.of_list args in - let (i1,o1) = Unix.pipe() in - let (i2,o2) = Unix.pipe() in - (* We need to make sure that there is only one reader and one - writer by pipe, so that, when one side of the connection - dies, the other side receives an EOF or a SIGPIPE. *) - Unix.set_close_on_exec i2; - Unix.set_close_on_exec o1; - (* We add CYGWIN=binmode to the environment before calling - ssh because the cygwin implementation on Windows sometimes - puts the pipe in text mode (which does end of line - translation). Specifically, if unison is invoked from - a DOS command prompt or other non-cygwin context, the pipe - goes into text mode; this does not happen if unison is - invoked from cygwin's bash. By setting CYGWIN=binmode - we force the pipe to remain in binary mode. *) - System.putenv "CYGWIN" "binmode"; - debug (fun ()-> Util.msg "Shell connection: %s (%s)\n" - shellCmd (String.concat ", " args)); - let (term,pid) = - Terminal.create_session shellCmd argsarray i1 o2 Unix.stderr in - (* after terminal interact, remember to close i1 and o2 *) - Some(i1,i2,o1,o2,s,term,clroot,pid) - end + match hostFspath clroot with + Some x -> + let unicode = Prefs.read Case.unicodePref in + (* We recompute the fspath as it may have changed due to + unicode settings *) + Lwt_unix.run + (x >>= fun ioServer -> + canonizeOnServer ioServer (s, unicode) >>= fun (host, fspath) -> + connectedHosts := + listReplace (clroot, (host, fspath, ioServer)) !connectedHosts; + connectionsByHosts := + listReplace (host, ioServer) !connectionsByHosts; + Lwt.return ()); + None + | None -> + let remoteCmd = + (if Prefs.read serverCmd="" then Uutil.myName + else Prefs.read serverCmd) + ^ (if Prefs.read addversionno then "-" ^ Uutil.myMajorVersion else "") + ^ " -server" in + let userArgs = + match userOpt with + None -> [] + | Some user -> ["-l"; user] in + let portArgs = + match portOpt with + None -> [] + | Some port -> ["-p"; port] in + let shellCmd = + (if shell = "ssh" then + Prefs.read sshCmd + else if shell = "rsh" then + Prefs.read rshCmd + else + shell) in + let shellCmdArgs = + (if shell = "ssh" then + Prefs.read sshargs + else if shell = "rsh" then + Prefs.read rshargs + else + "") in + let preargs = + ([shellCmd]@userArgs at portArgs@ + [host]@ + (if shell="ssh" then ["-e none"] else [])@ + [shellCmdArgs;remoteCmd]) in + (* Split compound arguments at space chars, to make + create_process happy *) + let args = + Safelist.concat + (Safelist.map (fun s -> Util.splitIntoWords s ' ') preargs) in + let argsarray = Array.of_list args in + let (i1,o1) = Unix.pipe() in + let (i2,o2) = Unix.pipe() in + (* We need to make sure that there is only one reader and one + writer by pipe, so that, when one side of the connection + dies, the other side receives an EOF or a SIGPIPE. *) + Unix.set_close_on_exec i2; + Unix.set_close_on_exec o1; + (* We add CYGWIN=binmode to the environment before calling + ssh because the cygwin implementation on Windows sometimes + puts the pipe in text mode (which does end of line + translation). Specifically, if unison is invoked from + a DOS command prompt or other non-cygwin context, the pipe + goes into text mode; this does not happen if unison is + invoked from cygwin's bash. By setting CYGWIN=binmode + we force the pipe to remain in binary mode. *) + System.putenv "CYGWIN" "binmode"; + debug (fun ()-> Util.msg "Shell connection: %s (%s)\n" + shellCmd (String.concat ", " args)); + let (term,pid) = + Terminal.create_session shellCmd argsarray i1 o2 Unix.stderr in + (* after terminal interact, remember to close i1 and o2 *) + Some(i1,i2,o1,o2,s,term,clroot,pid) let openConnectionPrompt = function (i1,i2,o1,o2,s,Some fdTerm,clroot,pid) -> @@ -1083,9 +1101,15 @@ let openConnectionEnd (i1,i2,o1,o2,s,_,clroot,pid) = Unix.close i1; Unix.close o2; - let ioServer = Lwt_unix.run (initConnection i2 o1) in - let (host,fspath) = Lwt_unix.run(canonizeOnServer ioServer s) in - connectedHosts := (clroot,host,fspath,ioServer)::(!connectedHosts) + Lwt_unix.run + (initConnection i2 o1 >>= fun ioServer -> + let unicode = Prefs.read Case.unicodePref in + canonizeOnServer ioServer (s, unicode) >>= fun (host, fspath) -> + connectedHosts := + listReplace (clroot, (host, fspath, ioServer)) !connectedHosts; + connectionsByHosts := + listReplace (host, ioServer) !connectionsByHosts; + Lwt.return ()) let openConnectionCancel (i1,i2,o1,o2,s,fdopt,clroot,pid) = try Unix.kill pid Sys.sigkill with _ -> (); Added: trunk/src/system/generic/system_impl.ml =================================================================== --- trunk/src/system/generic/system_impl.ml (rev 0) +++ trunk/src/system/generic/system_impl.ml 2009-05-15 14:34:43 UTC (rev 333) @@ -0,0 +1,31 @@ +(* Unison file synchronizer: src/system/generic/system_impl.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + +module System = System_generic +module Fs = struct + include System_generic + + let canSetTime win f = + not win || + try + Unix.access f [Unix.W_OK]; + true + with + Unix.Unix_error _ -> false + + let setUnicodeEncoding _ = () +end Copied: trunk/src/system/system_generic.ml (from rev 331, trunk/src/system_generic.ml) =================================================================== --- trunk/src/system/system_generic.ml (rev 0) +++ trunk/src/system/system_generic.ml 2009-05-15 14:34:43 UTC (rev 333) @@ -0,0 +1,63 @@ +(* Unison file synchronizer: src/system/system_generic.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + +type fspath = string + +let fspathFromString f = f +let fspathToPrintString f = f +let fspathToString f = f +let fspathToDebugString f = String.escaped f + +let fspathConcat = Filename.concat +let fspathDirname = Filename.dirname +let fspathAddSuffixToFinalName f suffix = f ^ suffix + +(****) + +let getenv = Sys.getenv +let putenv = Unix.putenv +let argv () = Sys.argv + +(****) + +type dir_handle = Unix.dir_handle + +let stat = Unix.LargeFile.stat +let lstat = Unix.LargeFile.lstat +let rmdir = Unix.rmdir +let mkdir = Unix.mkdir +let unlink = Unix.unlink +let rename = Unix.rename +let open_in_gen = open_in_gen +let open_out_gen = open_out_gen +let chmod = Unix.chmod +let chown = Unix.chown +let utimes = Unix.utimes +let link = Unix.link +let openfile = Unix.openfile +let opendir = Unix.opendir +let readdir = Unix.readdir +let closedir = Unix.closedir +let readlink = Unix.readlink +let symlink = Unix.symlink +let chdir = Sys.chdir +let getcwd = Sys.getcwd + +(****) + +let file_exists = Sys.file_exists +let open_in_bin = open_in_bin Copied: trunk/src/system/system_intf.ml (from rev 331, trunk/src/system_intf.ml) =================================================================== --- trunk/src/system/system_intf.ml (rev 0) +++ trunk/src/system/system_intf.ml 2009-05-15 14:34:43 UTC (rev 333) @@ -0,0 +1,70 @@ +(* Unison file synchronizer: src/system/system_intf.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + +module type Core = sig + +type fspath +type dir_handle + +val symlink : string -> fspath -> unit +val readlink : fspath -> string +val chown : fspath -> int -> int -> unit +val chmod : fspath -> int -> unit +val utimes : fspath -> float -> float -> unit +val unlink : fspath -> unit +val rmdir : fspath -> unit +val mkdir : fspath -> Unix.file_perm -> unit +val rename : fspath -> fspath -> unit +val stat : fspath -> Unix.LargeFile.stats +val lstat : fspath -> Unix.LargeFile.stats +val opendir : fspath -> dir_handle +val readdir : dir_handle -> string +val closedir : dir_handle -> unit +val openfile : + fspath -> Unix.open_flag list -> Unix.file_perm -> Unix.file_descr + +(****) + +val open_out_gen : open_flag list -> int -> fspath -> out_channel +val open_in_bin : fspath -> in_channel +val file_exists : fspath -> bool + +end + +module type Full = sig + +include Core + +val putenv : string -> string -> unit +val getenv : string -> string +val argv : unit -> string array + +val fspathFromString : string -> fspath +val fspathToPrintString : fspath -> string +val fspathToDebugString : fspath -> string +val fspathToString : fspath -> string +val fspathConcat : fspath -> string -> fspath +val fspathDirname : fspath -> fspath +val fspathAddSuffixToFinalName : fspath -> string -> fspath + +val open_in_gen : open_flag list -> int -> fspath -> in_channel + +val link : fspath -> fspath -> unit +val chdir : fspath -> unit +val getcwd : unit -> fspath + +end Copied: trunk/src/system/system_win.ml (from rev 331, trunk/src/system_win.ml) =================================================================== --- trunk/src/system/system_win.ml (rev 0) +++ trunk/src/system/system_win.ml 2009-05-15 14:34:43 UTC (rev 333) @@ -0,0 +1,192 @@ +(* Unison file synchronizer: src/system/system_win.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + +(*XXXX + +We have to propagate the encoding mode when canonizing roots +===> new major version + +TO CONVERT +========== +Unix.open_process_in +Unix.open_process_out +Unix.create_process +Unix.execvp +Lwt_unix.open_process_full +Lwt_unix.open_process_in + +- Use SetConsoleOutputCP/SetConsoleCP in text mode ??? +*) + +type fspath = string + +let fspathFromString f = f +let fspathToPrintString f = f +let fspathToString f = f +let fspathToDebugString f = String.escaped f + +let fspathConcat = Filename.concat +let fspathDirname = Filename.dirname +let fspathAddSuffixToFinalName f suffix = f ^ suffix + +(****) + +let fixPath f = + for i = 0 to String.length f - 1 do + if f.[i] = '/' then f.[i] <- '\\' + done; + f +let winRootRx = Rx.rx "[a-zA-Z]:[/\\].*" +let winUncRx = Rx.rx "//[^/]+/[^/]+/.*" +(* FIX: we could also handle UNC paths *) +let extendedPath f = + if Rx.match_string winRootRx f then + fixPath ("\\\\?\\" ^ f) + else + f + +let utf16 s = Unicode.to_utf_16 s +let utf8 s = Unicode.from_utf_16 s +let path16 = utf16 +let epath f = utf16 (extendedPath f) + +let sys_error e = + match e with + Unix.Unix_error (err, _, "") -> + raise (Sys_error (Unix.error_message err)) + | Unix.Unix_error (err, _, s) -> + raise (Sys_error (Format.sprintf "%s: %s" s (Unix.error_message err))) + | _ -> + raise e + +(****) + +external getenv_impl : string -> string = "win_getenv" +external putenv_impl : string -> string -> string -> unit = "win_putenv" +external argv_impl : unit -> string array = "win_argv" + +let getenv nm = utf8 (getenv_impl (utf16 nm)) +let putenv nm v = putenv_impl nm (utf16 nm) (utf16 v) +let argv () = Array.map utf8 (argv_impl ()) + +(****) + +type dir_entry = Dir_empty | Dir_read of string | Dir_toread +type dir_handle = Unix.dir_handle +type dir_handle' = + { handle : int; mutable entry_read: dir_entry } + +external stat_impl : string -> string -> Unix.LargeFile.stats = "win_stat" +external rmdir_impl : string -> string -> unit = "win_rmdir" +external mkdir_impl : string -> string -> unit = "win_mkdir" +external unlink_impl : string -> string -> unit = "win_unlink" +external rename_impl : string -> string -> string -> unit = "win_rename" +external chmod_impl : string -> string -> int -> unit = "win_chmod" +external utimes_impl : + string -> string -> float -> float -> unit = "win_utimes" +external open_impl : + string -> string -> Unix.open_flag list -> Unix.file_perm -> Unix.file_descr = "win_open" +external chdir_impl : string -> string -> unit = "win_chdir" +external getcwd_impl : unit -> string = "win_getcwd" +external findfirst : string -> string * int = "win_findfirstw" +external findnext : int -> string = "win_findnextw" +external findclose : int -> unit = "win_findclosew" + +let stat f = stat_impl f (epath f) +let lstat = stat +let rmdir f = rmdir_impl f (epath f) +let mkdir f perms = mkdir_impl f (epath f) +let unlink f = unlink_impl f (epath f) +let rename f1 f2 = rename_impl f1 (epath f1) (epath f2) +let chmod f perm = chmod_impl f (epath f) perm +let chown _ _ _ = raise (Unix.Unix_error (Unix.ENOSYS, "chown", "")) +let utimes f t1 t2 = utimes_impl f (epath f) t1 t2 +let link _ _ = raise (Unix.Unix_error (Unix.ENOSYS, "link", "")) +let openfile f flags perm = open_impl f (epath f) flags perm +let readlink _ = raise (Unix.Unix_error (Unix.ENOSYS, "readlink", "")) +let symlink _ _ = raise (Unix.Unix_error (Unix.ENOSYS, "symlink", "")) + +let chdir f = + try + chdir_impl f (path16 f) (* Better not to use [epath] here *) + with e -> sys_error e +let getcwd () = + try + utf8 (getcwd_impl ()) + with e -> sys_error e + +let badFileRx = Rx.rx ".*[?*].*" + +let ud : dir_handle' -> dir_handle = Obj.magic +let du : dir_handle -> dir_handle' = Obj.magic + +let opendir d = + if Rx.match_string badFileRx d then + raise (Unix.Unix_error (Unix.ENOENT, "opendir", d)); + try + let (first_entry, handle) = findfirst (epath (fspathConcat d "*")) in + ud { handle = handle; entry_read = Dir_read first_entry } + with End_of_file -> + ud { handle = 0; entry_read = Dir_empty } +let readdir d = + let d = du d in + match d.entry_read with + Dir_empty -> raise End_of_file + | Dir_read name -> d.entry_read <- Dir_toread; utf8 name + | Dir_toread -> utf8 (findnext d.handle) +let closedir d = + let d = du d in + match d.entry_read with + Dir_empty -> () + | _ -> findclose d.handle + +let rec conv_flags fl = + match fl with + Open_rdonly :: rem -> Unix.O_RDONLY :: conv_flags rem + | Open_wronly :: rem -> Unix.O_WRONLY :: conv_flags rem + | Open_append :: rem -> Unix.O_APPEND :: conv_flags rem + | Open_creat :: rem -> Unix.O_CREAT :: conv_flags rem + | Open_trunc :: rem -> Unix.O_TRUNC :: conv_flags rem + | Open_excl :: rem -> Unix.O_EXCL :: conv_flags rem + | Open_binary :: rem -> conv_flags rem + | Open_text :: rem -> conv_flags rem + | Open_nonblock :: rem -> Unix.O_NONBLOCK :: conv_flags rem + | [] -> [] + +let open_in_gen flags perms f = + try + Unix.in_channel_of_descr (openfile f (conv_flags flags) perms) + with e -> + sys_error e +let open_out_gen flags perms f = + try + Unix.out_channel_of_descr (openfile f (conv_flags flags) perms) + with e -> + sys_error e + +(****) + +let file_exists f = + try + ignore (stat f); true + with + Unix.Unix_error ((Unix.ENOENT | Unix.ENOTDIR), _, _) -> + false + | e -> + sys_error e + +let open_in_bin f = open_in_gen [Open_rdonly; Open_binary] 0 f Copied: trunk/src/system/system_win_stubs.c (from rev 331, trunk/src/system_win_stubs.c) =================================================================== --- trunk/src/system/system_win_stubs.c (rev 0) +++ trunk/src/system/system_win_stubs.c 2009-05-15 14:34:43 UTC (rev 333) @@ -0,0 +1,430 @@ +#include +#include +#include +#include + +#define _WIN32_WINDOWS 0x0410 + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#define Nothing ((value) 0) + +struct filedescr { + union { + HANDLE handle; + SOCKET socket; + } fd; + enum { KIND_HANDLE, KIND_SOCKET } kind; + int crt_fd; +}; +#define Handle_val(v) (((struct filedescr *) Data_custom_val(v))->fd.handle) + +static value copy_wstring(LPCWSTR s) +{ + int len; + value res; + + len = 2 * wcslen(s) + 2; /* NULL character included */ + res = caml_alloc_string(len); + memmove(String_val(res), s, len); + return res; +} + +extern void win32_maperr (DWORD errcode); +extern void uerror (char * cmdname, value arg); +extern value win_alloc_handle (HANDLE h); +extern value cst_to_constr (int n, int * tbl, int size, int deflt); + +static int open_access_flags[12] = { + GENERIC_READ, GENERIC_WRITE, GENERIC_READ|GENERIC_WRITE, + 0, 0, 0, 0, 0, 0, 0, 0, 0 +}; + +static int open_create_flags[12] = { + 0, 0, 0, 0, 0, O_CREAT, O_TRUNC, O_EXCL, 0, 0, 0, 0 +}; + +static int open_flag_table[12] = { + _O_RDONLY, _O_WRONLY, _O_RDWR, 0, _O_APPEND, _O_CREAT, _O_TRUNC, + _O_EXCL, 0, 0, 0, 0 +}; + +/****/ + +CAMLprim value win_rmdir(value path, value wpath) +{ + CAMLparam2(path, wpath); + if (!RemoveDirectoryW((LPWSTR)String_val(wpath))) { + win32_maperr (GetLastError ()); + uerror("rmdir", path); + } + CAMLreturn (Val_unit); +} + +CAMLprim value win_mkdir(value path, value wpath) +{ + CAMLparam2(path, wpath); + if (!CreateDirectoryW((LPWSTR)String_val(wpath), NULL)) { + win32_maperr (GetLastError ()); + uerror("mkdir", path); + } + CAMLreturn (Val_unit); +} + +CAMLprim value win_unlink(value path, value wpath) +{ + CAMLparam2(path, wpath); + if (!DeleteFileW((LPWSTR)String_val(wpath))) { + win32_maperr (GetLastError ()); + uerror("unlink", path); + } + CAMLreturn (Val_unit); +} + +CAMLprim value win_rename(value path1, value wpath1, value wpath2) +{ + CAMLparam3(path1, wpath1, wpath2); + if (!MoveFileExW((LPWSTR)String_val(wpath1), (LPWSTR)String_val(wpath2), + MOVEFILE_REPLACE_EXISTING)) { + win32_maperr (GetLastError ()); + uerror("rename", path1); + } + CAMLreturn (Val_unit); +} + +CAMLprim value win_chmod (value path, value wpath, value perm) { + DWORD attr; + CAMLparam3(path, wpath, perm); + + attr = GetFileAttributesW ((LPCWSTR)String_val (wpath)); + if (attr == INVALID_FILE_ATTRIBUTES) { + win32_maperr (GetLastError ()); + uerror("chmod", path); + } + if (Int_val(perm) & _S_IWRITE) + attr &= ~FILE_ATTRIBUTE_READONLY; + else + attr |= FILE_ATTRIBUTE_READONLY; + + if (!SetFileAttributesW ((LPCWSTR)String_val (wpath), attr)) { + win32_maperr (GetLastError ()); + uerror("chmod", path); + } + + CAMLreturn (Val_unit); +} + +CAMLprim value win_utimes (value path, value wpath, value atime, value mtime) { + HANDLE h; + BOOL res; + ULARGE_INTEGER iatime, imtime; + FILETIME fatime, fmtime; + + CAMLparam4(path, wpath, atime, mtime); + + iatime.QuadPart = Double_val(atime); + imtime.QuadPart = Double_val(mtime); + + /* http://www.filewatcher.com/p/Win32-UTCFileTime-1.44.tar.gz.93147/Win32-UTCFileTime-1.44/UTCFileTime.xs.html */ + /* http://savannah.nongnu.org/bugs/?22781#comment0 */ + if (iatime.QuadPart || imtime.QuadPart) { + iatime.QuadPart += 11644473600ull; + iatime.QuadPart *= 10000000ull; + fatime.dwLowDateTime = iatime.LowPart; + fatime.dwHighDateTime = iatime.HighPart; + imtime.QuadPart += 11644473600ull; + imtime.QuadPart *= 10000000ull; + fmtime.dwLowDateTime = imtime.LowPart; + fmtime.dwHighDateTime = imtime.HighPart; + } else { + GetSystemTimeAsFileTime (&fatime); + fmtime = fatime; + } + h = CreateFileW ((LPWSTR) wpath, FILE_WRITE_ATTRIBUTES, + FILE_SHARE_READ | FILE_SHARE_WRITE, + NULL, OPEN_EXISTING, 0, NULL); + if (h == INVALID_HANDLE_VALUE) { + win32_maperr (GetLastError ()); + uerror("utimes", path); + } + res = SetFileTime (h, NULL, &fatime, &fmtime); + if (res == 0) { + win32_maperr (GetLastError ()); + (void)CloseHandle (h); + uerror("utimes", path); + } + res = CloseHandle (h); + if (res == 0) { + win32_maperr (GetLastError ()); + uerror("utimes", path); + } + CAMLreturn (Val_unit); +} + +CAMLprim value win_open (value path, value wpath, value flags, value perm) { + int fileaccess, createflags, fileattrib, filecreate; + SECURITY_ATTRIBUTES attr; + HANDLE h; + + CAMLparam4 (path, wpath, flags, perm); + + fileaccess = convert_flag_list(flags, open_access_flags); + + createflags = convert_flag_list(flags, open_create_flags); + if ((createflags & (O_CREAT | O_EXCL)) == (O_CREAT | O_EXCL)) + filecreate = CREATE_NEW; + else if ((createflags & (O_CREAT | O_TRUNC)) == (O_CREAT | O_TRUNC)) + filecreate = CREATE_ALWAYS; + else if (createflags & O_TRUNC) + filecreate = TRUNCATE_EXISTING; + else if (createflags & O_CREAT) + filecreate = OPEN_ALWAYS; + else + filecreate = OPEN_EXISTING; + + if ((createflags & O_CREAT) && (Int_val(perm) & 0200) == 0) + fileattrib = FILE_ATTRIBUTE_READONLY; + else + fileattrib = FILE_ATTRIBUTE_NORMAL; + + attr.nLength = sizeof(attr); + attr.lpSecurityDescriptor = NULL; + attr.bInheritHandle = TRUE; + + h = CreateFileW((LPCWSTR) String_val(wpath), fileaccess, + FILE_SHARE_READ | FILE_SHARE_WRITE, &attr, + filecreate, fileattrib, NULL); + + if (h == INVALID_HANDLE_VALUE) { + win32_maperr (GetLastError ()); + uerror("open", path); + } + + CAMLreturn(win_alloc_handle(h)); +} + +#define MAKEDWORDLONG(a,b) ((DWORDLONG)(((DWORD)(a))|(((DWORDLONG)((DWORD)(b)))<<32))) +#define FILETIME_TO_TIME(ft) (((((ULONGLONG) ft.dwHighDateTime) << 32) + ft.dwLowDateTime) / 10000000ull - 11644473600ull) + +CAMLprim value win_stat(value path, value wpath) +{ + int res, mode; + HANDLE h; + BY_HANDLE_FILE_INFORMATION info; + CAMLparam2(path,wpath); + CAMLlocal1 (v); + + h = CreateFileW ((LPCWSTR) String_val (wpath), 0, 0, NULL, OPEN_EXISTING, + FILE_FLAG_BACKUP_SEMANTICS | FILE_ATTRIBUTE_READONLY, NULL); + + if (h == INVALID_HANDLE_VALUE) { + win32_maperr (GetLastError ()); + uerror("stat", path); + } + + res = GetFileInformationByHandle (h, &info); + if (res == 0) { + win32_maperr (GetLastError ()); + (void) CloseHandle (h); + uerror("stat", path); + } + + res = CloseHandle (h); + if (res == 0) { + win32_maperr (GetLastError ()); + uerror("stat", path); + } + + v = caml_alloc (12, 0); + Store_field (v, 0, Val_int (info.dwVolumeSerialNumber)); + Store_field + (v, 1, Val_int (MAKEDWORDLONG(info.nFileIndexLow,info.nFileIndexHigh))); + Store_field + (v, 2, Val_int (info.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY + ? 1: 0)); + mode = 0000444; + if (info.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) + mode |= 0000111; + if (!(info.dwFileAttributes & FILE_ATTRIBUTE_READONLY)) + mode |= 0000222; + Store_field (v, 3, Val_int(mode)); + Store_field (v, 4, Val_int (1)); + Store_field (v, 5, Val_int (0)); + Store_field (v, 6, Val_int (0)); + Store_field (v, 7, Val_int (0)); + Store_field + (v, 8, copy_int64(MAKEDWORDLONG(info.nFileSizeLow,info.nFileSizeHigh))); + Store_field + (v, 9, copy_double((double) FILETIME_TO_TIME(info.ftLastAccessTime))); + Store_field + (v, 10, copy_double((double) FILETIME_TO_TIME(info.ftLastWriteTime))); + Store_field + (v, 11, copy_double((double) FILETIME_TO_TIME(info.ftCreationTime))); + + CAMLreturn (v); +} + +CAMLprim value win_chdir (value path, value wpath) +{ + CAMLparam2(path,wpath); + if (!SetCurrentDirectoryW ((LPWSTR)wpath)) { + win32_maperr(GetLastError()); + uerror("chdir", path); + } + CAMLreturn (Val_unit); +} + +CAMLprim value win_getcwd (value unit) +{ + int res; + LPWSTR s; + CAMLparam0(); + CAMLlocal1 (path); + + s = stat_alloc (32768 * 2); + res = GetCurrentDirectoryW (32768, s); + if (res == 0) { + stat_free (s); + win32_maperr(GetLastError()); + uerror("getcwd", Nothing); + } + /* Normalize the path */ + res = GetLongPathNameW (s, s, 32768); + if (res == 0) { + stat_free (s); + win32_maperr(GetLastError()); + uerror("getcwd", Nothing); + } + /* Convert the drive letter to uppercase */ + if (s[0] >= L'a' && s[0] <= L'z') s[0] -= 32; + path = copy_wstring(s); + stat_free (s); + CAMLreturn (path); +} + +CAMLprim value win_findfirstw(value name) +{ + HANDLE h; + WIN32_FIND_DATAW fileinfo; + + CAMLparam1(name); + CAMLlocal3(v, valname, valh); + + h = FindFirstFileW((LPCWSTR) String_val(name),&fileinfo); + if (h == INVALID_HANDLE_VALUE) { + DWORD err = GetLastError(); + if (err == ERROR_NO_MORE_FILES) + raise_end_of_file(); + else { + win32_maperr(err); + uerror("opendir", Nothing); + } + } + valname = copy_wstring(fileinfo.cFileName); + valh = win_alloc_handle(h); + v = alloc_small(2, 0); + Field(v,0) = valname; + Field(v,1) = valh; + CAMLreturn (v); +} + +CAMLprim value win_findnextw(value valh) +{ + WIN32_FIND_DATAW fileinfo; + BOOL retcode; + + CAMLparam1(valh); + + retcode = FindNextFileW(Handle_val(valh), &fileinfo); + if (!retcode) { + DWORD err = GetLastError(); + if (err == ERROR_NO_MORE_FILES) + raise_end_of_file(); + else { + win32_maperr(err); + uerror("readdir", Nothing); + } + } + CAMLreturn (copy_wstring(fileinfo.cFileName)); +} + +CAMLprim value win_findclosew(value valh) +{ + CAMLparam1(valh); + + if (! FindClose(Handle_val(valh))) { + win32_maperr(GetLastError()); + uerror("closedir", Nothing); + } + CAMLreturn (Val_unit); +} + +CAMLprim value win_getenv(value var) +{ + LPWSTR s; + DWORD len; + CAMLparam1(var); + CAMLlocal1(res); + + s = stat_alloc (65536); + + len = GetEnvironmentVariableW((LPCWSTR) String_val(var), s, 65536); + if (len == 0) { stat_free (s); raise_not_found(); } + + res = copy_wstring(s); + stat_free (s); + CAMLreturn (res); + +} + +CAMLprim value win_putenv(value var, value wvar, value v) +{ + BOOL res; + CAMLparam3(var, wvar, v); + + res = SetEnvironmentVariableW((LPCWSTR) String_val(wvar), (LPCWSTR) v); + if (res == 0) { + win32_maperr (GetLastError ()); + uerror("putenv", var); + } + CAMLreturn (Val_unit); +} + +CAMLprim value win_argv(value unit) +{ + int n, i; + LPWSTR * l; + + CAMLparam0(); + CAMLlocal2(v,res); + + l = CommandLineToArgvW (GetCommandLineW (), &n); + + if (l == NULL) { + win32_maperr (GetLastError ()); + uerror("argv", Nothing); + } + res = caml_alloc (n, 0); + for (i = 0; i < n; i++) { + v = copy_wstring (l[i]); + Store_field (res, i, v); + } + LocalFree (l); + CAMLreturn (res); +} Added: trunk/src/system/win/system_impl.ml =================================================================== --- trunk/src/system/win/system_impl.ml (rev 0) +++ trunk/src/system/win/system_impl.ml 2009-05-15 14:34:43 UTC (rev 333) @@ -0,0 +1,63 @@ +(* Unison file synchronizer: src/system/win/system_impl.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + +module System = System_win + +module Fs = struct + (* The new implementation of utimes does not have the limitation of + the standard one *) + let canSetTime win f = true + + let unicode = ref false + + let setUnicodeEncoding u = unicode := u + + let c1 f1 f2 v1 = if !unicode then f1 v1 else f2 v1 + let c2 f1 f2 v1 v2 = if !unicode then f1 v1 v2 else f2 v1 v2 + let c3 f1 f2 v1 v2 v3 = if !unicode then f1 v1 v2 v3 else f2 v1 v2 v3 + + module G = System_generic + module W = System_win + + type fspath = string + + let fspathConcat v1 v2 = c2 W.fspathConcat G.fspathConcat v1 v2 + let fspathDirname v = c1 W.fspathDirname G.fspathDirname v + + type dir_handle = Unix.dir_handle + + let symlink v1 v2 = c2 W.symlink G.symlink v1 v2 + let readlink v = c1 W.readlink G.readlink v + let chown v1 v2 v3 = c3 W.chown G.chown v1 v2 v3 + let chmod v1 v2 = c2 W.chmod G.chmod v1 v2 + let utimes v1 v2 v3 = c3 W.utimes G.utimes v1 v2 v3 + let unlink v = c1 W.unlink G.unlink v + let rmdir v = c1 W.rmdir G.rmdir v + let mkdir v1 v2 = c2 W.mkdir G.mkdir v1 v2 + let rename v1 v2 = c2 W.rename G.rename v1 v2 + let stat v = c1 W.stat G.stat v + let lstat v = c1 W.lstat G.lstat v + let opendir v = c1 W.opendir G.opendir v + let readdir v = c1 W.readdir G.readdir v + let closedir v = c1 W.closedir G.closedir v + let openfile v1 v2 v3 = c3 W.openfile G.openfile v1 v2 v3 + let open_in_gen v1 v2 v3 = c3 W.open_in_gen G.open_in_gen v1 v2 v3 + let open_out_gen v1 v2 v3 = c3 W.open_out_gen G.open_out_gen v1 v2 v3 + let getcwd v = c1 W.getcwd G.getcwd v + let chdir v = c1 W.chdir G.chdir v + let readlink v = c1 W.readlink G.readlink v +end Deleted: trunk/src/system.ml =================================================================== --- trunk/src/system.ml 2009-05-14 15:59:33 UTC (rev 332) +++ trunk/src/system.ml 2009-05-15 14:34:43 UTC (rev 333) @@ -1,19 +0,0 @@ -(* Unison file synchronizer: src/system.ml *) -(* Copyright 1999-2009, Benjamin C. Pierce - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . -*) - -include System_generic -(*include System_win*) Added: trunk/src/system.ml =================================================================== --- trunk/src/system.ml (rev 0) +++ trunk/src/system.ml 2009-05-15 14:34:43 UTC (rev 333) @@ -0,0 +1,18 @@ +(* Unison file synchronizer: src/system.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + +include System_impl.System Deleted: trunk/src/system_generic.ml =================================================================== --- trunk/src/system_generic.ml 2009-05-14 15:59:33 UTC (rev 332) +++ trunk/src/system_generic.ml 2009-05-15 14:34:43 UTC (rev 333) @@ -1,63 +0,0 @@ -(* Unison file synchronizer: src/system_generic.ml *) -(* Copyright 1999-2009, Benjamin C. Pierce - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . -*) - -type fspath = string - -let fspathFromString f = f -let fspathToPrintString f = f -let fspathToString f = f -let fspathToDebugString f = String.escaped f - -let fspathConcat = Filename.concat -let fspathDirname = Filename.dirname -let fspathAddSuffixToFinalName f suffix = f ^ suffix - -(****) - -let getenv = Sys.getenv -let putenv = Unix.putenv -let argv () = Sys.argv - -(****) - -type dir_handle = Unix.dir_handle - -let stat = Unix.LargeFile.stat -let lstat = Unix.LargeFile.lstat -let rmdir = Unix.rmdir -let mkdir = Unix.mkdir -let unlink = Unix.unlink -let rename = Unix.rename -let open_in_gen = open_in_gen -let open_out_gen = open_out_gen -let chmod = Unix.chmod -let chown = Unix.chown -let utimes = Unix.utimes -let link = Unix.link -let openfile = Unix.openfile -let opendir = Unix.opendir -let readdir = Unix.readdir -let closedir = Unix.closedir -let readlink = Unix.readlink -let symlink = Unix.symlink -let chdir = Sys.chdir -let getcwd = Sys.getcwd - -(****) - -let file_exists = Sys.file_exists -let open_in_bin = open_in_bin Deleted: trunk/src/system_intf.ml =================================================================== --- trunk/src/system_intf.ml 2009-05-14 15:59:33 UTC (rev 332) +++ trunk/src/system_intf.ml 2009-05-15 14:34:43 UTC (rev 333) @@ -1,70 +0,0 @@ -(* Unison file synchronizer: src/system_intf.ml *) -(* Copyright 1999-2009, Benjamin C. Pierce - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . -*) - -module type Core = sig - -type fspath -type dir_handle - -val symlink : string -> fspath -> unit -val readlink : fspath -> string -val chown : fspath -> int -> int -> unit -val chmod : fspath -> int -> unit -val utimes : fspath -> float -> float -> unit -val unlink : fspath -> unit -val rmdir : fspath -> unit -val mkdir : fspath -> Unix.file_perm -> unit -val rename : fspath -> fspath -> unit -val stat : fspath -> Unix.LargeFile.stats -val lstat : fspath -> Unix.LargeFile.stats -val opendir : fspath -> dir_handle -val readdir : dir_handle -> string -val closedir : dir_handle -> unit -val openfile : - fspath -> Unix.open_flag list -> Unix.file_perm -> Unix.file_descr - -(****) - -val open_out_gen : open_flag list -> int -> fspath -> out_channel -val open_in_bin : fspath -> in_channel -val file_exists : fspath -> bool - -end - -module type Full = sig - -include Core - -val putenv : string -> string -> unit -val getenv : string -> string -val argv : unit -> string array - -val fspathFromString : string -> fspath -val fspathToPrintString : fspath -> string -val fspathToDebugString : fspath -> string -val fspathToString : fspath -> string -val fspathConcat : fspath -> string -> fspath -val fspathDirname : fspath -> fspath -val fspathAddSuffixToFinalName : fspath -> string -> fspath - -val open_in_gen : open_flag list -> int -> fspath -> in_channel - -val link : fspath -> fspath -> unit -val chdir : fspath -> unit -val getcwd : unit -> fspath - -end Deleted: trunk/src/system_win.ml =================================================================== --- trunk/src/system_win.ml 2009-05-14 15:59:33 UTC (rev 332) +++ trunk/src/system_win.ml 2009-05-15 14:34:43 UTC (rev 333) @@ -1,194 +0,0 @@ -(* Unison file synchronizer: src/system_win.ml *) -(* Copyright 1999-2009, Benjamin C. Pierce - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . -*) - -(*XXXX -Compilation/configuration issues - -Adapt fspath.ml to use Unix rather than Sys variants of getcwd and chdir? - -XXX Do not forget operations in fspath.ml... - -We have to propagate the encoding mode when canonizing roots -===> new major version - -TO CONVERT -========== -Unix.open_process_in -Unix.open_process_out -Unix.create_process -Unix.execvp -Lwt_unix.open_process_full -Lwt_unix.open_process_in - -- Try to hide the console when not using ssh -- Use SetConsoleOutputCP/SetConsoleCP in text mode - -copy icons to 2.32 ? -*) - -type fspath = string - -let fspathFromString f = f -let fspathToPrintString f = f -let fspathToString f = f -let fspathToDebugString f = String.escaped f - -let fspathConcat = Filename.concat -let fspathDirname = Filename.dirname -let fspathAddSuffixToFinalName f suffix = f ^ suffix - -(****) - -let fixPath f = - for i = 0 to String.length f - 1 do - if f.[i] = '/' then f.[i] <- '\\' - done; - f -let winRootRx = Rx.rx "[a-zA-Z]:[/\\].*" -let winUncRx = Rx.rx "//[^/]+/[^/]+/.*" -(* FIX: we could also handle UNC paths *) -let extendedPath f = - if Rx.match_string winRootRx f then - fixPath ("\\\\?\\" ^ f) - else - f - -let utf16 s = Unicode.to_utf_16 s -let utf8 s = Unicode.from_utf_16 s -let path16 = utf16 -let epath f = utf16 (extendedPath f) - -let sys_error e = - match e with - Unix.Unix_error (err, _, "") -> - raise (Sys_error (Unix.error_message err)) - | Unix.Unix_error (err, _, s) -> - raise (Sys_error (Format.sprintf "%s: %s" s (Unix.error_message err))) - | _ -> - raise e - -(****) - -external getenv_impl : string -> string = "win_getenv" -external putenv_impl : string -> string -> string -> unit = "win_putenv" -external argv_impl : unit -> string array = "win_argv" - -let getenv nm = utf8 (getenv_impl (utf16 nm)) -let putenv nm v = putenv_impl nm (utf16 nm) (utf16 v) -let argv () = Array.map utf8 (argv_impl ()) - -(****) - -type dir_entry = Dir_empty | Dir_read of string | Dir_toread -type dir_handle = - { handle : int; mutable entry_read: dir_entry } - -external stat_impl : string -> string -> Unix.LargeFile.stats = "win_stat" -external rmdir_impl : string -> string -> unit = "win_rmdir" -external mkdir_impl : string -> string -> unit = "win_mkdir" -external unlink_impl : string -> string -> unit = "win_unlink" -external rename_impl : string -> string -> string -> unit = "win_rename" -external chmod_impl : string -> string -> int -> unit = "win_chmod" -external utimes_impl : - string -> string -> float -> float -> unit = "win_utimes" -external open_impl : - string -> string -> Unix.open_flag list -> Unix.file_perm -> Unix.file_descr = "win_open" -external chdir_impl : string -> string -> unit = "win_chdir" -external getcwd_impl : unit -> string = "win_getcwd" -external findfirst : string -> string * int = "win_findfirstw" -external findnext : int -> string = "win_findnextw" -external findclose : int -> unit = "win_findclosew" - -let stat f = stat_impl f (epath f) -let lstat = stat -let rmdir f = rmdir_impl f (epath f) -let mkdir f perms = mkdir_impl f (epath f) -let unlink f = unlink_impl f (epath f) -let rename f1 f2 = rename_impl f1 (epath f1) (epath f2) -let chmod f perm = chmod_impl f (epath f) perm -let chown _ _ _ = raise (Unix.Unix_error (Unix.ENOSYS, "chown", "")) -let utimes f t1 t2 = utimes_impl f (epath f) t1 t2 -let link _ _ = raise (Unix.Unix_error (Unix.ENOSYS, "link", "")) -let openfile f flags perm = open_impl f (epath f) flags perm -let readlink _ = raise (Unix.Unix_error (Unix.ENOSYS, "readlink", "")) -let symlink _ _ = raise (Unix.Unix_error (Unix.ENOSYS, "symlink", "")) - -let chdir f = - try - chdir_impl f (path16 f) (* Better not to use [epath] here *) - with e -> sys_error e -let getcwd () = - try - utf8 (getcwd_impl ()) - with e -> sys_error e - -let badFileRx = Rx.rx ".*[?*].*" - -let opendir d = - if Rx.match_string badFileRx d then - raise (Unix.Unix_error (Unix.ENOENT, "opendir", d)); - try - let (first_entry, handle) = findfirst (epath (fspathConcat d "*")) in - { handle = handle; entry_read = Dir_read first_entry } - with End_of_file -> - { handle = 0; entry_read = Dir_empty } -let readdir d = - match d.entry_read with - Dir_empty -> raise End_of_file - | Dir_read name -> d.entry_read <- Dir_toread; utf8 name - | Dir_toread -> utf8 (findnext d.handle) -let closedir d = - match d.entry_read with - Dir_empty -> () - | _ -> findclose d.handle - -let rec conv_flags fl = - match fl with - Open_rdonly :: rem -> Unix.O_RDONLY :: conv_flags rem - | Open_wronly :: rem -> Unix.O_WRONLY :: conv_flags rem - | Open_append :: rem -> Unix.O_APPEND :: conv_flags rem - | Open_creat :: rem -> Unix.O_CREAT :: conv_flags rem - | Open_trunc :: rem -> Unix.O_TRUNC :: conv_flags rem - | Open_excl :: rem -> Unix.O_EXCL :: conv_flags rem - | Open_binary :: rem -> conv_flags rem - | Open_text :: rem -> conv_flags rem - | Open_nonblock :: rem -> Unix.O_NONBLOCK :: conv_flags rem - | [] -> [] - -let open_in_gen flags perms f = - try - Unix.in_channel_of_descr (openfile f (conv_flags flags) perms) - with e -> - sys_error e -let open_out_gen flags perms f = - try - Unix.out_channel_of_descr (openfile f (conv_flags flags) perms) - with e -> - sys_error e - -(****) - -let file_exists f = - try - ignore (stat f); true - with - Unix.Unix_error ((Unix.ENOENT | Unix.ENOTDIR), _, _) -> - false - | e -> - sys_error e - -let open_in_bin f = open_in_gen [Open_rdonly; Open_binary] 0 f Deleted: trunk/src/system_win_stubs.c =================================================================== --- trunk/src/system_win_stubs.c 2009-05-14 15:59:33 UTC (rev 332) +++ trunk/src/system_win_stubs.c 2009-05-15 14:34:43 UTC (rev 333) @@ -1,464 +0,0 @@ -#include -#include -#include -#include - -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#define Nothing ((value) 0) - -struct filedescr { - union { - HANDLE handle; - SOCKET socket; - } fd; - enum { KIND_HANDLE, KIND_SOCKET } kind; - int crt_fd; -}; -#define Handle_val(v) (((struct filedescr *) Data_custom_val(v))->fd.handle) - -static value copy_wstring(LPCWSTR s) -{ - int len; - value res; - - len = 2 * wcslen(s) + 2; /* NULL character included */ - res = caml_alloc_string(len); - memmove(String_val(res), s, len); - return res; -} - -extern void win32_maperr (DWORD errcode); -extern void uerror (char * cmdname, value arg); -extern value win_alloc_handle (HANDLE h); -extern value cst_to_constr (int n, int * tbl, int size, int deflt); - -static int open_access_flags[12] = { - GENERIC_READ, GENERIC_WRITE, GENERIC_READ|GENERIC_WRITE, - 0, 0, 0, 0, 0, 0, 0, 0, 0 -}; - -static int open_create_flags[12] = { - 0, 0, 0, 0, 0, O_CREAT, O_TRUNC, O_EXCL, 0, 0, 0, 0 -}; - -static int open_flag_table[12] = { - _O_RDONLY, _O_WRONLY, _O_RDWR, 0, _O_APPEND, _O_CREAT, _O_TRUNC, - _O_EXCL, 0, 0, 0, 0 -}; - -/****/ - -CAMLprim value win_rmdir(value path, value wpath) -{ - CAMLparam2(path, wpath); - if (!RemoveDirectoryW((LPWSTR)String_val(wpath))) { - win32_maperr (GetLastError ()); - uerror("rmdir", path); - } - CAMLreturn (Val_unit); -} - -CAMLprim value win_mkdir(value path, value wpath) -{ - CAMLparam2(path, wpath); - if (!CreateDirectoryW((LPWSTR)String_val(wpath), NULL)) { - win32_maperr (GetLastError ()); - uerror("mkdir", path); - } - CAMLreturn (Val_unit); -} - -CAMLprim value win_unlink(value path, value wpath) -{ - CAMLparam2(path, wpath); - if (!DeleteFileW((LPWSTR)String_val(wpath))) { - win32_maperr (GetLastError ()); - uerror("unlink", path); - } - CAMLreturn (Val_unit); -} - -CAMLprim value win_rename(value path1, value wpath1, value wpath2) -{ - CAMLparam3(path1, wpath1, wpath2); - if (!MoveFileExW((LPWSTR)String_val(wpath1), (LPWSTR)String_val(wpath2), - MOVEFILE_REPLACE_EXISTING)) { - win32_maperr (GetLastError ()); - uerror("rename", path1); - } - CAMLreturn (Val_unit); -} - -CAMLprim value win_chmod (value path, value wpath, value perm) { - DWORD attr; - CAMLparam3(path, wpath, perm); - - attr = GetFileAttributesW ((LPCWSTR)String_val (wpath)); - if (attr == INVALID_FILE_ATTRIBUTES) { - win32_maperr (GetLastError ()); - uerror("chmod", path); - } - if (Int_val(perm) & _S_IWRITE) - attr &= ~FILE_ATTRIBUTE_READONLY; - else - attr |= FILE_ATTRIBUTE_READONLY; - - if (!SetFileAttributesW ((LPCWSTR)String_val (wpath), attr)) { - win32_maperr (GetLastError ()); - uerror("chmod", path); - } - - CAMLreturn (Val_unit); -} - -CAMLprim value win_utimes (value path, value wpath, value atime, value mtime) { - HANDLE h; - BOOL res; - ULARGE_INTEGER iatime, imtime; - FILETIME fatime, fmtime; - - CAMLparam4(path, wpath, atime, mtime); - - iatime.QuadPart = Double_val(atime); - imtime.QuadPart = Double_val(mtime); - - /* http://www.filewatcher.com/p/Win32-UTCFileTime-1.44.tar.gz.93147/Win32-UTCFileTime-1.44/UTCFileTime.xs.html */ - /* http://savannah.nongnu.org/bugs/?22781#comment0 */ - if (iatime.QuadPart || imtime.QuadPart) { - iatime.QuadPart += 11644473600ull; - iatime.QuadPart *= 10000000ull; - fatime.dwLowDateTime = iatime.LowPart; - fatime.dwHighDateTime = iatime.HighPart; - imtime.QuadPart += 11644473600ull; - imtime.QuadPart *= 10000000ull; - fmtime.dwLowDateTime = imtime.LowPart; - fmtime.dwHighDateTime = imtime.HighPart; - } else { - GetSystemTimeAsFileTime (&fatime); - fmtime = fatime; - } - h = CreateFileW ((LPWSTR) wpath, FILE_WRITE_ATTRIBUTES, - FILE_SHARE_READ | FILE_SHARE_WRITE, - NULL, OPEN_EXISTING, 0, NULL); - if (h == INVALID_HANDLE_VALUE) { - win32_maperr (GetLastError ()); - uerror("utimes", path); - } - res = SetFileTime (h, NULL, &fatime, &fmtime); - if (res == 0) { - win32_maperr (GetLastError ()); - (void)CloseHandle (h); - uerror("utimes", path); - } - res = CloseHandle (h); - if (res == 0) { - win32_maperr (GetLastError ()); - uerror("utimes", path); - } - CAMLreturn (Val_unit); -} - -CAMLprim value win_open (value path, value wpath, value flags, value perm) { - int fileaccess, createflags, fileattrib, filecreate; - SECURITY_ATTRIBUTES attr; - HANDLE h; - - CAMLparam4 (path, wpath, flags, perm); - - fileaccess = convert_flag_list(flags, open_access_flags); - - createflags = convert_flag_list(flags, open_create_flags); - if ((createflags & (O_CREAT | O_EXCL)) == (O_CREAT | O_EXCL)) - filecreate = CREATE_NEW; - else if ((createflags & (O_CREAT | O_TRUNC)) == (O_CREAT | O_TRUNC)) - filecreate = CREATE_ALWAYS; - else if (createflags & O_TRUNC) - filecreate = TRUNCATE_EXISTING; - else if (createflags & O_CREAT) - filecreate = OPEN_ALWAYS; - else - filecreate = OPEN_EXISTING; - - if ((createflags & O_CREAT) && (Int_val(perm) & 0200) == 0) - fileattrib = FILE_ATTRIBUTE_READONLY; - else - fileattrib = FILE_ATTRIBUTE_NORMAL; - - attr.nLength = sizeof(attr); - attr.lpSecurityDescriptor = NULL; - attr.bInheritHandle = TRUE; - - h = CreateFileW((LPCWSTR) String_val(wpath), fileaccess, - FILE_SHARE_READ | FILE_SHARE_WRITE, &attr, - filecreate, fileattrib, NULL); - - if (h == INVALID_HANDLE_VALUE) { - win32_maperr (GetLastError ()); - uerror("open", path); - } - - CAMLreturn(win_alloc_handle(h)); -} - -/* -static int file_kind_table[] = { - S_IFREG, S_IFDIR, S_IFCHR, S_IFBLK, 0, S_IFIFO, 0 -}; - -static value stat_aux(int use_64, struct _stati64 *buf) -{ - CAMLparam0 (); - CAMLlocal1 (v); - - v = caml_alloc (12, 0); - Store_field (v, 0, Val_int (buf->st_dev)); - Store_field (v, 1, Val_int (buf->st_ino)); - Store_field (v, 2, cst_to_constr (buf->st_mode & S_IFMT, file_kind_table, - sizeof(file_kind_table) / sizeof(int), 0)); - Store_field (v, 3, Val_int(buf->st_mode & 07777)); - Store_field (v, 4, Val_int (buf->st_nlink)); - Store_field (v, 5, Val_int (buf->st_uid)); - Store_field (v, 6, Val_int (buf->st_gid)); - Store_field (v, 7, Val_int (buf->st_rdev)); - Store_field (v, 8, - use_64 ? copy_int64(buf->st_size) : Val_int (buf->st_size)); - Store_field (v, 9, copy_double((double) buf->st_atime)); - Store_field (v, 10, copy_double((double) buf->st_mtime)); - Store_field (v, 11, copy_double((double) buf->st_ctime)); - CAMLreturn (v); -} -*/ -#define MAKEDWORDLONG(a,b) ((DWORDLONG)(((DWORD)(a))|(((DWORDLONG)((DWORD)(b)))<<32))) -#define FILETIME_TO_TIME(ft) (((((ULONGLONG) ft.dwHighDateTime) << 32) + ft.dwLowDateTime) / 10000000ull - 11644473600ull) - -CAMLprim value win_stat(value path, value wpath) -{ - int res, mode; - HANDLE h; - BY_HANDLE_FILE_INFORMATION info; - CAMLparam2(path,wpath); - CAMLlocal1 (v); - - h = CreateFileW ((LPCWSTR) String_val (wpath), 0, 0, NULL, OPEN_EXISTING, - FILE_FLAG_BACKUP_SEMANTICS | FILE_ATTRIBUTE_READONLY, NULL); - - if (h == INVALID_HANDLE_VALUE) { - win32_maperr (GetLastError ()); - uerror("stat", path); - } - - res = GetFileInformationByHandle (h, &info); - if (res == 0) { - win32_maperr (GetLastError ()); - (void) CloseHandle (h); - uerror("stat", path); - } - - res = CloseHandle (h); - if (res == 0) { - win32_maperr (GetLastError ()); - uerror("stat", path); - } - - v = caml_alloc (12, 0); - Store_field (v, 0, Val_int (info.dwVolumeSerialNumber)); - Store_field - (v, 1, Val_int (MAKEDWORDLONG(info.nFileIndexLow,info.nFileIndexHigh))); - Store_field - (v, 2, Val_int (info.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY - ? 1: 0)); - mode = 0000444; - if (info.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) - mode |= 0000111; - if (!(info.dwFileAttributes & FILE_ATTRIBUTE_READONLY)) - mode |= 0000222; - Store_field (v, 3, Val_int(mode)); - Store_field (v, 4, Val_int (1)); - Store_field (v, 5, Val_int (0)); - Store_field (v, 6, Val_int (0)); - Store_field (v, 7, Val_int (0)); - Store_field - (v, 8, copy_int64(MAKEDWORDLONG(info.nFileSizeLow,info.nFileSizeHigh))); - Store_field - (v, 9, copy_double((double) FILETIME_TO_TIME(info.ftLastAccessTime))); - Store_field - (v, 10, copy_double((double) FILETIME_TO_TIME(info.ftLastWriteTime))); - Store_field - (v, 11, copy_double((double) FILETIME_TO_TIME(info.ftCreationTime))); - - CAMLreturn (v); -} - -/* -CAMLprim value win_stat(value path, value wpath) -{ - CAMLparam2(path,wpath); - int ret; - struct _stati64 buf; - ret = _wstati64((const wchar_t *)String_val(wpath), &buf); - if (ret == -1) uerror("stat", path); - CAMLreturn(stat_aux(1, &buf)); -} -*/ - -CAMLprim value win_chdir (value path, value wpath) -{ - CAMLparam2(path,wpath); - if (!SetCurrentDirectoryW ((LPWSTR)wpath)) { - win32_maperr(GetLastError()); - uerror("chdir", path); - } - CAMLreturn (Val_unit); -} - -CAMLprim value win_getcwd (value unit) -{ - int len; - LPWSTR s; - CAMLparam0(); - CAMLlocal1 (res); - - len = GetCurrentDirectoryW (0, NULL); - if (len == 0) { - win32_maperr(GetLastError()); - uerror("getcwd", Nothing); - } - s = stat_alloc (len * 2 + 2); - len = GetCurrentDirectoryW (len, s); - if (len == 0) { - stat_free (s); - win32_maperr(GetLastError()); - uerror("getcwd", Nothing); - } - res = copy_wstring(s); - stat_free (s); - CAMLreturn (res); -} - -CAMLprim value win_findfirstw(value name) -{ - HANDLE h; - WIN32_FIND_DATAW fileinfo; - - CAMLparam1(name); - CAMLlocal3(v, valname, valh); - - h = FindFirstFileW((LPCWSTR) String_val(name),&fileinfo); - if (h == INVALID_HANDLE_VALUE) { - DWORD err = GetLastError(); - if (err == ERROR_NO_MORE_FILES) - raise_end_of_file(); - else { - win32_maperr(err); - uerror("opendir", Nothing); - } - } - valname = copy_wstring(fileinfo.cFileName); - valh = win_alloc_handle(h); - v = alloc_small(2, 0); - Field(v,0) = valname; - Field(v,1) = valh; - CAMLreturn (v); -} - -CAMLprim value win_findnextw(value valh) -{ - WIN32_FIND_DATAW fileinfo; - BOOL retcode; - - CAMLparam1(valh); - - retcode = FindNextFileW(Handle_val(valh), &fileinfo); - if (!retcode) { - DWORD err = GetLastError(); - if (err == ERROR_NO_MORE_FILES) - raise_end_of_file(); - else { - win32_maperr(err); - uerror("readdir", Nothing); - } - } - CAMLreturn (copy_wstring(fileinfo.cFileName)); -} - -CAMLprim value win_findclosew(value valh) -{ - CAMLparam1(valh); - - if (! FindClose(Handle_val(valh))) { - win32_maperr(GetLastError()); - uerror("closedir", Nothing); - } - CAMLreturn (Val_unit); -} - -CAMLprim value win_getenv(value var) -{ - LPWSTR s; - DWORD len; - CAMLparam1(var); - CAMLlocal1(res); - - s = stat_alloc (65536); - - len = GetEnvironmentVariableW((LPCWSTR) String_val(var), s, 65536); - if (len == 0) { stat_free (s); raise_not_found(); } - - res = copy_wstring(s); - stat_free (s); - CAMLreturn (res); - -} - -CAMLprim value win_putenv(value var, value wvar, value v) -{ - BOOL res; - CAMLparam3(var, wvar, v); - - res = SetEnvironmentVariableW((LPCWSTR) String_val(wvar), (LPCWSTR) v); - if (res == 0) { - win32_maperr (GetLastError ()); - uerror("putenv", var); - } - CAMLreturn (Val_unit); -} - -CAMLprim value win_argv(value unit) -{ - int n, i; - LPWSTR * l; - - CAMLparam0(); - CAMLlocal2(v,res); - - l = CommandLineToArgvW (GetCommandLineW (), &n); - - if (l == NULL) { - win32_maperr (GetLastError ()); - uerror("argv", Nothing); - } - res = caml_alloc (n, 0); - for (i = 0; i < n; i++) { - v = copy_wstring (l[i]); - Store_field (res, i, v); - } - LocalFree (l); - CAMLreturn (res); -} Modified: trunk/src/terminal.ml =================================================================== --- trunk/src/terminal.ml 2009-05-14 15:59:33 UTC (rev 332) +++ trunk/src/terminal.ml 2009-05-15 14:34:43 UTC (rev 333) @@ -1,3 +1,20 @@ +(* Unison file synchronizer: src/terminal.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + (* Parsing messages from OpenSSH *) (* Examples. Modified: trunk/src/ubase/depend =================================================================== --- trunk/src/ubase/depend 2009-05-14 15:59:33 UTC (rev 332) +++ trunk/src/ubase/depend 2009-05-15 14:34:43 UTC (rev 333) @@ -2,8 +2,6 @@ myMap.cmx: myMap.cmi prefs.cmo: util.cmi uarg.cmi safelist.cmi prefs.cmi prefs.cmx: util.cmx uarg.cmx safelist.cmx prefs.cmi -projectInfo.cmo: -projectInfo.cmx: rx.cmo: rx.cmi rx.cmx: rx.cmi safelist.cmo: safelist.cmi Modified: trunk/src/uigtk2.ml =================================================================== --- trunk/src/uigtk2.ml 2009-05-14 15:59:33 UTC (rev 332) +++ trunk/src/uigtk2.ml 2009-05-15 14:34:43 UTC (rev 333) @@ -1463,8 +1463,10 @@ ) | None, _ -> (false, true, false) in - grSet grAction activate1; - grSet grDiff activate2; + if not !busy then begin + grSet grAction activate1; + grSet grDiff activate2 + end; if details then showDetailsButton#misc#show () else From vouillon at seas.upenn.edu Fri May 15 13:31:49 2009 From: vouillon at seas.upenn.edu (vouillon@seas.upenn.edu) Date: Fri, 15 May 2009 13:31:49 -0400 Subject: [Unison-hackers] [unison-svn] r334 - trunk/src Message-ID: <200905151731.n4FHVn8r020656@yaws.seas.upenn.edu> Author: vouillon Date: 2009-05-15 13:31:47 -0400 (Fri, 15 May 2009) New Revision: 334 Modified: trunk/src/.depend trunk/src/RECENTNEWS trunk/src/case.ml trunk/src/case.mli trunk/src/mkProjectInfo.ml trunk/src/remote.ml Log: * Cleaned-up the Unicode selection logic Modified: trunk/src/.depend =================================================================== --- trunk/src/.depend 2009-05-15 14:34:43 UTC (rev 333) +++ trunk/src/.depend 2009-05-15 17:31:47 UTC (rev 334) @@ -149,10 +149,10 @@ globals.cmx fileinfo.cmx common.cmx recon.cmi remote.cmo: uutil.cmi ubase/util.cmi ubase/trace.cmi terminal.cmi system.cmi \ ubase/safelist.cmi ubase/prefs.cmi os.cmi lwt/lwt_unix.cmi lwt/lwt.cmi \ - fspath.cmi common.cmi clroot.cmi remote.cmi + fspath.cmi fs.cmi common.cmi clroot.cmi case.cmi remote.cmi remote.cmx: uutil.cmx ubase/util.cmx ubase/trace.cmx terminal.cmx system.cmx \ ubase/safelist.cmx ubase/prefs.cmx os.cmx lwt/lwt_unix.cmx lwt/lwt.cmx \ - fspath.cmx common.cmx clroot.cmx remote.cmi + fspath.cmx fs.cmx common.cmx clroot.cmx case.cmx remote.cmi sortri.cmo: ubase/util.cmi ubase/safelist.cmi ubase/prefs.cmi pred.cmi \ path.cmi common.cmi sortri.cmi sortri.cmx: ubase/util.cmx ubase/safelist.cmx ubase/prefs.cmx pred.cmx \ Modified: trunk/src/RECENTNEWS =================================================================== --- trunk/src/RECENTNEWS 2009-05-15 14:34:43 UTC (rev 333) +++ trunk/src/RECENTNEWS 2009-05-15 17:31:47 UTC (rev 334) @@ -1,5 +1,9 @@ CHANGES FROM VERSION 2.34.0 +* Cleaned-up the Unicode selection logic +------------------------------- +CHANGES FROM VERSION 2.34.0 + * Bumped minor version: incompatible protocol changes * The use of the Windows Unicode API is now controlled via the "unicode" directive Modified: trunk/src/case.ml =================================================================== --- trunk/src/case.ml 2009-05-15 14:34:43 UTC (rev 333) +++ trunk/src/case.ml 2009-05-15 17:31:47 UTC (rev 334) @@ -40,26 +40,25 @@ Prefs.createBool "someHostIsInsensitive" false "*Pseudo-preference for internal use only" "" -let unicodePref = +let unicode = Prefs.createString "unicode" "default" "!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" let unicodeEncoding = - Prefs.createBool "unicodeEncoding" false + Prefs.createBool "unicodeEnc" false "*Pseudo-preference for internal use only" "" (* Whether we default to Unicode encoding on OSX and Windows *) -(* !!! the minor version should be increased whenever *) -(* !!! this default is changed *) let defaultToUnicode = false -let useUnicode pref b = +let useUnicode b = + let pref = Prefs.read unicode in pref = "yes" || pref = "true" || (defaultToUnicode && pref = "default" && b) -let useUnicodeAPI pref = useUnicode pref (Util.osType = `Win32) +let useUnicodeAPI () = useUnicode true (* 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 *) @@ -70,7 +69,7 @@ (Prefs.read caseInsensitiveMode = "yes" || Prefs.read caseInsensitiveMode = "true" || (Prefs.read caseInsensitiveMode = "default" && b)); - Prefs.set unicodeEncoding (useUnicode (Prefs.read unicodePref) b) + Prefs.set unicodeEncoding (useUnicode b) (****) Modified: trunk/src/case.mli =================================================================== --- trunk/src/case.mli 2009-05-15 14:34:43 UTC (rev 333) +++ trunk/src/case.mli 2009-05-15 17:31:47 UTC (rev 334) @@ -1,9 +1,8 @@ (* Unison file synchronizer: src/case.mli *) (* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) -val unicodePref : string Prefs.t val unicodeEncoding : bool Prefs.t -val useUnicodeAPI : string -> bool +val useUnicodeAPI : unit -> bool type mode Modified: trunk/src/mkProjectInfo.ml =================================================================== --- trunk/src/mkProjectInfo.ml 2009-05-15 14:34:43 UTC (rev 333) +++ trunk/src/mkProjectInfo.ml 2009-05-15 17:31:47 UTC (rev 334) @@ -149,3 +149,4 @@ + Modified: trunk/src/remote.ml =================================================================== --- trunk/src/remote.ml 2009-05-15 14:34:43 UTC (rev 333) +++ trunk/src/remote.ml 2009-05-15 17:31:47 UTC (rev 334) @@ -918,7 +918,7 @@ let canonizeLocally s unicode = (* We need to select the proper API in order to compute correctly the canonical fspath *) - Fs.setUnicodeEncoding (Case.useUnicodeAPI unicode); + Fs.setUnicodeEncoding unicode; Fspath.canonize s let canonizeOnServer = @@ -929,7 +929,7 @@ let canonize clroot = (* connection for clroot must have been set up already *) match clroot with Clroot.ConnectLocal s -> - (Common.Local, canonizeLocally s (Prefs.read Case.unicodePref)) + (Common.Local, canonizeLocally s (Case.useUnicodeAPI ())) | _ -> match try @@ -950,7 +950,7 @@ None let canonizeRoot rootName clroot termInteract = - let unicode = Prefs.read Case.unicodePref in + let unicode = Case.useUnicodeAPI () in let finish ioServer s = (* We need to always compute the fspath as it depends on unicode settings *) @@ -1001,7 +1001,7 @@ end >>= fun ioServer -> (* We need to always compute the fspath as it depends on unicode settings *) - let unicode = Prefs.read Case.unicodePref in + let unicode = Case.useUnicodeAPI () in canonizeOnServer ioServer (s, unicode) >>= fun (host, fspath) -> connectedHosts := listReplace (clroot, (host, fspath, ioServer)) !connectedHosts; @@ -1012,7 +1012,7 @@ | Clroot.ConnectByShell(shell,host,userOpt,portOpt,s) -> match hostFspath clroot with Some x -> - let unicode = Prefs.read Case.unicodePref in + let unicode = Case.useUnicodeAPI () in (* We recompute the fspath as it may have changed due to unicode settings *) Lwt_unix.run @@ -1103,7 +1103,7 @@ Unix.close i1; Unix.close o2; Lwt_unix.run (initConnection i2 o1 >>= fun ioServer -> - let unicode = Prefs.read Case.unicodePref in + let unicode = Case.useUnicodeAPI () in canonizeOnServer ioServer (s, unicode) >>= fun (host, fspath) -> connectedHosts := listReplace (clroot, (host, fspath, ioServer)) !connectedHosts; From bcpierce at seas.upenn.edu Tue May 19 12:50:49 2009 From: bcpierce at seas.upenn.edu (Benjamin C. Pierce) Date: Tue, 19 May 2009 12:50:49 -0400 Subject: [Unison-hackers] [unison-svn] r335 - in trunk: doc src Message-ID: <200905191650.n4JGon0V019528@yaws.seas.upenn.edu> Author: bcpierce Date: 2009-05-19 12:50:48 -0400 (Tue, 19 May 2009) New Revision: 335 Modified: trunk/doc/unison-manual.tex trunk/src/RECENTNEWS trunk/src/mkProjectInfo.ml Log: * Small documentation fix suggested by mszsummer. Modified: trunk/doc/unison-manual.tex =================================================================== --- trunk/doc/unison-manual.tex 2009-05-15 17:31:47 UTC (rev 334) +++ trunk/doc/unison-manual.tex 2009-05-19 16:50:48 UTC (rev 335) @@ -1255,7 +1255,7 @@ \verb|rootalias| preference. The preference file may contain any number of lines of the form: \begin{alltt} - rootalias = //\NT{hostnameA}//\NT{path-to-replicaA} -> //\NT{hostnameB}//\NT{path-to-replicaB} + rootalias = //\NT{hostnameA}//\NT{path-to-replicaA} -> //\NT{hostnameB}/\NT{path-to-replicaB} \end{alltt} When calculating the name of the archive files for a given pair of roots, Unison replaces any root that matches the left-hand side of any rootalias @@ -1264,8 +1264,10 @@ So, if you need to relocate a root on one of the hosts, you can add a rule of the form: \begin{alltt} - rootalias = //\NT{new-hostname}//\NT{new-path} -> //\NT{old-hostname}//\NT{old-path} + rootalias = //\NT{new-hostname}//\NT{new-path} -> //\NT{old-hostname}/\NT{old-path} \end{alltt} +Note that root aliases are case-sensitive, even on case-insensitive file +systems. {\em Warning}: The \verb|rootalias| option is dangerous and should only be used if you are sure you know what you're doing. In particular, it Modified: trunk/src/RECENTNEWS =================================================================== --- trunk/src/RECENTNEWS 2009-05-15 17:31:47 UTC (rev 334) +++ trunk/src/RECENTNEWS 2009-05-19 16:50:48 UTC (rev 335) @@ -1,5 +1,13 @@ CHANGES FROM VERSION 2.34.0 +* Small documentation fix suggested by mszsummer. + + + + +------------------------------- +CHANGES FROM VERSION 2.34.0 + * Cleaned-up the Unicode selection logic ------------------------------- CHANGES FROM VERSION 2.34.0 @@ -17,6 +25,14 @@ ------------------------------- CHANGES FROM VERSION 2.33.2 +* Small documentation fix suggested by mszsummer. + + + + +------------------------------- +CHANGES FROM VERSION 2.33.2 + * Added an abstraction layer over Unix/Sys modules in order to be able to redefine all system calls involving filenames * Implemented corresponding bindings for the Windows Unicode API Modified: trunk/src/mkProjectInfo.ml =================================================================== --- trunk/src/mkProjectInfo.ml 2009-05-15 17:31:47 UTC (rev 334) +++ trunk/src/mkProjectInfo.ml 2009-05-19 16:50:48 UTC (rev 335) @@ -150,3 +150,4 @@ + From bcpierce at seas.upenn.edu Tue May 19 12:51:45 2009 From: bcpierce at seas.upenn.edu (Benjamin C. Pierce) Date: Tue, 19 May 2009 12:51:45 -0400 Subject: [Unison-hackers] [unison-svn] r336 - in branches/2.32: doc src Message-ID: <200905191651.n4JGpjrh019586@yaws.seas.upenn.edu> Author: bcpierce Date: 2009-05-19 12:51:43 -0400 (Tue, 19 May 2009) New Revision: 336 Modified: branches/2.32/doc/unison-manual.tex branches/2.32/src/NEWS branches/2.32/src/RECENTNEWS branches/2.32/src/mkProjectInfo.ml branches/2.32/src/strings.ml Log: * Small documentation fix suggested by mszsummer. Modified: branches/2.32/doc/unison-manual.tex =================================================================== --- branches/2.32/doc/unison-manual.tex 2009-05-19 16:50:48 UTC (rev 335) +++ branches/2.32/doc/unison-manual.tex 2009-05-19 16:51:43 UTC (rev 336) @@ -1255,7 +1255,7 @@ \verb|rootalias| preference. The preference file may contain any number of lines of the form: \begin{alltt} - rootalias = //\NT{hostnameA}//\NT{path-to-replicaA} -> //\NT{hostnameB}//\NT{path-to-replicaB} + rootalias = //\NT{hostnameA}//\NT{path-to-replicaA} -> //\NT{hostnameB}/\NT{path-to-replicaB} \end{alltt} When calculating the name of the archive files for a given pair of roots, Unison replaces any root that matches the left-hand side of any rootalias @@ -1264,8 +1264,10 @@ So, if you need to relocate a root on one of the hosts, you can add a rule of the form: \begin{alltt} - rootalias = //\NT{new-hostname}//\NT{new-path} -> //\NT{old-hostname}//\NT{old-path} + rootalias = //\NT{new-hostname}//\NT{new-path} -> //\NT{old-hostname}/\NT{old-path} \end{alltt} +Note that root aliases are case-sensitive, even on case-insensitive file +systems. {\em Warning}: The \verb|rootalias| option is dangerous and should only be used if you are sure you know what you're doing. In particular, it Modified: branches/2.32/src/NEWS =================================================================== --- branches/2.32/src/NEWS 2009-05-19 16:50:48 UTC (rev 335) +++ branches/2.32/src/NEWS 2009-05-19 16:51:43 UTC (rev 336) @@ -1,11 +1,7 @@ -Changes in Version 2.32.10 +Changes in Version 2.32.12 Changes since 2.31: - * Small user interface changes - + Small change to text UI "scanning..." messages, to print just - directories (hopefully making it clearer that individual - files are not necessarily being fingerprinted). * Minor fixes and improvements: + Ignore one hour differences when deciding whether a file may have been updated. This avoids slow update detection after Modified: branches/2.32/src/RECENTNEWS =================================================================== --- branches/2.32/src/RECENTNEWS 2009-05-19 16:50:48 UTC (rev 335) +++ branches/2.32/src/RECENTNEWS 2009-05-19 16:51:43 UTC (rev 336) @@ -1,3 +1,10 @@ +CHANGES FROM VERSION 2.32.19 + +* Small documentation fix suggested by mszsummer. + + + +------------------------------- CHANGES FROM VERSION 2.32.12 * Fixed bug in GTK UI: buttons could be incorrectly activated back during Modified: branches/2.32/src/mkProjectInfo.ml =================================================================== --- branches/2.32/src/mkProjectInfo.ml 2009-05-19 16:50:48 UTC (rev 335) +++ branches/2.32/src/mkProjectInfo.ml 2009-05-19 16:51:43 UTC (rev 336) @@ -109,3 +109,4 @@ + Modified: branches/2.32/src/strings.ml =================================================================== --- branches/2.32/src/strings.ml 2009-05-19 16:50:48 UTC (rev 335) +++ branches/2.32/src/strings.ml 2009-05-19 16:51:43 UTC (rev 336) @@ -4,7 +4,7 @@ let docs = ("about", ("About Unison", "Unison File Synchronizer\n\ - Version 2.32.10\n\ + Version 2.32.12\n\ \n\ ")) :: @@ -2582,14 +2582,10 @@ \n\ ")) :: - ("news", ("Changes in Version 2.32.10", - "Changes in Version 2.32.10\n\ + ("news", ("Changes in Version 2.32.12", + "Changes in Version 2.32.12\n\ \n\ \032 Changes since 2.31:\n\ - \032 * Small user interface changes\n\ - \032 + Small change to text UI \"scanning...\" messages, to print just\n\ - \032 directories (hopefully making it clearer that individual\n\ - \032 files are not necessarily being fingerprinted).\n\ \032 * Minor fixes and improvements:\n\ \032 + Ignore one hour differences when deciding whether a file may\n\ \032 have been updated. This avoids slow update detection after\n\ From vouillon at seas.upenn.edu Tue May 26 05:38:25 2009 From: vouillon at seas.upenn.edu (vouillon@seas.upenn.edu) Date: Tue, 26 May 2009 05:38:25 -0400 Subject: [Unison-hackers] [unison-svn] r337 - in trunk/src: . lwt system system/generic Message-ID: <200905260938.n4Q9cPjP028698@yaws.seas.upenn.edu> Author: vouillon Date: 2009-05-26 05:38:19 -0400 (Tue, 26 May 2009) New Revision: 337 Modified: trunk/src/.depend trunk/src/Makefile.OCaml trunk/src/RECENTNEWS trunk/src/external.ml trunk/src/files.ml trunk/src/lwt/lwt_unix.ml trunk/src/lwt/lwt_unix.mli trunk/src/mkProjectInfo.ml trunk/src/remote.ml trunk/src/system/ trunk/src/system/generic/ trunk/src/system/system_generic.ml trunk/src/system/system_intf.ml trunk/src/system/system_win.ml trunk/src/system/system_win_stubs.c trunk/src/terminal.ml trunk/src/uigtk2.ml trunk/src/uitext.ml trunk/src/unicode.ml trunk/src/unicode.mli Log: * Use system dependant API for spawning processes. (Unicode API under Windows.) * Fixed the bug with ssh not working when running unison from a cygwin shell. * Move [protect] function (which converts a string to UTF-8 by keeping all UTF-8 characters unchanged and considering all other characters as ISO 8859-1 characters) from uigtk2.ml to unicode.ml, as it may be useful for the other UIs. Modified: trunk/src/.depend =================================================================== --- trunk/src/.depend 2009-05-19 16:51:43 UTC (rev 336) +++ trunk/src/.depend 2009-05-26 09:38:19 UTC (rev 337) @@ -65,9 +65,9 @@ ubase/safelist.cmx remote.cmx props.cmx ubase/prefs.cmx path.cmx osx.cmx \ os.cmx lwt/lwt_util.cmx lwt/lwt.cmx globals.cmx fspath.cmx fs.cmx \ fileinfo.cmx external.cmx common.cmx clroot.cmx abort.cmx copy.cmi -external.cmo: ubase/util.cmi ubase/safelist.cmi lwt/lwt_util.cmi \ +external.cmo: ubase/util.cmi system.cmi ubase/safelist.cmi lwt/lwt_util.cmi \ lwt/lwt_unix.cmi lwt/lwt.cmi external.cmi -external.cmx: ubase/util.cmx ubase/safelist.cmx lwt/lwt_util.cmx \ +external.cmx: ubase/util.cmx system.cmx ubase/safelist.cmx lwt/lwt_util.cmx \ lwt/lwt_unix.cmx lwt/lwt.cmx external.cmi fileinfo.cmo: ubase/util.cmi system.cmi props.cmi ubase/prefs.cmi path.cmi \ osx.cmi fspath.cmi fs.cmi fileinfo.cmi @@ -169,10 +169,10 @@ strings.cmx: strings.cmi system.cmo: system.cmi system.cmx: system.cmi -terminal.cmo: ubase/safelist.cmi ubase/rx.cmi lwt/lwt_unix.cmi lwt/lwt.cmi \ - terminal.cmi -terminal.cmx: ubase/safelist.cmx ubase/rx.cmx lwt/lwt_unix.cmx lwt/lwt.cmx \ - terminal.cmi +terminal.cmo: system.cmi ubase/safelist.cmi ubase/rx.cmi lwt/lwt_unix.cmi \ + lwt/lwt.cmi terminal.cmi +terminal.cmx: system.cmx ubase/safelist.cmx ubase/rx.cmx lwt/lwt_unix.cmx \ + lwt/lwt.cmx terminal.cmi test.cmo: uutil.cmi ubase/util.cmi update.cmi uicommon.cmi transport.cmi \ ubase/trace.cmi stasher.cmi ubase/safelist.cmi remote.cmi recon.cmi \ ubase/prefs.cmi path.cmi os.cmi lwt/lwt_util.cmi lwt/lwt_unix.cmi \ @@ -207,16 +207,16 @@ recon.cmx props.cmx ubase/prefs.cmx path.cmx osx.cmx os.cmx name.cmx \ lwt/lwt_unix.cmx lwt/lwt.cmx globals.cmx fspath.cmx files.cmx \ fileinfo.cmx common.cmx clroot.cmx case.cmx uicommon.cmi -uigtk2.cmo: uutil.cmi ubase/util.cmi update.cmi uitext.cmi uicommon.cmi \ - transport.cmi ubase/trace.cmi system.cmi strings.cmi sortri.cmi \ - ubase/safelist.cmi remote.cmi recon.cmi ubase/prefs.cmi pixmaps.cmo \ - path.cmi os.cmi lwt/lwt_util.cmi lwt/lwt_unix.cmi lwt/lwt.cmi globals.cmi \ - files.cmi common.cmi clroot.cmi case.cmi uigtk2.cmi -uigtk2.cmx: uutil.cmx ubase/util.cmx update.cmx uitext.cmx uicommon.cmx \ - transport.cmx ubase/trace.cmx system.cmx strings.cmx sortri.cmx \ - ubase/safelist.cmx remote.cmx recon.cmx ubase/prefs.cmx pixmaps.cmx \ - path.cmx os.cmx lwt/lwt_util.cmx lwt/lwt_unix.cmx lwt/lwt.cmx globals.cmx \ - files.cmx common.cmx clroot.cmx case.cmx uigtk2.cmi +uigtk2.cmo: uutil.cmi ubase/util.cmi update.cmi unicode.cmi uitext.cmi \ + uicommon.cmi transport.cmi ubase/trace.cmi system.cmi strings.cmi \ + sortri.cmi ubase/safelist.cmi remote.cmi recon.cmi ubase/prefs.cmi \ + pixmaps.cmo path.cmi os.cmi lwt/lwt_util.cmi lwt/lwt_unix.cmi lwt/lwt.cmi \ + globals.cmi files.cmi common.cmi clroot.cmi case.cmi uigtk2.cmi +uigtk2.cmx: uutil.cmx ubase/util.cmx update.cmx unicode.cmx uitext.cmx \ + uicommon.cmx transport.cmx ubase/trace.cmx system.cmx strings.cmx \ + sortri.cmx ubase/safelist.cmx remote.cmx recon.cmx ubase/prefs.cmx \ + pixmaps.cmx path.cmx os.cmx lwt/lwt_util.cmx lwt/lwt_unix.cmx lwt/lwt.cmx \ + globals.cmx files.cmx common.cmx clroot.cmx case.cmx uigtk2.cmi uigtk.cmo: uutil.cmi ubase/util.cmi update.cmi uitext.cmi uicommon.cmi \ transport.cmi ubase/trace.cmi system.cmi strings.cmi sortri.cmi \ ubase/safelist.cmi remote.cmi recon.cmi ubase/prefs.cmi pixmaps.cmo \ Modified: trunk/src/Makefile.OCaml =================================================================== --- trunk/src/Makefile.OCaml 2009-05-19 16:51:43 UTC (rev 336) +++ trunk/src/Makefile.OCaml 2009-05-26 09:38:19 UTC (rev 337) @@ -283,8 +283,8 @@ # Include an automatically generated list of dependencies include .depend # Additional dependencied depending on the system -system.cmo fs.cmo: system/$(SYSTEM)/system_impl.cmo -system.cmx fs.cmx: system/$(SYSTEM)/system_impl.cmx +system.cmo fspath.cmo fs.cmo: system/$(SYSTEM)/system_impl.cmo +system.cmx fspath.cmx fs.cmx: system/$(SYSTEM)/system_impl.cmx ifeq ($(OSARCH), OpenBSD) ifeq ($(shell echo type ocamldot | ksh), file) Modified: trunk/src/RECENTNEWS =================================================================== --- trunk/src/RECENTNEWS 2009-05-19 16:51:43 UTC (rev 336) +++ trunk/src/RECENTNEWS 2009-05-26 09:38:19 UTC (rev 337) @@ -1,5 +1,17 @@ CHANGES FROM VERSION 2.34.0 +* Use system dependant API for spawning processes. + (Unicode API under Windows.) +* Fixed the bug with ssh not working when running unison from a cygwin + shell. +* Move [protect] function (which converts a string to UTF-8 by keeping + all UTF-8 characters unchanged and considering all other characters + as ISO 8859-1 characters) from uigtk2.ml to unicode.ml, as it may be + useful for the other UIs. + +------------------------------- +CHANGES FROM VERSION 2.34.0 + * Small documentation fix suggested by mszsummer. Modified: trunk/src/external.ml =================================================================== --- trunk/src/external.ml 2009-05-19 16:51:43 UTC (rev 336) +++ trunk/src/external.ml 2009-05-26 09:38:19 UTC (rev 337) @@ -64,9 +64,9 @@ let runExternalProgram cmd = if Util.osType = `Win32 && not Util.isCygwin then begin debug (fun()-> Util.msg "Executing external program windows-style\n"); - let c = Unix.open_process_in ("\"" ^ cmd ^ "\"") in + let c = System.open_process_in ("\"" ^ cmd ^ "\"") in let log = readChannelTillEof c in - let returnValue = Unix.close_process_in c in + let returnValue = System.close_process_in c in let mergeResultLog = cmd ^ (if log <> "" then "\n\n" ^ log else "") ^ @@ -76,12 +76,12 @@ "") in (returnValue,mergeResultLog) end else Lwt_unix.run ( - Lwt_unix.open_process_full cmd (Unix.environment ()) - >>= (fun (out, ipt, err) -> + let (out, ipt, err) as desc = System.open_process_full cmd in + let out = Lwt_unix.intern_in_channel out in + let err = Lwt_unix.intern_in_channel err in readChannelsTillEof [out;err] >>= (function [logOut;logErr] -> - Lwt_unix.close_process_full (out, ipt, err) - >>= (fun returnValue -> + let returnValue = System.close_process_full desc in let logOut = Util.trimWhitespace logOut in let logErr = Util.trimWhitespace logErr in return (returnValue, ( @@ -92,6 +92,6 @@ else logOut ^ "\n\n" ^ ("Error Output:" ^ logErr)) ^ (if returnValue = Unix.WEXITED 0 then "" - else "\n\n" ^ Util.process_status_to_string returnValue)))) + else "\n\n" ^ Util.process_status_to_string returnValue))) (* Stop typechechecker from complaining about non-exhaustive pattern above *) - | _ -> assert false))) + | _ -> assert false)) Modified: trunk/src/files.ml =================================================================== --- trunk/src/files.ml 2009-05-19 16:51:43 UTC (rev 336) +++ trunk/src/files.ml 2009-05-26 09:38:19 UTC (rev 337) @@ -496,9 +496,7 @@ Util.replacesubstrings (Prefs.read diffCmd) ["CURRENT1", Fspath.quotes fspath1; "CURRENT2", Fspath.quotes fspath2] in - (* Doesn't seem to work well on Windows! - let c = Lwt_unix.run (Lwt_unix.open_process_in cmd) in *) - let c = Unix.open_process_in + let c = System.open_process_in (if Util.osType = `Win32 && not Util.isCygwin then (* BCP: Proposed by Karl M. to deal with the standard windows command processor's weird treatment of spaces and quotes: *) @@ -506,7 +504,7 @@ else cmd) in showDiff cmd (External.readChannelTillEof c); - ignore (Unix.close_process_in c) in + ignore (System.close_process_in c) in let (desc1, fp1, ress1, desc2, fp2, ress2) = Common.fileInfos ui1 ui2 in match root1,root2 with (Local,fspath1),(Local,fspath2) -> Modified: trunk/src/lwt/lwt_unix.ml =================================================================== --- trunk/src/lwt/lwt_unix.ml 2009-05-19 16:51:43 UTC (rev 336) +++ trunk/src/lwt/lwt_unix.ml 2009-05-26 09:38:19 UTC (rev 337) @@ -291,6 +291,12 @@ type lwt_in_channel = in_channel type lwt_out_channel = out_channel +let intern_in_channel ch = + Unix.set_nonblock (Unix.descr_of_in_channel ch); ch +let intern_out_channel ch = + Unix.set_nonblock (Unix.descr_of_out_channel ch); ch + + let wait_inchan ic = wait_read (Unix.descr_of_in_channel ic) let wait_outchan oc = wait_write (Unix.descr_of_out_channel oc) Modified: trunk/src/lwt/lwt_unix.mli =================================================================== --- trunk/src/lwt/lwt_unix.mli 2009-05-19 16:51:43 UTC (rev 336) +++ trunk/src/lwt/lwt_unix.mli 2009-05-26 09:38:19 UTC (rev 337) @@ -49,6 +49,9 @@ type lwt_in_channel type lwt_out_channel +val intern_in_channel : in_channel -> lwt_in_channel +val intern_out_channel : out_channel -> lwt_out_channel + val input_char : lwt_in_channel -> char Lwt.t val input_line : lwt_in_channel -> string Lwt.t val input : lwt_in_channel -> string -> int -> int -> int Lwt.t Modified: trunk/src/mkProjectInfo.ml =================================================================== --- trunk/src/mkProjectInfo.ml 2009-05-19 16:51:43 UTC (rev 336) +++ trunk/src/mkProjectInfo.ml 2009-05-26 09:38:19 UTC (rev 337) @@ -151,3 +151,4 @@ + Modified: trunk/src/remote.ml =================================================================== --- trunk/src/remote.ml 2009-05-19 16:51:43 UTC (rev 336) +++ trunk/src/remote.ml 2009-05-26 09:38:19 UTC (rev 337) @@ -899,12 +899,13 @@ debug (fun ()-> Util.msg "Shell connection: %s (%s)\n" shellCmd (String.concat ", " args)); let term = + Util.convertUnixErrorsToFatal "starting shell connection" (fun () -> match termInteract with None -> - ignore (Unix.create_process shellCmd argsarray i1 o2 Unix.stderr); + ignore (System.create_process shellCmd argsarray i1 o2 Unix.stderr); None | Some callBack -> - fst (Terminal.create_session shellCmd argsarray i1 o2 Unix.stderr) + fst (Terminal.create_session shellCmd argsarray i1 o2 Unix.stderr)) in Unix.close i1; Unix.close o2; begin match term, termInteract with Property changes on: trunk/src/system ___________________________________________________________________ Name: svn:ignore + *.cmi *.cmo *.cmx Property changes on: trunk/src/system/generic ___________________________________________________________________ Name: svn:ignore + *.cmi *.cmo *.cmx Modified: trunk/src/system/system_generic.ml =================================================================== --- trunk/src/system/system_generic.ml 2009-05-19 16:51:43 UTC (rev 336) +++ trunk/src/system/system_generic.ml 2009-05-26 09:38:19 UTC (rev 337) @@ -61,3 +61,13 @@ let file_exists = Sys.file_exists let open_in_bin = open_in_bin + +(****) + +let create_process = Unix.create_process +let open_process_in = Unix.open_process_in +let open_process_out = Unix.open_process_out +let open_process_full cmd = Unix.open_process_full cmd (Unix.environment ()) +let close_process_in = Unix.close_process_in +let close_process_out = Unix.close_process_out +let close_process_full = Unix.close_process_full Modified: trunk/src/system/system_intf.ml =================================================================== --- trunk/src/system/system_intf.ml 2009-05-19 16:51:43 UTC (rev 336) +++ trunk/src/system/system_intf.ml 2009-05-26 09:38:19 UTC (rev 337) @@ -67,4 +67,16 @@ val chdir : fspath -> unit val getcwd : unit -> fspath +val create_process : + string -> string array -> + Unix.file_descr -> Unix.file_descr -> Unix.file_descr -> int +val open_process_in : string -> in_channel +val open_process_out : string -> out_channel +val open_process_full : + string -> in_channel * out_channel * in_channel +val close_process_in : in_channel -> Unix.process_status +val close_process_out : out_channel -> Unix.process_status +val close_process_full : + in_channel * out_channel * in_channel -> Unix.process_status + end Modified: trunk/src/system/system_win.ml =================================================================== --- trunk/src/system/system_win.ml 2009-05-19 16:51:43 UTC (rev 336) +++ trunk/src/system/system_win.ml 2009-05-26 09:38:19 UTC (rev 337) @@ -17,19 +17,19 @@ (*XXXX -We have to propagate the encoding mode when canonizing roots -===> new major version +Backport to stable: +- Unix.select in lwt_unix (after some testing...) +- fix to daylight saving changes -TO CONVERT -========== -Unix.open_process_in -Unix.open_process_out -Unix.create_process -Unix.execvp -Lwt_unix.open_process_full -Lwt_unix.open_process_in +Try to rename several time if access denied the first time +Remove 16Mib limit by using a temp file (or bigarray) +http://caml.inria.fr/pub/ml-archives/caml-list/2004/06/2176c54608c3c39e2dbbd9365c2fc6bb.en.html +http://caml.inria.fr/pub/ml-archives/caml-list/2007/01/04ef3c364e41f5f60f70192609d87035.en.html + - Use SetConsoleOutputCP/SetConsoleCP in text mode ??? +http://www.codeproject.com/KB/cpp/unicode_console_output.aspx?display=Print + *) type fspath = string @@ -190,3 +190,100 @@ sys_error e let open_in_bin f = open_in_gen [Open_rdonly; Open_binary] 0 f + +(****) + +external win_create_process : + string -> string -> string -> + Unix.file_descr -> Unix.file_descr -> Unix.file_descr -> int + = "w_create_process" "w_create_process_native" + +let make_cmdline args = + let maybe_quote f = + if String.contains f ' ' || String.contains f '\"' + then Filename.quote f + else f in + String.concat " " (List.map maybe_quote (Array.to_list args)) + +let create_process prog args fd1 fd2 fd3 = + win_create_process + prog (utf16 prog) (utf16 (make_cmdline args)) fd1 fd2 fd3 + +(****) + +(* The following is by Xavier Leroy and Pascal Cuoq, + projet Cristal, INRIA Rocquencourt. + Taken from the Objective Caml win32unix library. *) + +type popen_process = + Process of in_channel * out_channel + | Process_in of in_channel + | Process_out of out_channel + | Process_full of in_channel * out_channel * in_channel + +let popen_processes = (Hashtbl.create 7 : (popen_process, int) Hashtbl.t) + +let open_proc cmd proc input output error = + let shell = + try getenv "COMSPEC" + with Not_found -> raise(Unix.Unix_error(Unix.ENOEXEC, "open_proc", cmd)) in + let pid = + win_create_process + shell (utf16 shell) (utf16 (shell ^ " /c " ^ cmd)) input output error in + Hashtbl.add popen_processes proc pid + +let open_process_in cmd = + let (in_read, in_write) = Unix.pipe() in + Unix.set_close_on_exec in_read; + let inchan = Unix.in_channel_of_descr in_read in + open_proc cmd (Process_in inchan) Unix.stdin in_write Unix.stderr; + Unix.close in_write; + inchan + +let open_process_out cmd = + let (out_read, out_write) = Unix.pipe() in + Unix.set_close_on_exec out_write; + let outchan = Unix.out_channel_of_descr out_write in + open_proc cmd (Process_out outchan) out_read Unix.stdout Unix.stderr; + Unix.close out_read; + outchan + +let open_process_full cmd = + let (in_read, in_write) = Unix.pipe() in + let (out_read, out_write) = Unix.pipe() in + let (err_read, err_write) = Unix.pipe() in + Unix.set_close_on_exec in_read; + Unix.set_close_on_exec out_write; + Unix.set_close_on_exec err_read; + let inchan = Unix.in_channel_of_descr in_read in + let outchan = Unix.out_channel_of_descr out_write in + let errchan = Unix.in_channel_of_descr err_read in + open_proc cmd (Process_full(inchan, outchan, errchan)) + out_read in_write err_write; + Unix.close out_read; Unix.close in_write; Unix.close err_write; + (inchan, outchan, errchan) + +let find_proc_id fun_name proc = + try + let pid = Hashtbl.find popen_processes proc in + Hashtbl.remove popen_processes proc; + pid + with Not_found -> + raise(Unix.Unix_error(Unix.EBADF, fun_name, "")) + +let close_process_in inchan = + let pid = find_proc_id "close_process_in" (Process_in inchan) in + close_in inchan; + snd(Unix.waitpid [] pid) + +let close_process_out outchan = + let pid = find_proc_id "close_process_out" (Process_out outchan) in + close_out outchan; + snd(Unix.waitpid [] pid) + +let close_process_full (inchan, outchan, errchan) = + let pid = + find_proc_id "close_process_full" + (Process_full(inchan, outchan, errchan)) in + close_in inchan; close_out outchan; close_in errchan; + snd(Unix.waitpid [] pid) Modified: trunk/src/system/system_win_stubs.c =================================================================== --- trunk/src/system/system_win_stubs.c 2009-05-19 16:51:43 UTC (rev 336) +++ trunk/src/system/system_win_stubs.c 2009-05-26 09:38:19 UTC (rev 337) @@ -23,6 +23,8 @@ #include #include +#define NT_MAX_PATH 32768 + #define Nothing ((value) 0) struct filedescr { @@ -293,28 +295,24 @@ CAMLprim value win_getcwd (value unit) { int res; - LPWSTR s; + wchar_t s[NT_MAX_PATH]; CAMLparam0(); CAMLlocal1 (path); - s = stat_alloc (32768 * 2); - res = GetCurrentDirectoryW (32768, s); + res = GetCurrentDirectoryW (NT_MAX_PATH, s); if (res == 0) { - stat_free (s); win32_maperr(GetLastError()); uerror("getcwd", Nothing); } /* Normalize the path */ - res = GetLongPathNameW (s, s, 32768); + res = GetLongPathNameW (s, s, NT_MAX_PATH); if (res == 0) { - stat_free (s); win32_maperr(GetLastError()); uerror("getcwd", Nothing); } /* Convert the drive letter to uppercase */ if (s[0] >= L'a' && s[0] <= L'z') s[0] -= 32; path = copy_wstring(s); - stat_free (s); CAMLreturn (path); } @@ -428,3 +426,59 @@ LocalFree (l); CAMLreturn (res); } + +CAMLprim value w_create_process_native +(value prog, value wprog, value wargs, value fd1, value fd2, value fd3) +{ + int res, flags; + PROCESS_INFORMATION pi; + STARTUPINFOW si; + wchar_t fullname [MAX_PATH]; + HANDLE h; + CAMLparam5(wprog, wargs, fd1, fd2, fd3); + + res = SearchPathW (NULL, (LPCWSTR) String_val(wprog), L".exe", + MAX_PATH, fullname, NULL); + if (res == 0) { + win32_maperr (GetLastError ()); + uerror("create_process", prog); + } + + ZeroMemory(&si, sizeof(STARTUPINFO)); + + si.cb = sizeof(STARTUPINFO); + si.dwFlags = STARTF_USESTDHANDLES; + si.hStdInput = Handle_val(fd1); + si.hStdOutput = Handle_val(fd2); + si.hStdError = Handle_val(fd3); + + flags = GetPriorityClass (GetCurrentProcess ()); + /* + h = CreateFile ("CONOUT$", GENERIC_WRITE, FILE_SHARE_WRITE, NULL, + OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); + if (h != INVALID_HANDLE_VALUE) + CloseHandle (h); + else { + flags |= CREATE_NEW_CONSOLE; + // si.dwFlags |= STARTF_USESHOWWINDOW; + // si.wShowWindow = SW_MINIMIZE; + } + */ + + res = CreateProcessW (fullname, (LPWSTR) String_val(wargs), + NULL, NULL, TRUE, flags, + NULL, NULL, &si, &pi); + if (res == 0) { + win32_maperr (GetLastError ()); + uerror("create_process", prog); + } + + CloseHandle (pi.hThread); + CAMLreturn (Val_long (pi.hProcess)); +} + +CAMLprim value w_create_process(value * argv, int argn) +{ + return w_create_process_native(argv[0], argv[1], argv[2], + argv[3], argv[4], argv[5]); +} Modified: trunk/src/terminal.ml =================================================================== --- trunk/src/terminal.ml 2009-05-19 16:51:43 UTC (rev 336) +++ trunk/src/terminal.ml 2009-05-26 09:38:19 UTC (rev 337) @@ -183,7 +183,7 @@ match openpty () with None -> (None, - Unix.create_process cmd args new_stdin new_stdout new_stderr) + System.create_process cmd args new_stdin new_stdout new_stderr) | Some (masterFd, slaveFd) -> (* Printf.printf "openpty returns %d--%d\n" (dumpFd fdM) (dumpFd fdS); flush stdout; Modified: trunk/src/uigtk2.ml =================================================================== --- trunk/src/uigtk2.ml 2009-05-19 16:51:43 UTC (rev 336) +++ trunk/src/uigtk2.ml 2009-05-26 09:38:19 UTC (rev 337) @@ -226,101 +226,25 @@ (****) -let wf_utf8 = - [[('\x01', '\x7F')]; - [('\xC2', '\xDF'); ('\x80', '\xBF')]; - [('\xE0', '\xE0'); ('\xA0', '\xBF'); ('\x80', '\xBF')]; - [('\xE1', '\xEC'); ('\x80', '\xBF'); ('\x80', '\xBF')]; - [('\xED', '\xED'); ('\x80', '\x9F'); ('\x80', '\xBF')]; - [('\xEE', '\xEF'); ('\x80', '\xBF'); ('\x80', '\xBF')]; - [('\xF0', '\xF0'); ('\x90', '\xBF'); ('\x80', '\xBF'); ('\x80', '\xBF')]; - [('\xF1', '\xF3'); ('\x80', '\xBF'); ('\x80', '\xBF'); ('\x80', '\xBF')]; - [('\xF4', '\xF4'); ('\x80', '\x8F'); ('\x80', '\xBF'); ('\x80', '\xBF')]] - -let rec accept_seq l s i len = - match l with - [] -> - Some i - | (a, b) :: r -> - if i = len || s.[i] < a || s.[i] > b then - None - else - accept_seq r s (i + 1) len - -let rec accept_rec l s i len = - match l with - [] -> - None - | seq :: r -> - match accept_seq seq s i len with - None -> accept_rec r s i len - | res -> res - -let accept = accept_rec wf_utf8 - -(***) - -let rec validate_rec s i len = - i = len || - match accept s i len with - Some i -> validate_rec s i len - | None -> false - -let expl f s = f s 0 (String.length s) - -let validate = expl validate_rec - -(****) - -let protect_char buf c = - if c = '\x00' then - Buffer.add_char buf ' ' - else if c < '\x80' then - Buffer.add_char buf c - else - let c = Char.code c in - Buffer.add_char buf (Char.chr (c lsr 6 + 0xC0)); - Buffer.add_char buf (Char.chr (c land 0x3f + 0x80)) - -let rec protect_rec buf s i len = - if i = len then - Buffer.contents buf - else - match accept s i len with - Some i' -> - Buffer.add_substring buf s i (i' - i); - protect_rec buf s i' len - | None -> - protect_char buf s.[i]; - protect_rec buf s (i + 1) len - -(* Convert a string to UTF8 by keeping all UTF8 characters unchanged - and considering all other characters as ISO 8859-1 characters *) -let protect s = - let buf = Buffer.create (String.length s * 2) in - expl (protect_rec buf) s - -(****) - let escapeMarkup s = Glib.Markup.escape_text s -let transcode s = +let transcodeFilename s = if Prefs.read Case.unicodeEncoding then - protect s - else + Unicode.protect s + else if Util.osType = `Win32 then transcodeDoc s else try - Glib.Convert.locale_to_utf8 s + Glib.Convert.filename_to_utf8 s with Glib.Convert.Error _ -> - protect s + Unicode.protect s -let transcodeFilename s = +let transcode s = if Prefs.read Case.unicodeEncoding then - protect s - else if Util.osType = `Win32 then transcode s else + Unicode.protect s + else try - Glib.Convert.filename_to_utf8 s + Glib.Convert.locale_to_utf8 s with Glib.Convert.Error _ -> - protect s + Unicode.protect s (********************************************************************** USEFUL LOW-LEVEL WIDGETS @@ -861,7 +785,8 @@ t#vbox#set_spacing 12; let header = - primaryText (Format.sprintf "Connecting to '%s'..." (protect rootName)) in + primaryText + (Format.sprintf "Connecting to '%s'..." (Unicode.protect rootName)) in let h1 = GPack.hbox ~border_width:6 ~spacing:12 ~packing:t#vbox#pack () in (* FIX: DIALOG_AUTHENTICATION is way better but is not available @@ -869,7 +794,8 @@ ignore (GMisc.image ~stock:(*`DIALOG_AUTHENTICATION*)`DIALOG_QUESTION ~icon_size:`DIALOG ~yalign:0. ~packing:h1#pack ()); let v1 = GPack.vbox ~spacing:12 ~packing:h1#pack () in - ignore(GMisc.label ~markup:(header ^ "\n\n" ^ escapeMarkup (protect msg)) + ignore(GMisc.label ~markup:(header ^ "\n\n" ^ + escapeMarkup (Unicode.protect msg)) ~selectable:true ~yalign:0. ~packing:v1#pack ()); let passwordE = GEdit.entry ~packing:v1#pack ~visibility:false () in @@ -1084,7 +1010,8 @@ let (profile, info) = lst#get_row_data i in result := Some profile; begin match info.roots with - [r1; r2] -> root1#set_text (protect r1); root2#set_text (protect r2); + [r1; r2] -> root1#set_text (Unicode.protect r1); + root2#set_text (Unicode.protect r2); tbl#misc#set_sensitive true | _ -> root1#set_text ""; root2#set_text ""; tbl#misc#set_sensitive false @@ -1370,13 +1297,15 @@ ~headers_clickable:false () in let s = Uicommon.roots2string () in ignore (lst#append_column - (GTree.view_column ~title:(" " ^ protect (String.sub s 0 12) ^ " ") + (GTree.view_column + ~title:(" " ^ Unicode.protect (String.sub s 0 12) ^ " ") ~renderer:(GTree.cell_renderer_text [], ["text", c_replica1]) ())); ignore (lst#append_column (GTree.view_column ~title:" Action " ~renderer:(GTree.cell_renderer_pixbuf [], ["pixbuf", c_action]) ())); ignore (lst#append_column - (GTree.view_column ~title:(" " ^ protect (String.sub s 15 12) ^ " ") + (GTree.view_column + ~title:(" " ^ Unicode.protect (String.sub s 15 12) ^ " ") ~renderer:(GTree.cell_renderer_text [], ["text", c_replica2]) ())); ignore (lst#append_column (GTree.view_column ~title:" Status " ())); @@ -1404,8 +1333,9 @@ (fun i data -> mainWindow#set_column ~title_active:false ~auto_resize:true ~title:data i) - [| " " ^ protect (String.sub s 0 12) ^ " "; " Action "; - " " ^ protect (String.sub s 15 12) ^ " "; " Status "; " Path" |] + [| " " ^ Unicode.protect (String.sub s 0 12) ^ " "; " Action "; + " " ^ Unicode.protect (String.sub s 15 12) ^ " "; " Status "; + " Path" |] in setMainWindowColumnHeaders(); @@ -2177,7 +2107,8 @@ let descl = if loc1 = loc2 then "right to left" else - Printf.sprintf "from %s to %s" (protect loc2) (protect loc1) in + Printf.sprintf "from %s to %s" + (Unicode.protect loc2) (Unicode.protect loc1) in let right = actionsMenu#add_image_item ~key:GdkKeysyms._less ~callback:leftAction ~image:((GMisc.image ~stock:`GO_BACK ~icon_size:`MENU ())#coerce) Modified: trunk/src/uitext.ml =================================================================== --- trunk/src/uitext.ml 2009-05-19 16:51:43 UTC (rev 336) +++ trunk/src/uitext.ml 2009-05-26 09:38:19 UTC (rev 337) @@ -286,9 +286,9 @@ try let pager = System.getenv "PAGER" in restoreTerminal (); - let out = Unix.open_process_out pager in + let out = System.open_process_out pager in Printf.fprintf out "\n%s\n\n%s\n\n" title text; - let _ = Unix.close_process_out out in + let _ = System.close_process_out out in setupTerminal () with Not_found -> Printf.printf "\n%s\n\n%s\n\n" title text) Modified: trunk/src/unicode.ml =================================================================== --- trunk/src/unicode.ml 2009-05-19 16:51:43 UTC (rev 336) +++ trunk/src/unicode.ml 2009-05-26 09:38:19 UTC (rev 337) @@ -865,3 +865,69 @@ end let check_utf_8 s = scan s 0 (String.length s) + +(****) + +let wf_utf8 = + [[('\x01', '\x7F')]; + [('\xC2', '\xDF'); ('\x80', '\xBF')]; + [('\xE0', '\xE0'); ('\xA0', '\xBF'); ('\x80', '\xBF')]; + [('\xE1', '\xEC'); ('\x80', '\xBF'); ('\x80', '\xBF')]; + [('\xED', '\xED'); ('\x80', '\x9F'); ('\x80', '\xBF')]; + [('\xEE', '\xEF'); ('\x80', '\xBF'); ('\x80', '\xBF')]; + [('\xF0', '\xF0'); ('\x90', '\xBF'); ('\x80', '\xBF'); ('\x80', '\xBF')]; + [('\xF1', '\xF3'); ('\x80', '\xBF'); ('\x80', '\xBF'); ('\x80', '\xBF')]; + [('\xF4', '\xF4'); ('\x80', '\x8F'); ('\x80', '\xBF'); ('\x80', '\xBF')]] + +let rec accept_seq l s i len = + match l with + [] -> + Some i + | (a, b) :: r -> + if i = len || s.[i] < a || s.[i] > b then + None + else + accept_seq r s (i + 1) len + +let rec accept_rec l s i len = + match l with + [] -> + None + | seq :: r -> + match accept_seq seq s i len with + None -> accept_rec r s i len + | res -> res + +let accept = accept_rec wf_utf8 + +(***) + +let protect_char buf c = + if c = '\x00' then + Buffer.add_char buf ' ' + else if c < '\x80' then + Buffer.add_char buf c + else + let c = Char.code c in + Buffer.add_char buf (Char.chr (c lsr 6 + 0xC0)); + Buffer.add_char buf (Char.chr (c land 0x3f + 0x80)) + +let rec protect_rec buf s i len = + if i = len then + Buffer.contents buf + else + match accept s i len with + Some i' -> + Buffer.add_substring buf s i (i' - i); + protect_rec buf s i' len + | None -> + protect_char buf s.[i]; + protect_rec buf s (i + 1) len + +let expl f s = f s 0 (String.length s) + +(* Convert a string to UTF8 by keeping all UTF8 characters unchanged + and considering all other characters as ISO 8859-1 characters *) +let protect s = + let buf = Buffer.create (String.length s * 2) in + expl (protect_rec buf) s Modified: trunk/src/unicode.mli =================================================================== --- trunk/src/unicode.mli 2009-05-19 16:51:43 UTC (rev 336) +++ trunk/src/unicode.mli 2009-05-26 09:38:19 UTC (rev 337) @@ -22,3 +22,7 @@ (* Check wether the string contains only well-formed UTF-8 characters *) val check_utf_8 : string -> bool + +(* Convert a string to UTF-8 by keeping all UTF-8 characters unchanged + and considering all other characters as ISO 8859-1 characters *) +val protect : string -> string From vouillon at seas.upenn.edu Tue May 26 05:42:44 2009 From: vouillon at seas.upenn.edu (vouillon@seas.upenn.edu) Date: Tue, 26 May 2009 05:42:44 -0400 Subject: [Unison-hackers] [unison-svn] r338 - branches/2.32/src Message-ID: <200905260942.n4Q9gidC028875@yaws.seas.upenn.edu> Author: vouillon Date: 2009-05-26 05:42:42 -0400 (Tue, 26 May 2009) New Revision: 338 Modified: branches/2.32/src/RECENTNEWS branches/2.32/src/copy.ml branches/2.32/src/fileinfo.ml branches/2.32/src/mkProjectInfo.ml branches/2.32/src/osx.ml Log: * Added some missing convertUnixErrorsToTransient Modified: branches/2.32/src/RECENTNEWS =================================================================== --- branches/2.32/src/RECENTNEWS 2009-05-26 09:38:19 UTC (rev 337) +++ branches/2.32/src/RECENTNEWS 2009-05-26 09:42:42 UTC (rev 338) @@ -1,3 +1,8 @@ +CHANGES FROM VERSION 2.32.23 + +* Added some missing convertUnixErrorsToTransient + +------------------------------- CHANGES FROM VERSION 2.32.19 * Small documentation fix suggested by mszsummer. Modified: branches/2.32/src/copy.ml =================================================================== --- branches/2.32/src/copy.ml 2009-05-26 09:38:19 UTC (rev 337) +++ branches/2.32/src/copy.ml 2009-05-26 09:42:42 UTC (rev 338) @@ -562,25 +562,23 @@ Remote.registerRootCmdWithConnection "setFileinfo" setFileinfoLocal let targetExists checkSize fspathTo pathTo = - Os.exists fspathTo pathTo + let info = Fileinfo.get false fspathTo pathTo in + info.Fileinfo.typ = `FILE && (match checkSize with `MakeWriteableAndCheckNonempty -> - let n = Fspath.concatToString fspathTo pathTo in - let perms = (Unix.stat n).Unix.st_perm in + let perms = Props.perms info.Fileinfo.desc in let perms' = perms lor 0o600 in - Unix.chmod n perms'; - let r = - Props.length (Fileinfo.get false fspathTo pathTo).Fileinfo.desc - > Uutil.Filesize.zero in - r + Util.convertUnixErrorsToTransient + "making target writable" + (fun () -> + Unix.chmod (Fspath.concatToString fspathTo pathTo) perms'); + Props.length info.Fileinfo.desc > Uutil.Filesize.zero | `CheckDataSize desc -> - Props.length (Fileinfo.get false fspathTo pathTo).Fileinfo.desc - = Props.length desc + Props.length info.Fileinfo.desc = Props.length desc | `CheckSize (desc,ress) -> - Props.length (Fileinfo.get false fspathTo pathTo).Fileinfo.desc - = Props.length desc - && Osx.ressLength (Osx.getFileInfos fspathTo pathTo `FILE).Osx.ressInfo - = Osx.ressLength ress) + Props.length info.Fileinfo.desc = Props.length desc + && Osx.ressLength info.Fileinfo.osX.Osx.ressInfo = + Osx.ressLength ress) let targetExistsLocal connFrom (checkSize, fspathTo, pathTo) = Lwt.return (targetExists checkSize fspathTo pathTo) Modified: branches/2.32/src/fileinfo.ml =================================================================== --- branches/2.32/src/fileinfo.ml 2009-05-26 09:38:19 UTC (rev 337) +++ branches/2.32/src/fileinfo.ml 2009-05-26 09:42:42 UTC (rev 338) @@ -82,7 +82,9 @@ osX = Osx.getFileInfos fspath path `ABSENT }) let check fspath path props = - Props.check fspath path (statFn false fspath path) props + Util.convertUnixErrorsToTransient + "checking file information" + (fun () -> Props.check fspath path (statFn false fspath path) props) let set fspath path action newDesc = let (kind, p) = Modified: branches/2.32/src/mkProjectInfo.ml =================================================================== --- branches/2.32/src/mkProjectInfo.ml 2009-05-26 09:38:19 UTC (rev 337) +++ branches/2.32/src/mkProjectInfo.ml 2009-05-26 09:42:42 UTC (rev 338) @@ -110,3 +110,4 @@ + Modified: branches/2.32/src/osx.ml =================================================================== --- branches/2.32/src/osx.ml 2009-05-26 09:38:19 UTC (rev 337) +++ branches/2.32/src/osx.ml 2009-05-26 09:42:42 UTC (rev 338) @@ -242,7 +242,9 @@ "") (fun () -> close_in_noerr inch) in - let stats = Unix.LargeFile.stat doublePath in + let stats = + Util.convertUnixErrorsToTransient "stating AppleDouble file" + (fun () -> Unix.LargeFile.stat doublePath) in { ressInfo = if rsrcLength = 0L then NoRess else AppleDoubleRess From vouillon at seas.upenn.edu Tue May 26 09:43:00 2009 From: vouillon at seas.upenn.edu (vouillon@seas.upenn.edu) Date: Tue, 26 May 2009 09:43:00 -0400 Subject: [Unison-hackers] [unison-svn] r339 - trunk/src Message-ID: <200905261343.n4QDh0BP005564@yaws.seas.upenn.edu> Author: vouillon Date: 2009-05-26 09:42:55 -0400 (Tue, 26 May 2009) New Revision: 339 Added: trunk/src/bytearray.ml trunk/src/bytearray.mli trunk/src/bytearray_stubs.c Modified: trunk/src/.depend trunk/src/Makefile.OCaml trunk/src/RECENTNEWS trunk/src/copy.ml trunk/src/mkProjectInfo.ml trunk/src/remote.ml trunk/src/remote.mli trunk/src/transfer.ml trunk/src/transfer.mli Log: * Got rid of the 16MiB marshalling limit by marshalling to a bigarray Modified: trunk/src/.depend =================================================================== --- trunk/src/.depend 2009-05-26 09:42:42 UTC (rev 338) +++ trunk/src/.depend 2009-05-26 13:42:55 UTC (rev 339) @@ -1,4 +1,5 @@ abort.cmi: uutil.cmi +bytearray.cmi: case.cmi: ubase/prefs.cmi checksum.cmi: clroot.cmi: @@ -23,14 +24,15 @@ pred.cmi: props.cmi: uutil.cmi ubase/prefs.cmi path.cmi osx.cmi fspath.cmi recon.cmi: path.cmi common.cmi -remote.cmi: ubase/prefs.cmi lwt/lwt.cmi fspath.cmi common.cmi clroot.cmi +remote.cmi: ubase/prefs.cmi lwt/lwt.cmi fspath.cmi common.cmi clroot.cmi \ + bytearray.cmi sortri.cmi: common.cmi stasher.cmi: ubase/prefs.cmi path.cmi os.cmi fspath.cmi strings.cmi: system.cmi: system/system_intf.cmo terminal.cmi: test.cmi: -transfer.cmi: uutil.cmi lwt/lwt.cmi +transfer.cmi: uutil.cmi lwt/lwt.cmi bytearray.cmi transport.cmi: uutil.cmi lwt/lwt.cmi common.cmi tree.cmi: uicommon.cmi: uutil.cmi ubase/prefs.cmi path.cmi lwt/lwt.cmi common.cmi @@ -47,6 +49,8 @@ abort.cmi abort.cmx: uutil.cmx ubase/util.cmx ubase/trace.cmx ubase/safelist.cmx \ abort.cmi +bytearray.cmo: bytearray.cmi +bytearray.cmx: bytearray.cmi case.cmo: ubase/util.cmi unicode.cmi ubase/prefs.cmi case.cmi case.cmx: ubase/util.cmx unicode.cmx ubase/prefs.cmx case.cmi checksum.cmo: checksum.cmi @@ -60,11 +64,13 @@ copy.cmo: xferhint.cmi uutil.cmi ubase/util.cmi transfer.cmi ubase/trace.cmi \ ubase/safelist.cmi remote.cmi props.cmi ubase/prefs.cmi path.cmi osx.cmi \ os.cmi lwt/lwt_util.cmi lwt/lwt.cmi globals.cmi fspath.cmi fs.cmi \ - fileinfo.cmi external.cmi common.cmi clroot.cmi abort.cmi copy.cmi + fileinfo.cmi external.cmi common.cmi clroot.cmi bytearray.cmi abort.cmi \ + copy.cmi copy.cmx: xferhint.cmx uutil.cmx ubase/util.cmx transfer.cmx ubase/trace.cmx \ ubase/safelist.cmx remote.cmx props.cmx ubase/prefs.cmx path.cmx osx.cmx \ os.cmx lwt/lwt_util.cmx lwt/lwt.cmx globals.cmx fspath.cmx fs.cmx \ - fileinfo.cmx external.cmx common.cmx clroot.cmx abort.cmx copy.cmi + fileinfo.cmx external.cmx common.cmx clroot.cmx bytearray.cmx abort.cmx \ + copy.cmi external.cmo: ubase/util.cmi system.cmi ubase/safelist.cmi lwt/lwt_util.cmi \ lwt/lwt_unix.cmi lwt/lwt.cmi external.cmi external.cmx: ubase/util.cmx system.cmx ubase/safelist.cmx lwt/lwt_util.cmx \ @@ -149,10 +155,10 @@ globals.cmx fileinfo.cmx common.cmx recon.cmi remote.cmo: uutil.cmi ubase/util.cmi ubase/trace.cmi terminal.cmi system.cmi \ ubase/safelist.cmi ubase/prefs.cmi os.cmi lwt/lwt_unix.cmi lwt/lwt.cmi \ - fspath.cmi fs.cmi common.cmi clroot.cmi case.cmi remote.cmi + fspath.cmi fs.cmi common.cmi clroot.cmi case.cmi bytearray.cmi remote.cmi remote.cmx: uutil.cmx ubase/util.cmx ubase/trace.cmx terminal.cmx system.cmx \ ubase/safelist.cmx ubase/prefs.cmx os.cmx lwt/lwt_unix.cmx lwt/lwt.cmx \ - fspath.cmx fs.cmx common.cmx clroot.cmx case.cmx remote.cmi + fspath.cmx fs.cmx common.cmx clroot.cmx case.cmx bytearray.cmx remote.cmi sortri.cmo: ubase/util.cmi ubase/safelist.cmi ubase/prefs.cmi pred.cmi \ path.cmi common.cmi sortri.cmi sortri.cmx: ubase/util.cmx ubase/safelist.cmx ubase/prefs.cmx pred.cmx \ @@ -184,9 +190,9 @@ lwt/lwt.cmx globals.cmx fspath.cmx fs.cmx fingerprint.cmx common.cmx \ test.cmi transfer.cmo: uutil.cmi ubase/util.cmi ubase/trace.cmi ubase/safelist.cmi \ - lwt/lwt.cmi checksum.cmi transfer.cmi + lwt/lwt.cmi checksum.cmi bytearray.cmi transfer.cmi transfer.cmx: uutil.cmx ubase/util.cmx ubase/trace.cmx ubase/safelist.cmx \ - lwt/lwt.cmx checksum.cmx transfer.cmi + lwt/lwt.cmx checksum.cmx bytearray.cmx transfer.cmi transport.cmo: uutil.cmi ubase/util.cmi update.cmi ubase/trace.cmi \ stasher.cmi remote.cmi props.cmi ubase/prefs.cmi path.cmi osx.cmi \ lwt/lwt_util.cmi lwt/lwt.cmi globals.cmi files.cmi common.cmi abort.cmi \ Modified: trunk/src/Makefile.OCaml =================================================================== --- trunk/src/Makefile.OCaml 2009-05-26 09:42:42 UTC (rev 338) +++ trunk/src/Makefile.OCaml 2009-05-26 13:42:55 UTC (rev 339) @@ -187,7 +187,7 @@ OCAMLOBJS += \ ubase/rx.cmo \ \ - unicode_tables.cmo unicode.cmo \ + unicode_tables.cmo unicode.cmo bytearray.cmo \ $(WINOBJS) system/system_generic.cmo \ system/$(SYSTEM)/system_impl.cmo \ system.cmo \ @@ -206,15 +206,15 @@ transfer.cmo xferhint.cmo remote.cmo globals.cmo copy.cmo \ stasher.cmo update.cmo \ files.cmo sortri.cmo recon.cmo transport.cmo \ - strings.cmo uicommon.cmo uitext.cmo test.cmo + strings.cmo uicommon.cmo uitext.cmo test.cmo OCAMLOBJS+=main.cmo # OCaml libraries for the bytecode version # File extensions will be substituted for the native code version -OCAMLLIBS+=unix.cma str.cma +OCAMLLIBS+=unix.cma str.cma bigarray.cma -COBJS+=osxsupport$(OBJ_EXT) pty$(OBJ_EXT) +COBJS+=osxsupport$(OBJ_EXT) pty$(OBJ_EXT) bytearray_stubs$(OBJ_EXT) ######################################################################## ### User Interface setup Modified: trunk/src/RECENTNEWS =================================================================== --- trunk/src/RECENTNEWS 2009-05-26 09:42:42 UTC (rev 338) +++ trunk/src/RECENTNEWS 2009-05-26 13:42:55 UTC (rev 339) @@ -1,5 +1,10 @@ CHANGES FROM VERSION 2.34.0 +* Got rid of the 16MiB marshalling limit by marshalling to a bigarray + +------------------------------- +CHANGES FROM VERSION 2.34.0 + * Use system dependant API for spawning processes. (Unicode API under Windows.) * Fixed the bug with ssh not working when running unison from a cygwin Added: trunk/src/bytearray.ml =================================================================== --- trunk/src/bytearray.ml (rev 0) +++ trunk/src/bytearray.ml 2009-05-26 13:42:55 UTC (rev 339) @@ -0,0 +1,94 @@ +(* Unison file synchronizer: src/bytearray.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + +open Bigarray + +type t = (char, int8_unsigned_elt, c_layout) Array1.t + +let length = Bigarray.Array1.dim + +let create l = Bigarray.Array1.create Bigarray.char Bigarray.c_layout l + +(* +let unsafe_blit_from_string s i a j l = + for k = 0 to l - 1 do + a.{j + k} <- s.[i + k] + done + +let unsafe_blit_to_string a i s j l = + for k = 0 to l - 1 do + s.[j + k] <- a.{i + k} + done +*) + +external unsafe_blit_from_string : string -> int -> t -> int -> int -> unit + = "ml_blit_string_to_bigarray" "noalloc" + +external unsafe_blit_to_string : t -> int -> string -> int -> int -> unit + = "ml_blit_bigarray_to_string" "noalloc" + +let to_string a = + let l = length a in + if l > Sys.max_string_length then invalid_arg "Bytearray.to_string" else + let s = String.create l in + unsafe_blit_to_string a 0 s 0 l; + s + +let of_string s = + let l = String.length s in + let a = create l in + unsafe_blit_from_string s 0 a 0 l; + a + +let sub a ofs len = + if + ofs < 0 || len < 0 || ofs > length a - len || len > Sys.max_string_length + then + invalid_arg "Bytearray.sub" + else begin + let s = String.create len in + unsafe_blit_to_string a ofs s 0 len; + s + end + +let rec prefix_rec a i a' i' l = + l = 0 || + (a.{i} = a'.{i'} && prefix_rec a (i + 1) a' (i' + 1) (l - 1)) + +let prefix a a' i = + let l = length a in + let l' = length a' in + i <= l' - l && + prefix_rec a 0 a' i l + +let blit_from_string s i a j l = + if l < 0 || i < 0 || i > String.length s - l + || j < 0 || j > length a - l + then invalid_arg "Bytearray.blit_from_string" + else unsafe_blit_from_string s i a j l + +let blit_to_string a i s j l = + if l < 0 || i < 0 || i > length a - l + || j < 0 || j > String.length s - l + then invalid_arg "Bytearray.blit_to_string" + else unsafe_blit_to_string a i s j l + +external marshal : 'a -> Marshal.extern_flags list -> t + = "ml_marshal_to_bigarray" + +external unmarshal : t -> int -> 'a + = "ml_unmarshal_from_bigarray" Added: trunk/src/bytearray.mli =================================================================== --- trunk/src/bytearray.mli (rev 0) +++ trunk/src/bytearray.mli 2009-05-26 13:42:55 UTC (rev 339) @@ -0,0 +1,25 @@ +(* Unison file synchronizer: src/bytearray.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +type t = + (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t + +val create : int -> t + +val length : t -> int + +val to_string : t -> string + +val of_string : string -> t + +val sub : t -> int -> int -> string + +val blit_from_string : string -> int -> t -> int -> int -> unit + +val blit_to_string : t -> int -> string -> int -> int -> unit + +val prefix : t -> t -> int -> bool + +val marshal : 'a -> Marshal.extern_flags list -> t + +val unmarshal : t -> int -> 'a Added: trunk/src/bytearray_stubs.c =================================================================== --- trunk/src/bytearray_stubs.c (rev 0) +++ trunk/src/bytearray_stubs.c 2009-05-26 13:42:55 UTC (rev 339) @@ -0,0 +1,45 @@ +/* Unison file synchronizer: src/bytearray_stubs.c */ +/* Copyright 1999-2009 (see COPYING for details) */ + +#include + +#include "caml/intext.h" +#include "caml/bigarray.h" + +CAMLprim value ml_marshal_to_bigarray(value v, value flags) +{ + char *buf; + long len; + output_value_to_malloc(v, flags, &buf, &len); + return alloc_bigarray(BIGARRAY_UINT8 | BIGARRAY_C_LAYOUT | BIGARRAY_MANAGED, + 1, buf, &len); +} + + +#define Array_data(a, i) (((char *) a->data) + Long_val(i)) + + +CAMLprim value ml_unmarshal_from_bigarray(value b, value ofs) +{ + struct caml_bigarray *b_arr = Bigarray_val(b); + return input_value_from_block (Array_data (b_arr, ofs), + b_arr->dim[0] - Long_val(ofs)); +} + +CAMLprim value ml_blit_string_to_bigarray +(value s, value i, value a, value j, value l) +{ + char *src = String_val(s) + Int_val(i); + char *dest = Array_data(Bigarray_val(a), j); + memcpy(dest, src, Long_val(l)); + return Val_unit; +} + +CAMLprim value ml_blit_bigarray_to_string +(value a, value i, value s, value j, value l) +{ + char *src = Array_data(Bigarray_val(a), i); + char *dest = String_val(s) + Long_val(j); + memcpy(dest, src, Long_val(l)); + return Val_unit; +} Modified: trunk/src/copy.ml =================================================================== --- trunk/src/copy.ml 2009-05-26 09:42:42 UTC (rev 338) +++ trunk/src/copy.ml 2009-05-26 13:42:55 UTC (rev 339) @@ -211,8 +211,8 @@ (fun (file_id, (data, pos, len)) rem -> ((Remote.encodeInt file_id, 0, 4) :: (data, pos, len) :: rem, len + 4)), (fun buf pos -> - let len = String.length buf - pos - 4 in - (Remote.decodeInt (String.sub buf pos 4), (buf, pos + 4, len))) + let len = Bytearray.length buf - pos - 4 in + (Remote.decodeInt buf pos, (buf, pos + 4, len))) let processTransferInstructionRemotely = Remote.registerSpecialServerCmd Modified: trunk/src/mkProjectInfo.ml =================================================================== --- trunk/src/mkProjectInfo.ml 2009-05-26 09:42:42 UTC (rev 338) +++ trunk/src/mkProjectInfo.ml 2009-05-26 13:42:55 UTC (rev 339) @@ -152,3 +152,4 @@ + Modified: trunk/src/remote.ml =================================================================== --- trunk/src/remote.ml 2009-05-26 09:42:42 UTC (rev 338) +++ trunk/src/remote.ml 2009-05-26 13:42:55 UTC (rev 339) @@ -33,18 +33,18 @@ (****) let encodeInt m = - let int_buf = String.create 4 in - String.set int_buf 0 (Char.chr ( m land 0xff)); - String.set int_buf 1 (Char.chr ((m lsr 8) land 0xff)); - String.set int_buf 2 (Char.chr ((m lsr 16) land 0xff)); - String.set int_buf 3 (Char.chr ((m lsr 24) land 0xff)); + let int_buf = Bytearray.create 4 in + int_buf.{0} <- Char.chr ( m land 0xff); + int_buf.{1} <- Char.chr ((m lsr 8) land 0xff); + int_buf.{2} <- Char.chr ((m lsr 16) land 0xff); + int_buf.{3} <- Char.chr ((m lsr 24) land 0xff); int_buf -let decodeInt int_buf = - let b0 = Char.code (String.get int_buf 0) in - let b1 = Char.code (String.get int_buf 1) in - let b2 = Char.code (String.get int_buf 2) in - let b3 = Char.code (String.get int_buf 3) in +let decodeInt int_buf i = + let b0 = Char.code (int_buf.{i + 0}) in + let b1 = Char.code (int_buf.{i + 1}) in + let b2 = Char.code (int_buf.{i + 2}) in + let b3 = Char.code (int_buf.{i + 3}) in ((b3 lsl 24) lor (b2 lsl 16) lor (b1 lsl 8) lor b0) (*************************************************************************) @@ -76,7 +76,7 @@ outputChannel : Unix.file_descr; outputBuffer : string; mutable outputLength : int; - outputQueue : (string * int * int) list Queue.t; + outputQueue : (Bytearray.t * int * int) list Queue.t; mutable pendingOutput : bool; mutable flowControl : bool; mutable canWrite : bool; @@ -114,7 +114,7 @@ grab_rec conn s pos len) end else begin let l = min (len - pos) conn.inputLength in - String.blit conn.inputBuffer 0 s pos l; + Bytearray.blit_from_string conn.inputBuffer 0 s pos l; conn.inputLength <- conn.inputLength - l; if conn.inputLength > 0 then String.blit conn.inputBuffer l conn.inputBuffer 0 conn.inputLength; @@ -126,7 +126,7 @@ let grab conn s len = assert (len > 0); - assert (String.length s <= len); + assert (Bytearray.length s <= len); grab_rec conn s 0 len let peek_without_blocking conn = @@ -158,7 +158,7 @@ fill_buffer_2 conn s pos len) else begin let l = min (len - pos) (outputBuffer_size - conn.outputLength) in - String.blit s pos conn.outputBuffer conn.outputLength l; + Bytearray.blit_to_string s pos conn.outputBuffer conn.outputLength l; conn.outputLength <- conn.outputLength + l; if pos + l < len then fill_buffer_2 conn s (pos + l) len @@ -171,7 +171,7 @@ (s, pos, len) :: rem -> assert (pos >= 0); assert (len >= 0); - assert (pos + len <= String.length s); + assert (pos <= Bytearray.length s - len); fill_buffer_2 conn s pos len >>= (fun () -> fill_buffer conn rem) | [] -> @@ -331,11 +331,11 @@ (* MARSHALING *) (*****************************************************************************) -type tag = string +type tag = Bytearray.t type 'a marshalFunction = - 'a -> (string * int * int) list -> (string * int * int) list -type 'a unmarshalFunction = string -> 'a + 'a -> (Bytearray.t * int * int) list -> (Bytearray.t * int * int) list +type 'a unmarshalFunction = Bytearray.t -> 'a type 'a marshalingFunctions = 'a marshalFunction * 'a unmarshalFunction let registeredSet = ref Util.StringSet.empty @@ -346,9 +346,9 @@ "" | (s, p, l) :: rem -> if l < len then - String.sub s p l ^ first_chars (len - l) rem + Bytearray.sub s p l ^ first_chars (len - l) rem else - String.sub s p len + Bytearray.sub s p len (* An integer just a little smaller than the maximum representable in 30 bits *) let hugeint = 1000000000 @@ -359,50 +359,47 @@ let start = first_chars (min length 10) rem' in let start = if length > 10 then start ^ "..." else start in let start = String.escaped start in - Util.msg "Fatal error in safeMarshal: sending too many (%d) bytes with tag %s and contents [%s]\n" length tag start; + Util.msg "Fatal error in safeMarshal: sending too many (%d) bytes with tag %s and contents [%s]\n" length (Bytearray.to_string tag) start; raise (Util.Fatal ((Printf.sprintf - "Message payload too large (%d, %s, [%s]). \n" length tag start) + "Message payload too large (%d, %s, [%s]). \n" + length (Bytearray.to_string tag) start) ^ "This is a bug in Unison; if it happens to you in a repeatable way, \n" ^ "please post a report on the unison-users mailing list.")) end; - let l = String.length tag in + let l = Bytearray.length tag in debugE (fun() -> let start = first_chars (min length 10) rem' in let start = if length > 10 then start ^ "..." else start in let start = String.escaped start in - Util.msg "send [%s] '%s' %d bytes\n" tag start length); + Util.msg "send [%s] '%s' %d bytes\n" + (Bytearray.to_string tag) start length); ((encodeInt (l + length), 0, 4) :: (tag, 0, l) :: rem') let safeUnmarshal unmarshalPayload tag buf = - let taglength = String.length tag in - let identifier = String.sub buf 0 (min taglength (String.length buf)) in - if identifier = tag then + let taglength = Bytearray.length tag in + if Bytearray.prefix tag buf 0 then unmarshalPayload buf taglength else + let identifier = + String.escaped + (Bytearray.sub buf 0 (min taglength (Bytearray.length buf))) in raise (Util.Fatal - (Printf.sprintf "[safeUnmarshal] expected %s but got %s" - tag identifier)) + (Printf.sprintf "[safeUnmarshal] expected '%s' but got '%s'" + (String.escaped (Bytearray.to_string tag)) identifier)) let registerTag string = if Util.StringSet.mem string !registeredSet then raise (Util.Fatal (Printf.sprintf "tag %s is already registered" string)) else registeredSet := Util.StringSet.add string !registeredSet; - string + Bytearray.of_string string let defaultMarshalingFunctions = (fun data rem -> - try - let s = Marshal.to_string data [Marshal.No_sharing] in - let l = String.length s in - ((s, 0, String.length s) :: rem, l) - with Out_of_memory -> - raise (Util.Fatal - "Trying to transfer too much data in one go.\n\ - If this happens during update detection, try to\n\ - synchronize smaller pieces of the replica first\n\ - using the \"path\" directive.")), - (fun buf pos -> Marshal.from_string buf pos) + let s = Bytearray.marshal data [Marshal.No_sharing] in + let l = Bytearray.length s in + ((s, 0, l) :: rem, l)), + (fun buf pos -> Bytearray.unmarshal buf pos) let makeMarshalingFunctions payloadMarshalingFunctions string = let (marshalPayload, unmarshalPayload) = payloadMarshalingFunctions in @@ -529,24 +526,24 @@ let receivePacket conn = (* Get the length of the packet *) - let int_buf = String.create 4 in + let int_buf = Bytearray.create 4 in grab conn int_buf 4 >>= (fun () -> - let length = decodeInt int_buf in + let length = decodeInt int_buf 0 in assert (length >= 0); (* Get packet *) - let buf = String.create length in + let buf = Bytearray.create length in grab conn buf length >>= (fun () -> (debugE (fun () -> let start = - if length > 10 then (String.sub buf 0 10) ^ "..." - else String.sub buf 0 length in + if length > 10 then (Bytearray.sub buf 0 10) ^ "..." + else Bytearray.sub buf 0 length in let start = String.escaped start in Util.msg "receive '%s' %d bytes\n" start length); Lwt.return buf))) type servercmd = - connection -> string -> - ((string * int * int) list -> (string * int * int) list) Lwt.t + connection -> Bytearray.t -> + ((Bytearray.t * int * int) list -> (Bytearray.t * int * int) list) Lwt.t let serverCmds = ref (Util.StringMap.empty : servercmd Util.StringMap.t) type header = @@ -565,16 +562,16 @@ in Lwt.try_bind (fun () -> cmd conn buf) (fun marshal -> - debugE (fun () -> Util.msg "Sending result (id: %d)\n" (decodeInt id)); + debugE (fun () -> Util.msg "Sending result (id: %d)\n" (decodeInt id 0)); dump conn ((id, 0, 4) :: marshalHeader NormalResult (marshal []))) (function Util.Transient s -> debugE (fun () -> - Util.msg "Sending transient exception (id: %d)\n" (decodeInt id)); + Util.msg "Sending transient exception (id: %d)\n" (decodeInt id 0)); dump conn ((id, 0, 4) :: marshalHeader (TransientExn s) []) | Util.Fatal s -> debugE (fun () -> - Util.msg "Sending fatal exception (id: %d)\n" (decodeInt id)); + Util.msg "Sending fatal exception (id: %d)\n" (decodeInt id 0)); dump conn ((id, 0, 4) :: marshalHeader (FatalExn s) []) | e -> Lwt.fail e) @@ -605,9 +602,9 @@ Lwt.return ()) >>= (fun () -> debugE (fun () -> Util.msg "Waiting for next message\n"); (* Get the message ID *) - let id = String.create 4 in + let id = Bytearray.create 4 in grab conn id 4 >>= (fun () -> - let num_id = decodeInt id in + let num_id = decodeInt id 0 in if num_id = 0 then begin debugE (fun () -> Util.msg "Received the write permission\n"); allowWrites conn; @@ -752,12 +749,14 @@ let connectionHeader = "Unison " ^ Uutil.myMajorVersion ^ "\n" -let rec checkHeader conn prefix buffer pos len = +let rec checkHeader conn buffer pos len = if pos = len then Lwt.return () else begin (grab conn buffer 1 >>= (fun () -> - if buffer.[0] <> connectionHeader.[pos] then + if buffer.{0} <> connectionHeader.[pos] then + let prefix = + String.sub connectionHeader 0 pos ^ Bytearray.to_string buffer in let rest = peek_without_blocking conn in Lwt.fail (Util.Fatal @@ -765,15 +764,15 @@ expected \"" ^ String.escaped (* (String.sub connectionHeader 0 (pos + 1)) *) connectionHeader - ^ "\" but received \"" ^ String.escaped (prefix ^ buffer ^ rest) ^ "\", \n" - ^ "which differs at \"" ^ String.escaped (prefix ^ buffer) ^ "\".\n" + ^ "\" but received \"" ^ String.escaped (prefix ^ rest) ^ "\", \n" + ^ "which differs at \"" ^ String.escaped prefix ^ "\".\n" ^ "This can happen because you have different versions of Unison\n" ^ "installed on the client and server machines, or because\n" ^ "your connection is failing and somebody is printing an error\n" ^ "message, or because your remote login shell is printing\n" ^ "something itself before starting Unison.")) else - checkHeader conn (prefix ^ buffer) buffer (pos + 1) len)) + checkHeader conn buffer (pos + 1) len)) end (****) @@ -808,7 +807,8 @@ ignore(Sys.set_signal Sys.sigpipe Sys.Signal_ignore); let conn = setupIO in_ch out_ch in conn.canWrite <- false; - checkHeader conn "" " " 0 (String.length connectionHeader) >>= (fun () -> + checkHeader + conn (Bytearray.create 1) 0 (String.length connectionHeader) >>= (fun () -> Lwt.ignore_result (receive conn); negociateFlowControl conn >>= (fun () -> Lwt.return conn)) @@ -1144,7 +1144,8 @@ let conn = setupIO in_ch out_ch in try Lwt_unix.run - (dump conn [(connectionHeader, 0, String.length connectionHeader)] + (dump conn [(Bytearray.of_string connectionHeader, 0, + String.length connectionHeader)] >>= (fun () -> (* Set the local warning printer to make an RPC to the client and show the warning there; ditto for the message printer *) Modified: trunk/src/remote.mli =================================================================== --- trunk/src/remote.mli 2009-05-26 09:42:42 UTC (rev 338) +++ trunk/src/remote.mli 2009-05-26 13:42:55 UTC (rev 339) @@ -83,16 +83,19 @@ string -> (connection -> 'a -> 'b Lwt.t) -> connection -> 'a -> 'b Lwt.t val registerSpecialServerCmd : string -> - ('a -> (string * int * int) list -> (string * int * int) list * int) * - (string -> int -> 'a) -> - ('b -> (string * int * int) list -> (string * int * int) list * int) * - (string -> int -> 'b) -> + ('a -> + (Bytearray.t * int * int) list -> (Bytearray.t * int * int) list * int) * + (Bytearray.t -> int -> 'a) -> + ('b -> + (Bytearray.t * int * int) list -> (Bytearray.t * int * int) list * int) * + (Bytearray.t -> int -> 'b) -> (connection -> 'a -> 'b Lwt.t) -> connection -> 'a -> 'b Lwt.t val defaultMarshalingFunctions : - ('a -> (string * int * int) list -> (string * int * int) list * int) * - (string -> int -> 'b) -val encodeInt : int -> string -val decodeInt : string -> int + ('a -> + (Bytearray.t * int * int) list -> (Bytearray.t * int * int) list * int) * + (Bytearray.t -> int -> 'b) +val encodeInt : int -> Bytearray.t +val decodeInt : Bytearray.t -> int -> int val registerRootCmdWithConnection : string (* command name *) -> (connection -> 'a -> 'b Lwt.t) (* local command *) Modified: trunk/src/transfer.ml =================================================================== --- trunk/src/transfer.ml 2009-05-26 09:42:42 UTC (rev 338) +++ trunk/src/transfer.ml 2009-05-26 13:42:55 UTC (rev 339) @@ -56,7 +56,7 @@ open Lwt -type transfer_instruction = string * int * int +type transfer_instruction = Bytearray.t * int * int type transmitter = transfer_instruction -> unit Lwt.t @@ -100,7 +100,7 @@ let maxQueueSize = 65500 let maxQueueSizeFS = Uutil.Filesize.ofInt maxQueueSize type tokenQueue = - { mutable data : string; (* the queued tokens *) + { mutable data : Bytearray.t; (* the queued tokens *) mutable previous : [`Str of int | `Block of int | `None]; (* some informations about the previous token *) @@ -117,29 +117,29 @@ let encodeInt3 s pos i = assert (i >= 0 && i < 256 * 256 * 256); - s.[pos + 0] <- Char.chr ((i lsr 0) land 0xff); - s.[pos + 1] <- Char.chr ((i lsr 8) land 0xff); - s.[pos + 2] <- Char.chr ((i lsr 16) land 0xff) + s.{pos + 0} <- Char.chr ((i lsr 0) land 0xff); + s.{pos + 1} <- Char.chr ((i lsr 8) land 0xff); + s.{pos + 2} <- Char.chr ((i lsr 16) land 0xff) let decodeInt3 s pos = - (Char.code s.[pos + 0] lsl 0) lor - (Char.code s.[pos + 1] lsl 8) lor - (Char.code s.[pos + 2] lsl 16) + (Char.code s.{pos + 0} lsl 0) lor + (Char.code s.{pos + 1} lsl 8) lor + (Char.code s.{pos + 2} lsl 16) let encodeInt2 s pos i = assert (i >= 0 && i < 65536); - s.[pos + 0] <- Char.chr ((i lsr 0) land 0xff); - s.[pos + 1] <- Char.chr ((i lsr 8) land 0xff) + s.{pos + 0} <- Char.chr ((i lsr 0) land 0xff); + s.{pos + 1} <- Char.chr ((i lsr 8) land 0xff) let decodeInt2 s pos = - (Char.code s.[pos + 0] lsl 0) lor (Char.code s.[pos + 1] lsl 8) + (Char.code s.{pos + 0} lsl 0) lor (Char.code s.{pos + 1} lsl 8) let encodeInt1 s pos i = assert (i >= 0 && i < 256); - s.[pos + 0] <- Char.chr i + s.{pos + 0} <- Char.chr i let decodeInt1 s pos = - Char.code s.[pos + 0] + Char.code s.{pos + 0} (* Transmit the contents of the tokenQueue *) let flushQueue q showProgress transmit cond = @@ -154,34 +154,34 @@ let pushEOF q showProgress transmit = flushQueue q showProgress transmit - (q.pos + 1 > String.length q.data) >>= (fun () -> - q.data.[q.pos] <- 'E'; + (q.pos + 1 > Bytearray.length q.data) >>= (fun () -> + q.data.{q.pos} <- 'E'; q.pos <- q.pos + 1; q.previous <- `None; return ()) let pushString q id transmit s pos len = - flushQueue q id transmit (q.pos + len + 3 > String.length q.data) + flushQueue q id transmit (q.pos + len + 3 > Bytearray.length q.data) >>= (fun () -> - if q.pos + 3 + len > String.length q.data then begin + if q.pos + 3 + len > Bytearray.length q.data then begin (* The file is longer than expected, so the string does not fit in the buffer *) assert (q.pos = 0); - q.data <- String.create maxQueueSize + q.data <- Bytearray.create maxQueueSize end; - q.data.[q.pos] <- 'S'; + q.data.{q.pos} <- 'S'; encodeInt2 q.data (q.pos + 1) len; - assert (q.pos + 3 + len <= String.length q.data); - String.blit s pos q.data (q.pos + 3) len; + assert (q.pos + 3 + len <= Bytearray.length q.data); + Bytearray.blit_from_string s pos q.data (q.pos + 3) len; q.pos <- q.pos + len + 3; q.prog <- q.prog + len; q.previous <- `Str len; return ()) let rec growString q id transmit len' s pos len = - let l = min (String.length q.data - q.pos) len in - String.blit s pos q.data q.pos l; - assert (q.data.[q.pos - len' - 3] = 'S'); + let l = min (Bytearray.length q.data - q.pos) len in + Bytearray.blit_from_string s pos q.data q.pos l; + assert (q.data.{q.pos - len' - 3} = 'S'); assert (decodeInt2 q.data (q.pos - len' - 2) = len'); let len'' = len' + l in encodeInt2 q.data (q.pos - len' - 2) len''; @@ -194,8 +194,8 @@ return () let pushBlock q id transmit pos = - flushQueue q id transmit (q.pos + 5 > String.length q.data) >>= (fun () -> - q.data.[q.pos] <- 'B'; + flushQueue q id transmit (q.pos + 5 > Bytearray.length q.data) >>= (fun () -> + q.data.{q.pos} <- 'B'; encodeInt3 q.data (q.pos + 1) pos; encodeInt1 q.data (q.pos + 4) 1; q.pos <- q.pos + 5; @@ -205,7 +205,7 @@ let growBlock q id transmit pos = let count = decodeInt1 q.data (q.pos - 1) in - assert (q.data.[q.pos - 5] = 'B'); + assert (q.data.{q.pos - 5} = 'B'); assert (decodeInt3 q.data (q.pos - 4) + count = pos); assert (count < 255); encodeInt1 q.data (q.pos - 1) (count + 1); @@ -234,7 +234,7 @@ (* We need to make sure here that the size of the queue is not larger than 65538 (1 byte: header, 2 bytes: string size, 65535 bytes: string) *) - String.create + Bytearray.create (if length > maxQueueSizeFS then maxQueueSize else Uutil.Filesize.toInt length + 10); pos = 0; previous = `None; prog = 0 } @@ -272,12 +272,12 @@ let rec receiveRec outfd showProgress data pos maxPos = if pos = maxPos then false else - match data.[pos] with + match data.{pos} with 'S' -> let length = decodeInt2 data (pos + 1) in if Trace.enabled "generic" then debug (fun() -> Util.msg "receiving %d bytes\n" length); - reallyWrite outfd data (pos + 3) length; + reallyWrite outfd (Bytearray.sub data (pos + 3) length) 0 length; showProgress length; receiveRec outfd showProgress data (pos + length + 3) maxPos | 'E' -> @@ -403,13 +403,13 @@ let maxPos = pos + len in let rec decode pos = if pos = maxPos then false else - match data.[pos] with + match data.{pos} with 'S' -> let length = decodeInt2 data (pos + 1) in if Trace.enabled "rsynctoken" then debugToken (fun() -> Util.msg "decompressing string (%d bytes)\n" length); - reallyWrite outfd data (pos + 3) length; + reallyWrite outfd (Bytearray.sub data (pos + 3) length) 0 length; progress := !progress + length; decode (pos + length + 3) | 'B' -> Modified: trunk/src/transfer.mli =================================================================== --- trunk/src/transfer.mli 2009-05-26 09:42:42 UTC (rev 338) +++ trunk/src/transfer.mli 2009-05-26 13:42:55 UTC (rev 339) @@ -37,7 +37,7 @@ (* Transfer instruction giving data to build a file incrementally *) -type transfer_instruction = string * int * int +type transfer_instruction = Bytearray.t * int * int type transmitter = transfer_instruction -> unit Lwt.t From vouillon at seas.upenn.edu Wed May 27 08:15:20 2009 From: vouillon at seas.upenn.edu (vouillon@seas.upenn.edu) Date: Wed, 27 May 2009 08:15:20 -0400 Subject: [Unison-hackers] [unison-svn] r340 - trunk/src Message-ID: <200905271215.n4RCFKJi002882@yaws.seas.upenn.edu> Author: vouillon Date: 2009-05-27 08:15:17 -0400 (Wed, 27 May 2009) New Revision: 340 Modified: trunk/src/RECENTNEWS trunk/src/mkProjectInfo.ml trunk/src/uitext.ml trunk/src/update.ml trunk/src/uutil.ml trunk/src/uutil.mli Log: * 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: trunk/src/RECENTNEWS =================================================================== --- trunk/src/RECENTNEWS 2009-05-26 13:42:55 UTC (rev 339) +++ trunk/src/RECENTNEWS 2009-05-27 12:15:17 UTC (rev 340) @@ -1,5 +1,15 @@ CHANGES FROM VERSION 2.34.0 +* 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.34.0 + * Got rid of the 16MiB marshalling limit by marshalling to a bigarray ------------------------------- Modified: trunk/src/mkProjectInfo.ml =================================================================== --- trunk/src/mkProjectInfo.ml 2009-05-26 13:42:55 UTC (rev 339) +++ trunk/src/mkProjectInfo.ml 2009-05-27 12:15:17 UTC (rev 340) @@ -153,3 +153,4 @@ + Modified: trunk/src/uitext.ml =================================================================== --- trunk/src/uitext.ml 2009-05-26 13:42:55 UTC (rev 339) +++ trunk/src/uitext.ml 2009-05-27 12:15:17 UTC (rev 340) @@ -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: trunk/src/update.ml =================================================================== --- trunk/src/update.ml 2009-05-26 13:42:55 UTC (rev 339) +++ trunk/src/update.ml 2009-05-27 12:15:17 UTC (rev 340) @@ -1043,7 +1043,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 @@ -1436,7 +1437,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 @@ -1572,8 +1573,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; Modified: trunk/src/uutil.ml =================================================================== --- trunk/src/uutil.ml 2009-05-26 13:42:55 UTC (rev 339) +++ trunk/src/uutil.ml 2009-05-27 12:15:17 UTC (rev 340) @@ -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: trunk/src/uutil.mli =================================================================== --- trunk/src/uutil.mli 2009-05-26 13:42:55 UTC (rev 339) +++ trunk/src/uutil.mli 2009-05-27 12:15:17 UTC (rev 340) @@ -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 *) From vouillon at seas.upenn.edu Wed May 27 12:57:59 2009 From: vouillon at seas.upenn.edu (vouillon@seas.upenn.edu) Date: Wed, 27 May 2009 12:57:59 -0400 Subject: [Unison-hackers] [unison-svn] r341 - in trunk/src: . system Message-ID: <200905271657.n4RGvxTb013695@yaws.seas.upenn.edu> Author: vouillon Date: 2009-05-27 12:57:57 -0400 (Wed, 27 May 2009) New Revision: 341 Modified: trunk/src/RECENTNEWS trunk/src/mkProjectInfo.ml trunk/src/system/system_win.ml trunk/src/system/system_win_stubs.c Log: * Windows Unicode API: when a file cannot be renamed due to a sharing violation error or an access denied error, retry for up to 1 second, in case the file is temporarily opened by an indexer or an anti-virus. Modified: trunk/src/RECENTNEWS =================================================================== --- trunk/src/RECENTNEWS 2009-05-27 12:15:17 UTC (rev 340) +++ trunk/src/RECENTNEWS 2009-05-27 16:57:57 UTC (rev 341) @@ -1,5 +1,12 @@ CHANGES FROM VERSION 2.34.0 +* Windows Unicode API: when a file cannot be renamed due to a sharing + violation error or an access denied error, retry for up to 1 second, + in case the file is temporarily opened by an indexer or an anti-virus. + +------------------------------- +CHANGES FROM VERSION 2.34.0 + * 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. Modified: trunk/src/mkProjectInfo.ml =================================================================== --- trunk/src/mkProjectInfo.ml 2009-05-27 12:15:17 UTC (rev 340) +++ trunk/src/mkProjectInfo.ml 2009-05-27 16:57:57 UTC (rev 341) @@ -154,3 +154,4 @@ + Modified: trunk/src/system/system_win.ml =================================================================== --- trunk/src/system/system_win.ml 2009-05-27 12:15:17 UTC (rev 340) +++ trunk/src/system/system_win.ml 2009-05-27 16:57:57 UTC (rev 341) @@ -21,12 +21,6 @@ - Unix.select in lwt_unix (after some testing...) - fix to daylight saving changes -Try to rename several time if access denied the first time - -Remove 16Mib limit by using a temp file (or bigarray) -http://caml.inria.fr/pub/ml-archives/caml-list/2004/06/2176c54608c3c39e2dbbd9365c2fc6bb.en.html -http://caml.inria.fr/pub/ml-archives/caml-list/2007/01/04ef3c364e41f5f60f70192609d87035.en.html - - Use SetConsoleOutputCP/SetConsoleCP in text mode ??? http://www.codeproject.com/KB/cpp/unicode_console_output.aspx?display=Print Modified: trunk/src/system/system_win_stubs.c =================================================================== --- trunk/src/system/system_win_stubs.c 2009-05-27 12:15:17 UTC (rev 340) +++ trunk/src/system/system_win_stubs.c 2009-05-27 16:57:57 UTC (rev 341) @@ -101,10 +101,21 @@ CAMLprim value win_rename(value path1, value wpath1, value wpath2) { + int err, t; CAMLparam3(path1, wpath1, wpath2); + + t = 10; + retry: if (!MoveFileExW((LPWSTR)String_val(wpath1), (LPWSTR)String_val(wpath2), MOVEFILE_REPLACE_EXISTING)) { - win32_maperr (GetLastError ()); + err = GetLastError (); + if ((err == ERROR_SHARING_VIOLATION || err == ERROR_ACCESS_DENIED) && + t < 1000) { + Sleep (t); + t *= 2; + goto retry; + } + win32_maperr (err); uerror("rename", path1); } CAMLreturn (Val_unit); From Jerome.Vouillon at pps.jussieu.fr Wed May 27 15:44:09 2009 From: Jerome.Vouillon at pps.jussieu.fr (Jerome Vouillon) Date: Wed, 27 May 2009 21:44:09 +0200 Subject: [Unison-hackers] 'Some error in create_session child' In-Reply-To: References: Message-ID: <20090527194409.GA16430@pps.jussieu.fr> Hello, On Thu, Feb 19, 2009 at 02:49:42PM +0000, Ben Willmore wrote: > Can anyone expand on what the error 'Some error in create_session > child' is likely to mean? If you can still reproduce this bug, can you run unison using dtruss and send me the result: dtruss -f unison -- Jerome From vouillon at seas.upenn.edu Thu May 28 05:22:00 2009 From: vouillon at seas.upenn.edu (vouillon@seas.upenn.edu) Date: Thu, 28 May 2009 05:22:00 -0400 Subject: [Unison-hackers] [unison-svn] r342 - in trunk/src: . lwt system Message-ID: <200905280922.n4S9M0k9019881@yaws.seas.upenn.edu> Author: vouillon Date: 2009-05-28 05:21:56 -0400 (Thu, 28 May 2009) New Revision: 342 Modified: trunk/src/RECENTNEWS trunk/src/lwt/lwt_unix.ml trunk/src/mkProjectInfo.ml trunk/src/system/system_win.ml trunk/src/uicommon.ml Log: * Fixed quotation of paths and names when writing to a preference file * Workaround for bug in new "select" implementation in Ocaml 3.11 (select fails with EPIPE error when monitoring a remotely closed file descriptor) Modified: trunk/src/RECENTNEWS =================================================================== --- trunk/src/RECENTNEWS 2009-05-27 16:57:57 UTC (rev 341) +++ trunk/src/RECENTNEWS 2009-05-28 09:21:56 UTC (rev 342) @@ -1,5 +1,13 @@ CHANGES FROM VERSION 2.34.0 +* Fixed quotation of paths and names when writing to a preference file +* Workaround for bug in new "select" implementation in Ocaml 3.11 + (select fails with EPIPE error when monitoring a remotely closed + file descriptor) + +------------------------------- +CHANGES FROM VERSION 2.34.0 + * Windows Unicode API: when a file cannot be renamed due to a sharing violation error or an access denied error, retry for up to 1 second, in case the file is temporarily opened by an indexer or an anti-virus. Modified: trunk/src/lwt/lwt_unix.ml =================================================================== --- trunk/src/lwt/lwt_unix.ml 2009-05-27 16:57:57 UTC (rev 341) +++ trunk/src/lwt/lwt_unix.ml 2009-05-28 09:21:56 UTC (rev 342) @@ -132,6 +132,11 @@ ([], [], []) | Unix.Unix_error (Unix.EBADF, _, _) -> (List.filter bad_fd infds, List.filter bad_fd outfds, []) + | Unix.Unix_error (Unix.EPIPE, _, _) + when windows_hack && recent_ocaml -> + (* Workaround for a bug in Ocaml 3.11: select fails with an + EPIPE error when the file descriptor is remotely closed *) + (infds, [], []) in restart_threads !event_counter now; List.iter Modified: trunk/src/mkProjectInfo.ml =================================================================== --- trunk/src/mkProjectInfo.ml 2009-05-27 16:57:57 UTC (rev 341) +++ trunk/src/mkProjectInfo.ml 2009-05-28 09:21:56 UTC (rev 342) @@ -155,3 +155,4 @@ + Modified: trunk/src/system/system_win.ml =================================================================== --- trunk/src/system/system_win.ml 2009-05-27 16:57:57 UTC (rev 341) +++ trunk/src/system/system_win.ml 2009-05-28 09:21:56 UTC (rev 342) @@ -20,6 +20,7 @@ Backport to stable: - Unix.select in lwt_unix (after some testing...) - fix to daylight saving changes +- Proper quoting of path and names - Use SetConsoleOutputCP/SetConsoleCP in text mode ??? http://www.codeproject.com/KB/cpp/unicode_console_output.aspx?display=Print Modified: trunk/src/uicommon.ml =================================================================== --- trunk/src/uicommon.ml 2009-05-27 16:57:57 UTC (rev 341) +++ trunk/src/uicommon.ml 2009-05-28 09:21:56 UTC (rev 342) @@ -360,7 +360,7 @@ let pos = ref 0 in for i = 0 to len - 1 do match s.[i] with - '*' | '?' | '[' | '{' as c -> + '*' | '?' | '[' | '{' | '}' | ',' | '\\' as c -> buf.[!pos] <- '\\'; buf.[!pos + 1] <- c; pos := !pos + 2 | c -> buf.[!pos] <- c; pos := !pos + 1 From vouillon at seas.upenn.edu Thu May 28 05:23:35 2009 From: vouillon at seas.upenn.edu (vouillon@seas.upenn.edu) Date: Thu, 28 May 2009 05:23:35 -0400 Subject: [Unison-hackers] [unison-svn] r343 - in branches/2.32/src: . lwt Message-ID: <200905280923.n4S9NZG6019945@yaws.seas.upenn.edu> Author: vouillon Date: 2009-05-28 05:23:33 -0400 (Thu, 28 May 2009) New Revision: 343 Modified: branches/2.32/src/RECENTNEWS branches/2.32/src/lwt/lwt_unix.ml branches/2.32/src/mkProjectInfo.ml branches/2.32/src/uicommon.ml Log: * Fixed quotation of paths and names when writing to a preference file * Workaround for bug in new "select" implementation in Ocaml 3.11 (select fails with EPIPE error when monitoring a remotely closed file descriptor) Modified: branches/2.32/src/RECENTNEWS =================================================================== --- branches/2.32/src/RECENTNEWS 2009-05-28 09:21:56 UTC (rev 342) +++ branches/2.32/src/RECENTNEWS 2009-05-28 09:23:33 UTC (rev 343) @@ -1,3 +1,11 @@ +CHANGES FROM VERSION 2.32.25 + +* Fixed quotation of paths and names when writing to a preference file +* Workaround for bug in new "select" implementation in Ocaml 3.11 + (select fails with EPIPE error when monitoring a remotely closed + file descriptor) + +------------------------------- CHANGES FROM VERSION 2.32.23 * Added some missing convertUnixErrorsToTransient Modified: branches/2.32/src/lwt/lwt_unix.ml =================================================================== --- branches/2.32/src/lwt/lwt_unix.ml 2009-05-28 09:21:56 UTC (rev 342) +++ branches/2.32/src/lwt/lwt_unix.ml 2009-05-28 09:23:33 UTC (rev 343) @@ -132,6 +132,11 @@ ([], [], []) | Unix.Unix_error (Unix.EBADF, _, _) -> (List.filter bad_fd infds, List.filter bad_fd outfds, []) + | Unix.Unix_error (Unix.EPIPE, _, _) + when windows_hack && recent_ocaml -> + (* Workaround for a bug in Ocaml 3.11: select fails with an + EPIPE error when the file descriptor is remotely closed *) + (infds, [], []) in restart_threads !event_counter now; List.iter Modified: branches/2.32/src/mkProjectInfo.ml =================================================================== --- branches/2.32/src/mkProjectInfo.ml 2009-05-28 09:21:56 UTC (rev 342) +++ branches/2.32/src/mkProjectInfo.ml 2009-05-28 09:23:33 UTC (rev 343) @@ -111,3 +111,4 @@ + Modified: branches/2.32/src/uicommon.ml =================================================================== --- branches/2.32/src/uicommon.ml 2009-05-28 09:21:56 UTC (rev 342) +++ branches/2.32/src/uicommon.ml 2009-05-28 09:23:33 UTC (rev 343) @@ -360,7 +360,7 @@ let pos = ref 0 in for i = 0 to len - 1 do match s.[i] with - '*' | '?' | '[' | '{' as c -> + '*' | '?' | '[' | '{' | '}' | ',' | '\\' as c -> buf.[!pos] <- '\\'; buf.[!pos + 1] <- c; pos := !pos + 2 | c -> buf.[!pos] <- c; pos := !pos + 1 From vouillon at seas.upenn.edu Fri May 29 08:05:30 2009 From: vouillon at seas.upenn.edu (vouillon@seas.upenn.edu) Date: Fri, 29 May 2009 08:05:30 -0400 Subject: [Unison-hackers] [unison-svn] r344 - in trunk/src: . system Message-ID: <200905291205.n4TC5UVF016113@yaws.seas.upenn.edu> Author: vouillon Date: 2009-05-29 08:05:25 -0400 (Fri, 29 May 2009) New Revision: 344 Modified: trunk/src/RECENTNEWS trunk/src/TODO.txt trunk/src/case.ml trunk/src/case.mli trunk/src/mkProjectInfo.ml trunk/src/remote.ml trunk/src/system/system_win.ml trunk/src/system/system_win_stubs.c trunk/src/uigtk2.ml trunk/src/update.ml Log: * Case sensitivity information put in the archive (in a backward compatible way) and checked when the archive is loaded Modified: trunk/src/RECENTNEWS =================================================================== --- trunk/src/RECENTNEWS 2009-05-28 09:23:33 UTC (rev 343) +++ trunk/src/RECENTNEWS 2009-05-29 12:05:25 UTC (rev 344) @@ -1,5 +1,11 @@ CHANGES FROM VERSION 2.34.0 +* Case sensitivity information put in the archive (in a backward + compatible way) and checked when the archive is loaded + +------------------------------- +CHANGES FROM VERSION 2.34.0 + * Fixed quotation of paths and names when writing to a preference file * Workaround for bug in new "select" implementation in Ocaml 3.11 (select fails with EPIPE error when monitoring a remotely closed Modified: trunk/src/TODO.txt =================================================================== --- trunk/src/TODO.txt 2009-05-28 09:23:33 UTC (rev 343) +++ trunk/src/TODO.txt 2009-05-29 12:05:25 UTC (rev 344) @@ -85,9 +85,6 @@ - diagnosis: the merge stuff is not correctly updating the archive in the event of a partial reconciliation -**** When deleting a directory, we should *not* skip over Unison temp files - in the process of listing children - *** Un-writeable directories can't be copied. The 'rename' operation at the end of Files.copy will fail (at least on OSX) if the path being renamed points to a directory and that directory @@ -203,10 +200,6 @@ ~/bin/, especially considering that ~/bin is the wrong place to do the install under OSX (it should be ~/Apps or ~/Apps/bin) -** document the dynamically linked version, as some user already reported - that it works fine. Also, try to make the statistics window work with - this version. [This is "under windows," I think.] - should strip symbols from binary files in 'make exportnative' @@ -250,12 +243,6 @@ * SMALL FUNCTIONALITY IMPROVEMENTS * ================================ -**** When I tell unison to ignore a file whose name has a comma in it, - then unison adds to the preferences file a line like: - ignore = Path{this file, has a comma} - which gets interpreted as "this file" OR " has a comma". - unison should be escaping that comma and write it as \, instead. - **** Please let me say root = ~/bla instead of requiring me to give an absolute path to my home dir. @@ -264,10 +251,6 @@ (This is important for correctness -- if the case-insensitive flag is set differently on different runs, things can get very confused!) -**** Use LargeFile (submodule of Unix) instead of standard file commands, - to avoid problems with huge files - DONE - *** [Marcus Sundman, 2008] Unison can't propagate changes in read-only folders. The correct way to do it is to temporarily add write permissions for the user to the folder, then do the changes and then @@ -298,9 +281,6 @@ - otherwise, put them in a central place if one is given - Update.incrVersionsOfBackups should not be externally visible -*** there's an HFS+ aware version of rsync called rsyncx. It should be - relatively easy to import that functionality into unison. - *** Consider altering the socket method, so the server accepts connections only on a particular address? This would be very useful, because many people tunnel unison over an OpenVPN Link, and this software works with virtual @@ -312,10 +292,6 @@ ===> Probably *all* output should go to stdout, not stderr (but maybe we need a switch to recover the current behavior) -*** for the MSVC version of unison, we should deal with the nonstandard - semantics regarding read-only files. - ===> What does that mean?? - *** If a root resides on a `host' with an ever and unpredictably changing host name (like a public login cluster with dozens of machines and a shared file system), listing each possible host name for this root is @@ -339,9 +315,6 @@ offer to delete them *for* the user, rather than forcing the user to delete them manually. -*** improve error reporting when Unison is started with different versions of - client and server - *** A switch to delete files before replication. It's not something I would have considered doing, and in normal replication, there have already been pointed out good reasons why Unison works the way it @@ -381,15 +354,6 @@ ** we should reload the current preference file (if it's changed, at least) when we restart -** [A good idea for the ssh prompt issue...] I'm not sure why you would - need a C implementation; you could do the same thing in CAML that expect - does: allocate a PTY, start up ssh on that, and interact with it. On - Windows, you can probably do the same with the Win32 console API, - although I don't see why such an improvement needs to work uniformly - across all platforms to be useful. [Note that allocating PTYs is not - very portable, but we could at least try allocating one and see if - something useful comes back...] - ** An idea for the interface to the external merge functionality: created a general mechanism for invoking external functionality... - in profile, declare a command of the form @@ -481,16 +445,6 @@ mechanism for getting the list of files from another program (plugin)? ===> needs to be documented (look at rx.ml) -** seems not to recognise ignores when they are inside a path that has - just been added. -===> Jamey claims that if we add a new directory, some of whose children - are ignored, then when this new dir is propagated, also the ignored - stuff gets copied (if this is true, then it's probably a bug in - update.ml) - -* When loading archives (not just when dumping them), one should check that - they have the same checksum. - * [July 2002, S. Garfinkel] Maybe we should turn the 'time' option on by default. We might need to help people a little on the upgrading, though. When you did a sync with time=false, then a sync with @@ -544,9 +498,6 @@ messages in the text ui. See Dale Worley's message for a detailed proposal. -Make sure that no filesystem check is missing in the transport agent. - ===> What does this mean? - Would be nice to have the Unison log file relative to my home directory, like this logfile = ~/.unision/log @@ -578,10 +529,6 @@ obvious... It should be -limitbysize xxx, where xxx is the size (preferably in kb, but bytes will do as well). -Maybe we should use getcwd for canonizing roots under Unix. For some - systems (Linux, for instance), getcwd succeeds even when some parent - directory is not readable. - [From Yan Seiner] Can unison modify the (*nix) environment to show the ip/name/some_other_id of the system making the connection? This would @@ -706,18 +653,9 @@ Execute rm core If core Execute make clean If Makefile -We should put in a preference that forces Unison to do really safe update - detection (with fingerprinting), even on Unix systems. (Maybe just for - some paths?) - Maybe we should never emit a conflict for modtimes; instead, we just propagate the largest one. -[John Langford] Some code for (at least partially) handling large files - can be found in 64bit_ops.c in: - http://www-2.cs.cmu.edu/~jcl/programs/sync_file.tar.gz - Make sure you pay attention to the compile line as it is important. - [Ivo Welch] I would do a quick test of case sensitivity in the program itself at the time you do a first prf sync, so that the user does not have to bother with it. Just write two files on each end which differ in case, @@ -865,35 +803,6 @@ ("Select an existing profile..."). I think the help topics should be available here. -* [Jamey Leifer] The file list is confusing since the paths - are sometime relative to the root and sometimes relative to the - previous path: - Mail/drafts/3 - inbox/5538 - 5539 - 5540 - I now understand that the indentation is significant, but it's not - that clear. A further confusion is that there's varying amounts of - indentation depending on the depth of the enclosing path: - foo/1 - 2 - boo/goo/loo/1 - 3 - 4 - This is really hard to parse since the fonts are variable width. - I would prefer to read the former as: - Mail/drafts/3 - inbox/5538 - 5539 - 5540 - (with the indentation actually showing the relationship) though this - may take too much horizontal space. Alternatively, one could choose a - Windows-style display: - |-Mail/drafts/3 - |-inbox/5538 - |- 5539 - |- 5540 - Unison's gui offers an `Actions' menu with a variety of features regarding preferences. I would love to see an action with the following semantics: if the two files differ only in their modification time, @@ -931,8 +840,6 @@ really want this, probably the best is to put in some preferences for the user to control the colors of all the arrows individually. -Under Windows, convert filename to Unicode before printing them. - Text mode user interface should be brought up to date with graphical interface (it should prompt for profile selection, creation, root entry, etc.; command characters should be the same; ...) @@ -1099,12 +1006,6 @@ -- PS: see http://www.simplythebest.net/shellenh.html for some examples. -when typing ctrl-c in windows (dos-window in win98SE) when - unison is asking for conflicting updates there araises following - message (sorry for my bad translation to english): - "This program is closes because of a non-valid action. Contact the - manufactura if the error remains". - NTFS seems to have two ways of setting a file read-only! Comments from Karl Moerder: Tonight I made some files read-only on my desktop at home. I did this by Modified: trunk/src/case.ml =================================================================== --- trunk/src/case.ml 2009-05-28 09:23:33 UTC (rev 343) +++ trunk/src/case.ml 2009-05-29 12:05:25 UTC (rev 344) @@ -132,6 +132,7 @@ let sensitiveOps = object method mode = Sensitive + method modeDesc = "case sensitive" method compare s s' = compare s s' method hash s = Hashtbl.hash s method normalizePattern s = s @@ -142,6 +143,7 @@ let insensitiveOps = object method mode = Insensitive + method modeDesc = "Latin-1 case insensitive" method compare s s' = Util.nocase_cmp s s' method hash s = Hashtbl.hash (String.lowercase s) method normalizePattern s = s @@ -152,6 +154,7 @@ let unicodeInsensitiveOps = object method mode = UnicodeInsensitive + method modeDesc = "Unicode case insensitive" method compare s s' = Unicode.compare s s' method hash s = Hashtbl.hash (Unicode.normalize s) method normalizePattern p = Unicode.normalize p Modified: trunk/src/case.mli =================================================================== --- trunk/src/case.mli 2009-05-28 09:23:33 UTC (rev 343) +++ trunk/src/case.mli 2009-05-29 12:05:25 UTC (rev 344) @@ -7,7 +7,7 @@ type mode val ops : unit -> - < mode : mode; + < mode : mode; modeDesc : string; compare : string -> string -> int; hash : string -> int; normalizePattern : string -> string; Modified: trunk/src/mkProjectInfo.ml =================================================================== --- trunk/src/mkProjectInfo.ml 2009-05-28 09:23:33 UTC (rev 343) +++ trunk/src/mkProjectInfo.ml 2009-05-29 12:05:25 UTC (rev 344) @@ -156,3 +156,4 @@ + Modified: trunk/src/remote.ml =================================================================== --- trunk/src/remote.ml 2009-05-28 09:23:33 UTC (rev 343) +++ trunk/src/remote.ml 2009-05-29 12:05:25 UTC (rev 344) @@ -1229,9 +1229,10 @@ let beAServer () = begin try + let home = System.getenv "HOME" in Util.convertUnixErrorsToFatal "changing working directory" - (fun () -> System.chdir (System.fspathFromString (System.getenv "HOME"))) + (fun () -> System.chdir (System.fspathFromString home)) with Not_found -> Util.msg "Environment variable HOME unbound: \ Modified: trunk/src/system/system_win.ml =================================================================== --- trunk/src/system/system_win.ml 2009-05-28 09:23:33 UTC (rev 343) +++ trunk/src/system/system_win.ml 2009-05-29 12:05:25 UTC (rev 344) @@ -17,11 +17,6 @@ (*XXXX -Backport to stable: -- Unix.select in lwt_unix (after some testing...) -- fix to daylight saving changes -- Proper quoting of path and names - - Use SetConsoleOutputCP/SetConsoleCP in text mode ??? http://www.codeproject.com/KB/cpp/unicode_console_output.aspx?display=Print Modified: trunk/src/system/system_win_stubs.c =================================================================== --- trunk/src/system/system_win_stubs.c 2009-05-28 09:23:33 UTC (rev 343) +++ trunk/src/system/system_win_stubs.c 2009-05-29 12:05:25 UTC (rev 344) @@ -111,6 +111,9 @@ err = GetLastError (); if ((err == ERROR_SHARING_VIOLATION || err == ERROR_ACCESS_DENIED) && t < 1000) { + /* The renaming may fail due to an indexer or an anti-virus. + We retry after a short time in the hope that this other + program is done with the file. */ Sleep (t); t *= 2; goto retry; Modified: trunk/src/uigtk2.ml =================================================================== --- trunk/src/uigtk2.ml 2009-05-28 09:23:33 UTC (rev 343) +++ trunk/src/uigtk2.ml 2009-05-29 12:05:25 UTC (rev 344) @@ -591,7 +591,7 @@ ignore (GMisc.label ~markup:(primaryText title ^ "\n\n" ^ escapeMarkup (transcode message)) - ~selectable:true ~yalign:0. ~packing:v1#add ()); + ~line_wrap:true ~selectable:true ~yalign:0. ~packing:v1#add ()); t#add_button_stock `QUIT `QUIT; t#set_default_response `QUIT; grabFocus t; t#show(); ignore (t#run ()); t#destroy (); releaseFocus (); Modified: trunk/src/update.ml =================================================================== --- trunk/src/update.ml 2009-05-28 09:23:33 UTC (rev 343) +++ trunk/src/update.ml 2009-05-29 12:05:25 UTC (rev 344) @@ -41,6 +41,8 @@ (*FIX: one should also store whether we are in case-insensitive mode in the archive and check the mode has not changed when the archive is loaded *) +(*FIX: consider changing the way case-sensitivity mode is stored in + the archive *) let archiveFormat = 22 module NameMap = MyMap.Make (Name) @@ -249,6 +251,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, + System.file_exists (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.ops ())#modeDesc 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 *) (*****************************************************************************) @@ -324,8 +374,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.ops())#modeDesc)); Marshal.to_channel c (archive, hash, magic) [Marshal.No_sharing]; close_out c) @@ -565,6 +617,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) @@ -761,18 +814,6 @@ System.file_exists (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, - System.file_exists (Os.fileInUnisonDir name))) - let forall = Safelist.for_all (fun x -> x) let exists = Safelist.exists (fun x -> x) @@ -1626,7 +1667,8 @@ Remote.Thread.unwindProtect (fun () -> let magic = - Format.sprintf "%.f.%d" (Unix.gettimeofday ()) (Unix.getpid ()) + Format.sprintf "%s\000%.f.%d" + ((Case.ops ())#modeDesc) (Unix.gettimeofday ()) (Unix.getpid ()) in Globals.allRootsMap (fun r -> prepareCommitOnRoot r magic) >>= (fun checksums -> From vouillon at seas.upenn.edu Fri May 29 08:54:28 2009 From: vouillon at seas.upenn.edu (vouillon@seas.upenn.edu) Date: Fri, 29 May 2009 08:54:28 -0400 Subject: [Unison-hackers] [unison-svn] r345 - branches/2.32/src Message-ID: <200905291254.n4TCsSeT017916@yaws.seas.upenn.edu> 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 *) From vouillon at seas.upenn.edu Fri May 29 10:00:22 2009 From: vouillon at seas.upenn.edu (vouillon@seas.upenn.edu) Date: Fri, 29 May 2009 10:00:22 -0400 Subject: [Unison-hackers] [unison-svn] r346 - branches/2.32/src Message-ID: <200905291400.n4TE0Mtk020408@yaws.seas.upenn.edu> Author: vouillon Date: 2009-05-29 10:00:18 -0400 (Fri, 29 May 2009) New Revision: 346 Added: branches/2.32/src/bytearray.ml branches/2.32/src/bytearray.mli branches/2.32/src/bytearray_stubs.c Modified: branches/2.32/src/.depend branches/2.32/src/Makefile.OCaml branches/2.32/src/RECENTNEWS branches/2.32/src/copy.ml branches/2.32/src/mkProjectInfo.ml branches/2.32/src/remote.ml branches/2.32/src/remote.mli branches/2.32/src/transfer.ml branches/2.32/src/transfer.mli Log: * Got rid of the 16MiB marshalling limit by marshalling to a bigarray Modified: branches/2.32/src/.depend =================================================================== --- branches/2.32/src/.depend 2009-05-29 12:54:25 UTC (rev 345) +++ branches/2.32/src/.depend 2009-05-29 14:00:18 UTC (rev 346) @@ -1,35 +1,53 @@ abort.cmi: uutil.cmi +bytearray.cmi: +case.cmi: +checksum.cmi: +clroot.cmi: common.cmi: uutil.cmi props.cmi path.cmi osx.cmi os.cmi name.cmi fspath.cmi \ fileinfo.cmi copy.cmi: uutil.cmi props.cmi path.cmi osx.cmi os.cmi lwt/lwt.cmi fspath.cmi \ common.cmi +external.cmi: fileinfo.cmi: props.cmi path.cmi osx.cmi fspath.cmi files.cmi: uutil.cmi props.cmi path.cmi lwt/lwt_util.cmi lwt/lwt.cmi \ common.cmi +fileutil.cmi: fingerprint.cmi: uutil.cmi path.cmi fspath.cmi fspath.cmi: path.cmi name.cmi globals.cmi: ubase/prefs.cmi path.cmi lwt/lwt.cmi common.cmi +lock.cmi: +name.cmi: os.cmi: props.cmi path.cmi name.cmi fspath.cmi fileinfo.cmi osx.cmi: uutil.cmi ubase/prefs.cmi path.cmi fspath.cmi fingerprint.cmi path.cmi: name.cmi +pred.cmi: props.cmi: uutil.cmi ubase/prefs.cmi path.cmi osx.cmi fspath.cmi recon.cmi: path.cmi common.cmi -remote.cmi: ubase/prefs.cmi lwt/lwt.cmi fspath.cmi common.cmi clroot.cmi +remote.cmi: ubase/prefs.cmi lwt/lwt.cmi fspath.cmi common.cmi clroot.cmi \ + bytearray.cmi sortri.cmi: common.cmi stasher.cmi: ubase/prefs.cmi path.cmi os.cmi fspath.cmi -transfer.cmi: uutil.cmi lwt/lwt.cmi +strings.cmi: +terminal.cmi: +test.cmi: +transfer.cmi: uutil.cmi lwt/lwt.cmi bytearray.cmi transport.cmi: uutil.cmi lwt/lwt.cmi common.cmi +tree.cmi: uicommon.cmi: uutil.cmi ubase/prefs.cmi path.cmi lwt/lwt.cmi common.cmi +uigtk2.cmi: uicommon.cmi uigtk.cmi: uicommon.cmi -uigtk2.cmi: uicommon.cmi +ui.cmi: uitext.cmi: uicommon.cmi update.cmi: tree.cmi props.cmi path.cmi osx.cmi os.cmi name.cmi lwt/lwt.cmi \ fspath.cmi fileinfo.cmi common.cmi +uutil.cmi: xferhint.cmi: ubase/prefs.cmi path.cmi os.cmi fspath.cmi abort.cmo: uutil.cmi ubase/util.cmi ubase/trace.cmi ubase/safelist.cmi \ abort.cmi abort.cmx: uutil.cmx ubase/util.cmx ubase/trace.cmx ubase/safelist.cmx \ abort.cmi +bytearray.cmo: bytearray.cmi +bytearray.cmx: bytearray.cmi case.cmo: ubase/prefs.cmi case.cmi case.cmx: ubase/prefs.cmx case.cmi checksum.cmo: checksum.cmi @@ -43,11 +61,11 @@ copy.cmo: xferhint.cmi uutil.cmi ubase/util.cmi transfer.cmi ubase/trace.cmi \ ubase/safelist.cmi remote.cmi props.cmi ubase/prefs.cmi path.cmi osx.cmi \ os.cmi lwt/lwt_util.cmi lwt/lwt.cmi globals.cmi fspath.cmi fileinfo.cmi \ - external.cmi common.cmi clroot.cmi abort.cmi copy.cmi + external.cmi common.cmi clroot.cmi bytearray.cmi abort.cmi copy.cmi copy.cmx: xferhint.cmx uutil.cmx ubase/util.cmx transfer.cmx ubase/trace.cmx \ ubase/safelist.cmx remote.cmx props.cmx ubase/prefs.cmx path.cmx osx.cmx \ os.cmx lwt/lwt_util.cmx lwt/lwt.cmx globals.cmx fspath.cmx fileinfo.cmx \ - external.cmx common.cmx clroot.cmx abort.cmx copy.cmi + external.cmx common.cmx clroot.cmx bytearray.cmx abort.cmx copy.cmi external.cmo: ubase/util.cmi ubase/safelist.cmi lwt/lwt_util.cmi \ lwt/lwt_unix.cmi lwt/lwt.cmi external.cmi external.cmx: ubase/util.cmx ubase/safelist.cmx lwt/lwt_util.cmx \ @@ -80,10 +98,10 @@ globals.cmx: ubase/util.cmx ubase/trace.cmx ubase/safelist.cmx remote.cmx \ ubase/prefs.cmx pred.cmx path.cmx os.cmx name.cmx lwt/lwt_util.cmx \ lwt/lwt_unix.cmx lwt/lwt.cmx common.cmx clroot.cmx globals.cmi +linkgtk2.cmo: uigtk2.cmi main.cmo +linkgtk2.cmx: uigtk2.cmx main.cmx linkgtk.cmo: uigtk.cmi main.cmo linkgtk.cmx: uigtk.cmx main.cmx -linkgtk2.cmo: uigtk2.cmi main.cmo -linkgtk2.cmx: uigtk2.cmx main.cmx linktext.cmo: uitext.cmi main.cmo linktext.cmx: uitext.cmx main.cmx linktk.cmo: main.cmo @@ -94,6 +112,8 @@ ubase/safelist.cmi remote.cmi ubase/prefs.cmi os.cmi fspath.cmi main.cmx: uutil.cmx ubase/util.cmx uitext.cmx uicommon.cmx strings.cmx \ ubase/safelist.cmx remote.cmx ubase/prefs.cmx os.cmx fspath.cmx +mkProjectInfo.cmo: +mkProjectInfo.cmx: name.cmo: ubase/util.cmi case.cmi name.cmi name.cmx: ubase/util.cmx case.cmx name.cmi os.cmo: uutil.cmi ubase/util.cmi ubase/safelist.cmi props.cmi ubase/prefs.cmi \ @@ -108,6 +128,8 @@ fileutil.cmi case.cmi path.cmi path.cmx: ubase/util.cmx ubase/safelist.cmx ubase/rx.cmx pred.cmx name.cmx \ fileutil.cmx case.cmx path.cmi +pixmaps.cmo: +pixmaps.cmx: pred.cmo: ubase/util.cmi ubase/safelist.cmi ubase/rx.cmi ubase/prefs.cmi \ case.cmi pred.cmi pred.cmx: ubase/util.cmx ubase/safelist.cmx ubase/rx.cmx ubase/prefs.cmx \ @@ -124,10 +146,10 @@ globals.cmx fileinfo.cmx common.cmx recon.cmi remote.cmo: uutil.cmi ubase/util.cmi ubase/trace.cmi terminal.cmi \ ubase/safelist.cmi ubase/prefs.cmi os.cmi lwt/lwt_unix.cmi lwt/lwt.cmi \ - fspath.cmi common.cmi clroot.cmi remote.cmi + fspath.cmi common.cmi clroot.cmi bytearray.cmi remote.cmi remote.cmx: uutil.cmx ubase/util.cmx ubase/trace.cmx terminal.cmx \ ubase/safelist.cmx ubase/prefs.cmx os.cmx lwt/lwt_unix.cmx lwt/lwt.cmx \ - fspath.cmx common.cmx clroot.cmx remote.cmi + fspath.cmx common.cmx clroot.cmx bytearray.cmx remote.cmi sortri.cmo: ubase/util.cmi ubase/safelist.cmi ubase/prefs.cmi pred.cmi \ path.cmi common.cmi sortri.cmi sortri.cmx: ubase/util.cmx ubase/safelist.cmx ubase/prefs.cmx pred.cmx \ @@ -155,9 +177,9 @@ ubase/prefs.cmx path.cmx os.cmx lwt/lwt_util.cmx lwt/lwt_unix.cmx \ lwt/lwt.cmx globals.cmx fspath.cmx fingerprint.cmx common.cmx test.cmi transfer.cmo: uutil.cmi ubase/util.cmi ubase/trace.cmi ubase/safelist.cmi \ - lwt/lwt.cmi checksum.cmi transfer.cmi + lwt/lwt.cmi checksum.cmi bytearray.cmi transfer.cmi transfer.cmx: uutil.cmx ubase/util.cmx ubase/trace.cmx ubase/safelist.cmx \ - lwt/lwt.cmx checksum.cmx transfer.cmi + lwt/lwt.cmx checksum.cmx bytearray.cmx transfer.cmi transport.cmo: uutil.cmi ubase/util.cmi update.cmi ubase/trace.cmi \ stasher.cmi remote.cmi props.cmi ubase/prefs.cmi path.cmi osx.cmi \ lwt/lwt_util.cmi lwt/lwt.cmi globals.cmi files.cmi common.cmi abort.cmi \ @@ -178,26 +200,26 @@ props.cmx ubase/prefs.cmx path.cmx osx.cmx os.cmx name.cmx \ lwt/lwt_unix.cmx lwt/lwt.cmx globals.cmx fspath.cmx files.cmx \ fileinfo.cmx common.cmx clroot.cmx case.cmx uicommon.cmi -uigtk.cmo: uutil.cmi ubase/util.cmi update.cmi uitext.cmi uicommon.cmi \ +uigtk2.cmo: uutil.cmi ubase/util.cmi update.cmi uitext.cmi uicommon.cmi \ transport.cmi ubase/trace.cmi strings.cmi sortri.cmi ubase/safelist.cmi \ remote.cmi recon.cmi ubase/prefs.cmi pixmaps.cmo path.cmi os.cmi \ lwt/lwt_util.cmi lwt/lwt_unix.cmi lwt/lwt.cmi globals.cmi fspath.cmi \ - files.cmi common.cmi clroot.cmi uigtk.cmi -uigtk.cmx: uutil.cmx ubase/util.cmx update.cmx uitext.cmx uicommon.cmx \ + files.cmi common.cmi clroot.cmi uigtk2.cmi +uigtk2.cmx: uutil.cmx ubase/util.cmx update.cmx uitext.cmx uicommon.cmx \ transport.cmx ubase/trace.cmx strings.cmx sortri.cmx ubase/safelist.cmx \ remote.cmx recon.cmx ubase/prefs.cmx pixmaps.cmx path.cmx os.cmx \ lwt/lwt_util.cmx lwt/lwt_unix.cmx lwt/lwt.cmx globals.cmx fspath.cmx \ - files.cmx common.cmx clroot.cmx uigtk.cmi -uigtk2.cmo: uutil.cmi ubase/util.cmi update.cmi uitext.cmi uicommon.cmi \ + files.cmx common.cmx clroot.cmx uigtk2.cmi +uigtk.cmo: uutil.cmi ubase/util.cmi update.cmi uitext.cmi uicommon.cmi \ transport.cmi ubase/trace.cmi strings.cmi sortri.cmi ubase/safelist.cmi \ remote.cmi recon.cmi ubase/prefs.cmi pixmaps.cmo path.cmi os.cmi \ lwt/lwt_util.cmi lwt/lwt_unix.cmi lwt/lwt.cmi globals.cmi fspath.cmi \ - files.cmi common.cmi clroot.cmi uigtk2.cmi -uigtk2.cmx: uutil.cmx ubase/util.cmx update.cmx uitext.cmx uicommon.cmx \ + files.cmi common.cmi clroot.cmi uigtk.cmi +uigtk.cmx: uutil.cmx ubase/util.cmx update.cmx uitext.cmx uicommon.cmx \ transport.cmx ubase/trace.cmx strings.cmx sortri.cmx ubase/safelist.cmx \ remote.cmx recon.cmx ubase/prefs.cmx pixmaps.cmx path.cmx os.cmx \ lwt/lwt_util.cmx lwt/lwt_unix.cmx lwt/lwt.cmx globals.cmx fspath.cmx \ - files.cmx common.cmx clroot.cmx uigtk2.cmi + files.cmx common.cmx clroot.cmx uigtk.cmi uimacbridge.cmo: xferhint.cmi uutil.cmi ubase/util.cmi update.cmi \ uicommon.cmi transport.cmi ubase/trace.cmi terminal.cmi stasher.cmi \ ubase/safelist.cmi remote.cmi recon.cmi ubase/prefs.cmi path.cmi os.cmi \ @@ -230,14 +252,14 @@ stasher.cmi ubase/safelist.cmi ubase/rx.cmi remote.cmi props.cmi \ ubase/prefs.cmi pred.cmi path.cmi osx.cmi os.cmi name.cmi ubase/myMap.cmi \ lwt/lwt_unix.cmi lwt/lwt.cmi lock.cmi globals.cmi fspath.cmi \ - fingerprint.cmi fileinfo.cmi external.cmi common.cmi update.cmi + fingerprint.cmi fileinfo.cmi external.cmi common.cmi case.cmi update.cmi update.cmx: xferhint.cmx uutil.cmx ubase/util.cmx tree.cmx ubase/trace.cmx \ stasher.cmx ubase/safelist.cmx ubase/rx.cmx remote.cmx props.cmx \ ubase/prefs.cmx pred.cmx path.cmx osx.cmx os.cmx name.cmx ubase/myMap.cmx \ lwt/lwt_unix.cmx lwt/lwt.cmx lock.cmx globals.cmx fspath.cmx \ - fingerprint.cmx fileinfo.cmx external.cmx common.cmx update.cmi -uutil.cmo: ubase/util.cmi uutil.cmi -uutil.cmx: ubase/util.cmx uutil.cmi + fingerprint.cmx fileinfo.cmx external.cmx common.cmx case.cmx update.cmi +uutil.cmo: ubase/util.cmi ubase/trace.cmi ubase/projectInfo.cmo uutil.cmi +uutil.cmx: ubase/util.cmx ubase/trace.cmx ubase/projectInfo.cmx uutil.cmi xferhint.cmo: ubase/util.cmi ubase/trace.cmi ubase/prefs.cmi path.cmi os.cmi \ fspath.cmi xferhint.cmi xferhint.cmx: ubase/util.cmx ubase/trace.cmx ubase/prefs.cmx path.cmx os.cmx \ @@ -256,6 +278,8 @@ ubase/prefs.cmi ubase/prefs.cmx: ubase/util.cmx ubase/uarg.cmx ubase/safelist.cmx \ ubase/prefs.cmi +ubase/projectInfo.cmo: +ubase/projectInfo.cmx: ubase/rx.cmo: ubase/rx.cmi ubase/rx.cmx: ubase/rx.cmi ubase/safelist.cmo: ubase/safelist.cmi @@ -270,7 +294,15 @@ ubase/uprintf.cmx: ubase/uprintf.cmi ubase/util.cmo: ubase/uprintf.cmi ubase/safelist.cmi ubase/util.cmi ubase/util.cmx: ubase/uprintf.cmx ubase/safelist.cmx ubase/util.cmi +lwt/lwt.cmi: lwt/lwt_unix.cmi: lwt/lwt.cmi lwt/lwt_util.cmi: lwt/lwt.cmi +lwt/pqueue.cmi: +ubase/myMap.cmi: ubase/prefs.cmi: ubase/util.cmi +ubase/rx.cmi: +ubase/safelist.cmi: ubase/trace.cmi: ubase/prefs.cmi +ubase/uarg.cmi: +ubase/uprintf.cmi: +ubase/util.cmi: Modified: branches/2.32/src/Makefile.OCaml =================================================================== --- branches/2.32/src/Makefile.OCaml 2009-05-29 12:54:25 UTC (rev 345) +++ branches/2.32/src/Makefile.OCaml 2009-05-29 14:00:18 UTC (rev 346) @@ -179,7 +179,7 @@ \ lwt/pqueue.cmo lwt/lwt.cmo lwt/lwt_util.cmo lwt/lwt_unix.cmo \ \ - case.cmo pred.cmo uutil.cmo \ + bytearray.cmo case.cmo pred.cmo uutil.cmo \ fileutil.cmo name.cmo path.cmo fspath.cmo fingerprint.cmo \ abort.cmo osx.cmo external.cmo \ props.cmo fileinfo.cmo os.cmo lock.cmo clroot.cmo common.cmo \ @@ -187,15 +187,15 @@ transfer.cmo xferhint.cmo remote.cmo globals.cmo copy.cmo \ stasher.cmo update.cmo \ files.cmo sortri.cmo recon.cmo transport.cmo \ - strings.cmo uicommon.cmo uitext.cmo test.cmo + strings.cmo uicommon.cmo uitext.cmo test.cmo OCAMLOBJS+=main.cmo # OCaml libraries for the bytecode version # File extensions will be substituted for the native code version -OCAMLLIBS+=unix.cma str.cma +OCAMLLIBS+=unix.cma str.cma bigarray.cma -COBJS+=osxsupport$(OBJ_EXT) pty$(OBJ_EXT) +COBJS+=osxsupport$(OBJ_EXT) pty$(OBJ_EXT) bytearray_stubs$(OBJ_EXT) ######################################################################## ### User Interface setup Modified: branches/2.32/src/RECENTNEWS =================================================================== --- branches/2.32/src/RECENTNEWS 2009-05-29 12:54:25 UTC (rev 345) +++ branches/2.32/src/RECENTNEWS 2009-05-29 14:00:18 UTC (rev 346) @@ -1,3 +1,8 @@ +CHANGES FROM VERSION 2.32.32 + +* Got rid of the 16MiB marshalling limit by marshalling to a bigarray + +------------------------------- CHANGES FROM VERSION 2.32.30 * Case sensitivity information put in the archive (in a backward Added: branches/2.32/src/bytearray.ml =================================================================== --- branches/2.32/src/bytearray.ml (rev 0) +++ branches/2.32/src/bytearray.ml 2009-05-29 14:00:18 UTC (rev 346) @@ -0,0 +1,94 @@ +(* Unison file synchronizer: src/bytearray.ml *) +(* Copyright 1999-2009, Benjamin C. Pierce + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +*) + +open Bigarray + +type t = (char, int8_unsigned_elt, c_layout) Array1.t + +let length = Bigarray.Array1.dim + +let create l = Bigarray.Array1.create Bigarray.char Bigarray.c_layout l + +(* +let unsafe_blit_from_string s i a j l = + for k = 0 to l - 1 do + a.{j + k} <- s.[i + k] + done + +let unsafe_blit_to_string a i s j l = + for k = 0 to l - 1 do + s.[j + k] <- a.{i + k} + done +*) + +external unsafe_blit_from_string : string -> int -> t -> int -> int -> unit + = "ml_blit_string_to_bigarray" "noalloc" + +external unsafe_blit_to_string : t -> int -> string -> int -> int -> unit + = "ml_blit_bigarray_to_string" "noalloc" + +let to_string a = + let l = length a in + if l > Sys.max_string_length then invalid_arg "Bytearray.to_string" else + let s = String.create l in + unsafe_blit_to_string a 0 s 0 l; + s + +let of_string s = + let l = String.length s in + let a = create l in + unsafe_blit_from_string s 0 a 0 l; + a + +let sub a ofs len = + if + ofs < 0 || len < 0 || ofs > length a - len || len > Sys.max_string_length + then + invalid_arg "Bytearray.sub" + else begin + let s = String.create len in + unsafe_blit_to_string a ofs s 0 len; + s + end + +let rec prefix_rec a i a' i' l = + l = 0 || + (a.{i} = a'.{i'} && prefix_rec a (i + 1) a' (i' + 1) (l - 1)) + +let prefix a a' i = + let l = length a in + let l' = length a' in + i <= l' - l && + prefix_rec a 0 a' i l + +let blit_from_string s i a j l = + if l < 0 || i < 0 || i > String.length s - l + || j < 0 || j > length a - l + then invalid_arg "Bytearray.blit_from_string" + else unsafe_blit_from_string s i a j l + +let blit_to_string a i s j l = + if l < 0 || i < 0 || i > length a - l + || j < 0 || j > String.length s - l + then invalid_arg "Bytearray.blit_to_string" + else unsafe_blit_to_string a i s j l + +external marshal : 'a -> Marshal.extern_flags list -> t + = "ml_marshal_to_bigarray" + +external unmarshal : t -> int -> 'a + = "ml_unmarshal_from_bigarray" Added: branches/2.32/src/bytearray.mli =================================================================== --- branches/2.32/src/bytearray.mli (rev 0) +++ branches/2.32/src/bytearray.mli 2009-05-29 14:00:18 UTC (rev 346) @@ -0,0 +1,25 @@ +(* Unison file synchronizer: src/bytearray.mli *) +(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) + +type t = + (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t + +val create : int -> t + +val length : t -> int + +val to_string : t -> string + +val of_string : string -> t + +val sub : t -> int -> int -> string + +val blit_from_string : string -> int -> t -> int -> int -> unit + +val blit_to_string : t -> int -> string -> int -> int -> unit + +val prefix : t -> t -> int -> bool + +val marshal : 'a -> Marshal.extern_flags list -> t + +val unmarshal : t -> int -> 'a Added: branches/2.32/src/bytearray_stubs.c =================================================================== --- branches/2.32/src/bytearray_stubs.c (rev 0) +++ branches/2.32/src/bytearray_stubs.c 2009-05-29 14:00:18 UTC (rev 346) @@ -0,0 +1,45 @@ +/* Unison file synchronizer: src/bytearray_stubs.c */ +/* Copyright 1999-2009 (see COPYING for details) */ + +#include + +#include "caml/intext.h" +#include "caml/bigarray.h" + +CAMLprim value ml_marshal_to_bigarray(value v, value flags) +{ + char *buf; + long len; + output_value_to_malloc(v, flags, &buf, &len); + return alloc_bigarray(BIGARRAY_UINT8 | BIGARRAY_C_LAYOUT | BIGARRAY_MANAGED, + 1, buf, &len); +} + + +#define Array_data(a, i) (((char *) a->data) + Long_val(i)) + + +CAMLprim value ml_unmarshal_from_bigarray(value b, value ofs) +{ + struct caml_bigarray *b_arr = Bigarray_val(b); + return input_value_from_block (Array_data (b_arr, ofs), + b_arr->dim[0] - Long_val(ofs)); +} + +CAMLprim value ml_blit_string_to_bigarray +(value s, value i, value a, value j, value l) +{ + char *src = String_val(s) + Int_val(i); + char *dest = Array_data(Bigarray_val(a), j); + memcpy(dest, src, Long_val(l)); + return Val_unit; +} + +CAMLprim value ml_blit_bigarray_to_string +(value a, value i, value s, value j, value l) +{ + char *src = Array_data(Bigarray_val(a), i); + char *dest = String_val(s) + Long_val(j); + memcpy(dest, src, Long_val(l)); + return Val_unit; +} Modified: branches/2.32/src/copy.ml =================================================================== --- branches/2.32/src/copy.ml 2009-05-29 12:54:25 UTC (rev 345) +++ branches/2.32/src/copy.ml 2009-05-29 14:00:18 UTC (rev 346) @@ -212,8 +212,8 @@ (fun (file_id, (data, pos, len)) rem -> ((Remote.encodeInt file_id, 0, 4) :: (data, pos, len) :: rem, len + 4)), (fun buf pos -> - let len = String.length buf - pos - 4 in - (Remote.decodeInt (String.sub buf pos 4), (buf, pos + 4, len))) + let len = Bytearray.length buf - pos - 4 in + (Remote.decodeInt buf pos, (buf, pos + 4, len))) let processTransferInstructionRemotely = Remote.registerSpecialServerCmd Modified: branches/2.32/src/mkProjectInfo.ml =================================================================== --- branches/2.32/src/mkProjectInfo.ml 2009-05-29 12:54:25 UTC (rev 345) +++ branches/2.32/src/mkProjectInfo.ml 2009-05-29 14:00:18 UTC (rev 346) @@ -114,3 +114,5 @@ + + Modified: branches/2.32/src/remote.ml =================================================================== --- branches/2.32/src/remote.ml 2009-05-29 12:54:25 UTC (rev 345) +++ branches/2.32/src/remote.ml 2009-05-29 14:00:18 UTC (rev 346) @@ -41,18 +41,18 @@ (****) let encodeInt m = - let int_buf = String.create 4 in - String.set int_buf 0 (Char.chr ( m land 0xff)); - String.set int_buf 1 (Char.chr ((m lsr 8) land 0xff)); - String.set int_buf 2 (Char.chr ((m lsr 16) land 0xff)); - String.set int_buf 3 (Char.chr ((m lsr 24) land 0xff)); + let int_buf = Bytearray.create 4 in + int_buf.{0} <- Char.chr ( m land 0xff); + int_buf.{1} <- Char.chr ((m lsr 8) land 0xff); + int_buf.{2} <- Char.chr ((m lsr 16) land 0xff); + int_buf.{3} <- Char.chr ((m lsr 24) land 0xff); int_buf -let decodeInt int_buf = - let b0 = Char.code (String.get int_buf 0) in - let b1 = Char.code (String.get int_buf 1) in - let b2 = Char.code (String.get int_buf 2) in - let b3 = Char.code (String.get int_buf 3) in +let decodeInt int_buf i = + let b0 = Char.code (int_buf.{i + 0}) in + let b1 = Char.code (int_buf.{i + 1}) in + let b2 = Char.code (int_buf.{i + 2}) in + let b3 = Char.code (int_buf.{i + 3}) in ((b3 lsl 24) lor (b2 lsl 16) lor (b1 lsl 8) lor b0) (*************************************************************************) @@ -84,7 +84,7 @@ outputChannel : Unix.file_descr; outputBuffer : string; mutable outputLength : int; - outputQueue : (string * int * int) list Queue.t; + outputQueue : (Bytearray.t * int * int) list Queue.t; mutable pendingOutput : bool; mutable flowControl : bool; mutable canWrite : bool; @@ -122,7 +122,7 @@ grab_rec conn s pos len) end else begin let l = min (len - pos) conn.inputLength in - String.blit conn.inputBuffer 0 s pos l; + Bytearray.blit_from_string conn.inputBuffer 0 s pos l; conn.inputLength <- conn.inputLength - l; if conn.inputLength > 0 then String.blit conn.inputBuffer l conn.inputBuffer 0 conn.inputLength; @@ -134,7 +134,7 @@ let grab conn s len = assert (len > 0); - assert (String.length s <= len); + assert (Bytearray.length s <= len); grab_rec conn s 0 len let peek_without_blocking conn = @@ -166,7 +166,7 @@ fill_buffer_2 conn s pos len) else begin let l = min (len - pos) (outputBuffer_size - conn.outputLength) in - String.blit s pos conn.outputBuffer conn.outputLength l; + Bytearray.blit_to_string s pos conn.outputBuffer conn.outputLength l; conn.outputLength <- conn.outputLength + l; if pos + l < len then fill_buffer_2 conn s (pos + l) len @@ -179,7 +179,7 @@ (s, pos, len) :: rem -> assert (pos >= 0); assert (len >= 0); - assert (pos + len <= String.length s); + assert (pos <= Bytearray.length s - len); fill_buffer_2 conn s pos len >>= (fun () -> fill_buffer conn rem) | [] -> @@ -339,11 +339,11 @@ (* MARSHALING *) (*****************************************************************************) -type tag = string +type tag = Bytearray.t type 'a marshalFunction = - 'a -> (string * int * int) list -> (string * int * int) list -type 'a unmarshalFunction = string -> 'a + 'a -> (Bytearray.t * int * int) list -> (Bytearray.t * int * int) list +type 'a unmarshalFunction = Bytearray.t -> 'a type 'a marshalingFunctions = 'a marshalFunction * 'a unmarshalFunction let registeredSet = ref Util.StringSet.empty @@ -354,9 +354,9 @@ "" | (s, p, l) :: rem -> if l < len then - String.sub s p l ^ first_chars (len - l) rem + Bytearray.sub s p l ^ first_chars (len - l) rem else - String.sub s p len + Bytearray.sub s p len (* An integer just a little smaller than the maximum representable in 30 bits *) let hugeint = 1000000000 @@ -367,50 +367,47 @@ let start = first_chars (min length 10) rem' in let start = if length > 10 then start ^ "..." else start in let start = String.escaped start in - Util.msg "Fatal error in safeMarshal: sending too many (%d) bytes with tag %s and contents [%s]\n" length tag start; + Util.msg "Fatal error in safeMarshal: sending too many (%d) bytes with tag %s and contents [%s]\n" length (Bytearray.to_string tag) start; raise (Util.Fatal ((Printf.sprintf - "Message payload too large (%d, %s, [%s]). \n" length tag start) + "Message payload too large (%d, %s, [%s]). \n" + length (Bytearray.to_string tag) start) ^ "This is a bug in Unison; if it happens to you in a repeatable way, \n" ^ "please post a report on the unison-users mailing list.")) end; - let l = String.length tag in + let l = Bytearray.length tag in debugE (fun() -> let start = first_chars (min length 10) rem' in let start = if length > 10 then start ^ "..." else start in let start = String.escaped start in - Util.msg "send [%s] '%s' %d bytes\n" tag start length); + Util.msg "send [%s] '%s' %d bytes\n" + (Bytearray.to_string tag) start length); ((encodeInt (l + length), 0, 4) :: (tag, 0, l) :: rem') let safeUnmarshal unmarshalPayload tag buf = - let taglength = String.length tag in - let identifier = String.sub buf 0 (min taglength (String.length buf)) in - if identifier = tag then + let taglength = Bytearray.length tag in + if Bytearray.prefix tag buf 0 then unmarshalPayload buf taglength else + let identifier = + String.escaped + (Bytearray.sub buf 0 (min taglength (Bytearray.length buf))) in raise (Util.Fatal - (Printf.sprintf "[safeUnmarshal] expected %s but got %s" - tag identifier)) + (Printf.sprintf "[safeUnmarshal] expected '%s' but got '%s'" + (String.escaped (Bytearray.to_string tag)) identifier)) let registerTag string = if Util.StringSet.mem string !registeredSet then raise (Util.Fatal (Printf.sprintf "tag %s is already registered" string)) else registeredSet := Util.StringSet.add string !registeredSet; - string + Bytearray.of_string string let defaultMarshalingFunctions = (fun data rem -> - try - let s = Marshal.to_string data [Marshal.No_sharing] in - let l = String.length s in - ((s, 0, String.length s) :: rem, l) - with Out_of_memory -> - raise (Util.Fatal - "Trying to transfer too much data in one go.\n\ - If this happens during update detection, try to\n\ - synchronize smaller pieces of the replica first\n\ - using the \"path\" directive.")), - (fun buf pos -> Marshal.from_string buf pos) + let s = Bytearray.marshal data [Marshal.No_sharing] in + let l = Bytearray.length s in + ((s, 0, l) :: rem, l)), + (fun buf pos -> Bytearray.unmarshal buf pos) let makeMarshalingFunctions payloadMarshalingFunctions string = let (marshalPayload, unmarshalPayload) = payloadMarshalingFunctions in @@ -557,24 +554,24 @@ let receivePacket conn = (* Get the length of the packet *) - let int_buf = String.create 4 in + let int_buf = Bytearray.create 4 in grab conn int_buf 4 >>= (fun () -> - let length = decodeInt int_buf in + let length = decodeInt int_buf 0 in assert (length >= 0); (* Get packet *) - let buf = String.create length in + let buf = Bytearray.create length in grab conn buf length >>= (fun () -> (debugE (fun () -> let start = - if length > 10 then (String.sub buf 0 10) ^ "..." - else String.sub buf 0 length in + if length > 10 then (Bytearray.sub buf 0 10) ^ "..." + else Bytearray.sub buf 0 length in let start = String.escaped start in Util.msg "receive '%s' %d bytes\n" start length); Lwt.return buf))) type servercmd = - connection -> string -> - ((string * int * int) list -> (string * int * int) list) Lwt.t + connection -> Bytearray.t -> + ((Bytearray.t * int * int) list -> (Bytearray.t * int * int) list) Lwt.t let serverCmds = ref (Util.StringMap.empty : servercmd Util.StringMap.t) type header = @@ -593,16 +590,16 @@ in Lwt.try_bind (fun () -> cmd conn buf) (fun marshal -> - debugE (fun () -> Util.msg "Sending result (id: %d)\n" (decodeInt id)); + debugE (fun () -> Util.msg "Sending result (id: %d)\n" (decodeInt id 0)); dump conn ((id, 0, 4) :: marshalHeader NormalResult (marshal []))) (function Util.Transient s -> debugE (fun () -> - Util.msg "Sending transient exception (id: %d)\n" (decodeInt id)); + Util.msg "Sending transient exception (id: %d)\n" (decodeInt id 0)); dump conn ((id, 0, 4) :: marshalHeader (TransientExn s) []) | Util.Fatal s -> debugE (fun () -> - Util.msg "Sending fatal exception (id: %d)\n" (decodeInt id)); + Util.msg "Sending fatal exception (id: %d)\n" (decodeInt id 0)); dump conn ((id, 0, 4) :: marshalHeader (FatalExn s) []) | e -> Lwt.fail e) @@ -633,9 +630,9 @@ Lwt.return ()) >>= (fun () -> debugE (fun () -> Util.msg "Waiting for next message\n"); (* Get the message ID *) - let id = String.create 4 in + let id = Bytearray.create 4 in grab conn id 4 >>= (fun () -> - let num_id = decodeInt id in + let num_id = decodeInt id 0 in if num_id = 0 then begin debugE (fun () -> Util.msg "Received the write permission\n"); allowWrites conn; @@ -780,12 +777,14 @@ let connectionHeader = "Unison " ^ Uutil.myMajorVersion ^ "\n" -let rec checkHeader conn prefix buffer pos len = +let rec checkHeader conn buffer pos len = if pos = len then Lwt.return () else begin (grab conn buffer 1 >>= (fun () -> - if buffer.[0] <> connectionHeader.[pos] then + if buffer.{0} <> connectionHeader.[pos] then + let prefix = + String.sub connectionHeader 0 pos ^ Bytearray.to_string buffer in let rest = peek_without_blocking conn in Lwt.fail (Util.Fatal @@ -793,15 +792,15 @@ expected \"" ^ String.escaped (* (String.sub connectionHeader 0 (pos + 1)) *) connectionHeader - ^ "\" but received \"" ^ String.escaped (prefix ^ buffer ^ rest) ^ "\", \n" - ^ "which differs at \"" ^ String.escaped (prefix ^ buffer) ^ "\".\n" + ^ "\" but received \"" ^ String.escaped (prefix ^ rest) ^ "\", \n" + ^ "which differs at \"" ^ String.escaped prefix ^ "\".\n" ^ "This can happen because you have different versions of Unison\n" ^ "installed on the client and server machines, or because\n" ^ "your connection is failing and somebody is printing an error\n" ^ "message, or because your remote login shell is printing\n" ^ "something itself before starting Unison.")) else - checkHeader conn (prefix ^ buffer) buffer (pos + 1) len)) + checkHeader conn buffer (pos + 1) len)) end (****) @@ -836,7 +835,8 @@ ignore(Sys.set_signal Sys.sigpipe Sys.Signal_ignore); let conn = setupIO in_ch out_ch in conn.canWrite <- false; - checkHeader conn "" " " 0 (String.length connectionHeader) >>= (fun () -> + checkHeader + conn (Bytearray.create 1) 0 (String.length connectionHeader) >>= (fun () -> Lwt.ignore_result (receive conn); negociateFlowControl conn >>= (fun () -> Lwt.return conn)) @@ -1119,7 +1119,8 @@ let conn = setupIO in_ch out_ch in try Lwt_unix.run - (dump conn [(connectionHeader, 0, String.length connectionHeader)] + (dump conn [(Bytearray.of_string connectionHeader, 0, + String.length connectionHeader)] >>= (fun () -> (* Set the local warning printer to make an RPC to the client and show the warning there; ditto for the message printer *) Modified: branches/2.32/src/remote.mli =================================================================== --- branches/2.32/src/remote.mli 2009-05-29 12:54:25 UTC (rev 345) +++ branches/2.32/src/remote.mli 2009-05-29 14:00:18 UTC (rev 346) @@ -83,16 +83,19 @@ string -> (connection -> 'a -> 'b Lwt.t) -> connection -> 'a -> 'b Lwt.t val registerSpecialServerCmd : string -> - ('a -> (string * int * int) list -> (string * int * int) list * int) * - (string -> int -> 'a) -> - ('b -> (string * int * int) list -> (string * int * int) list * int) * - (string -> int -> 'b) -> + ('a -> + (Bytearray.t * int * int) list -> (Bytearray.t * int * int) list * int) * + (Bytearray.t -> int -> 'a) -> + ('b -> + (Bytearray.t * int * int) list -> (Bytearray.t * int * int) list * int) * + (Bytearray.t -> int -> 'b) -> (connection -> 'a -> 'b Lwt.t) -> connection -> 'a -> 'b Lwt.t val defaultMarshalingFunctions : - ('a -> (string * int * int) list -> (string * int * int) list * int) * - (string -> int -> 'b) -val encodeInt : int -> string -val decodeInt : string -> int + ('a -> + (Bytearray.t * int * int) list -> (Bytearray.t * int * int) list * int) * + (Bytearray.t -> int -> 'b) +val encodeInt : int -> Bytearray.t +val decodeInt : Bytearray.t -> int -> int val registerRootCmdWithConnection : string (* command name *) -> (connection -> 'a -> 'b Lwt.t) (* local command *) Modified: branches/2.32/src/transfer.ml =================================================================== --- branches/2.32/src/transfer.ml 2009-05-29 12:54:25 UTC (rev 345) +++ branches/2.32/src/transfer.ml 2009-05-29 14:00:18 UTC (rev 346) @@ -56,7 +56,7 @@ open Lwt -type transfer_instruction = string * int * int +type transfer_instruction = Bytearray.t * int * int type transmitter = transfer_instruction -> unit Lwt.t @@ -100,7 +100,7 @@ let maxQueueSize = 65500 let maxQueueSizeFS = Uutil.Filesize.ofInt maxQueueSize type tokenQueue = - { mutable data : string; (* the queued tokens *) + { mutable data : Bytearray.t; (* the queued tokens *) mutable previous : [`Str of int | `Block of int | `None]; (* some informations about the previous token *) @@ -117,29 +117,29 @@ let encodeInt3 s pos i = assert (i >= 0 && i < 256 * 256 * 256); - s.[pos + 0] <- Char.chr ((i lsr 0) land 0xff); - s.[pos + 1] <- Char.chr ((i lsr 8) land 0xff); - s.[pos + 2] <- Char.chr ((i lsr 16) land 0xff) + s.{pos + 0} <- Char.chr ((i lsr 0) land 0xff); + s.{pos + 1} <- Char.chr ((i lsr 8) land 0xff); + s.{pos + 2} <- Char.chr ((i lsr 16) land 0xff) let decodeInt3 s pos = - (Char.code s.[pos + 0] lsl 0) lor - (Char.code s.[pos + 1] lsl 8) lor - (Char.code s.[pos + 2] lsl 16) + (Char.code s.{pos + 0} lsl 0) lor + (Char.code s.{pos + 1} lsl 8) lor + (Char.code s.{pos + 2} lsl 16) let encodeInt2 s pos i = assert (i >= 0 && i < 65536); - s.[pos + 0] <- Char.chr ((i lsr 0) land 0xff); - s.[pos + 1] <- Char.chr ((i lsr 8) land 0xff) + s.{pos + 0} <- Char.chr ((i lsr 0) land 0xff); + s.{pos + 1} <- Char.chr ((i lsr 8) land 0xff) let decodeInt2 s pos = - (Char.code s.[pos + 0] lsl 0) lor (Char.code s.[pos + 1] lsl 8) + (Char.code s.{pos + 0} lsl 0) lor (Char.code s.{pos + 1} lsl 8) let encodeInt1 s pos i = assert (i >= 0 && i < 256); - s.[pos + 0] <- Char.chr i + s.{pos + 0} <- Char.chr i let decodeInt1 s pos = - Char.code s.[pos + 0] + Char.code s.{pos + 0} (* Transmit the contents of the tokenQueue *) let flushQueue q showProgress transmit cond = @@ -154,34 +154,34 @@ let pushEOF q showProgress transmit = flushQueue q showProgress transmit - (q.pos + 1 > String.length q.data) >>= (fun () -> - q.data.[q.pos] <- 'E'; + (q.pos + 1 > Bytearray.length q.data) >>= (fun () -> + q.data.{q.pos} <- 'E'; q.pos <- q.pos + 1; q.previous <- `None; return ()) let pushString q id transmit s pos len = - flushQueue q id transmit (q.pos + len + 3 > String.length q.data) + flushQueue q id transmit (q.pos + len + 3 > Bytearray.length q.data) >>= (fun () -> - if q.pos + 3 + len > String.length q.data then begin + if q.pos + 3 + len > Bytearray.length q.data then begin (* The file is longer than expected, so the string does not fit in the buffer *) assert (q.pos = 0); - q.data <- String.create maxQueueSize + q.data <- Bytearray.create maxQueueSize end; - q.data.[q.pos] <- 'S'; + q.data.{q.pos} <- 'S'; encodeInt2 q.data (q.pos + 1) len; - assert (q.pos + 3 + len <= String.length q.data); - String.blit s pos q.data (q.pos + 3) len; + assert (q.pos + 3 + len <= Bytearray.length q.data); + Bytearray.blit_from_string s pos q.data (q.pos + 3) len; q.pos <- q.pos + len + 3; q.prog <- q.prog + len; q.previous <- `Str len; return ()) let rec growString q id transmit len' s pos len = - let l = min (String.length q.data - q.pos) len in - String.blit s pos q.data q.pos l; - assert (q.data.[q.pos - len' - 3] = 'S'); + let l = min (Bytearray.length q.data - q.pos) len in + Bytearray.blit_from_string s pos q.data q.pos l; + assert (q.data.{q.pos - len' - 3} = 'S'); assert (decodeInt2 q.data (q.pos - len' - 2) = len'); let len'' = len' + l in encodeInt2 q.data (q.pos - len' - 2) len''; @@ -194,8 +194,8 @@ return () let pushBlock q id transmit pos = - flushQueue q id transmit (q.pos + 5 > String.length q.data) >>= (fun () -> - q.data.[q.pos] <- 'B'; + flushQueue q id transmit (q.pos + 5 > Bytearray.length q.data) >>= (fun () -> + q.data.{q.pos} <- 'B'; encodeInt3 q.data (q.pos + 1) pos; encodeInt1 q.data (q.pos + 4) 1; q.pos <- q.pos + 5; @@ -205,7 +205,7 @@ let growBlock q id transmit pos = let count = decodeInt1 q.data (q.pos - 1) in - assert (q.data.[q.pos - 5] = 'B'); + assert (q.data.{q.pos - 5} = 'B'); assert (decodeInt3 q.data (q.pos - 4) + count = pos); assert (count < 255); encodeInt1 q.data (q.pos - 1) (count + 1); @@ -234,7 +234,7 @@ (* We need to make sure here that the size of the queue is not larger than 65538 (1 byte: header, 2 bytes: string size, 65535 bytes: string) *) - String.create + Bytearray.create (if length > maxQueueSizeFS then maxQueueSize else Uutil.Filesize.toInt length + 10); pos = 0; previous = `None; prog = 0 } @@ -272,12 +272,12 @@ let rec receiveRec outfd showProgress data pos maxPos = if pos = maxPos then false else - match data.[pos] with + match data.{pos} with 'S' -> let length = decodeInt2 data (pos + 1) in if Trace.enabled "generic" then debug (fun() -> Util.msg "receiving %d bytes\n" length); - reallyWrite outfd data (pos + 3) length; + reallyWrite outfd (Bytearray.sub data (pos + 3) length) 0 length; showProgress length; receiveRec outfd showProgress data (pos + length + 3) maxPos | 'E' -> @@ -403,13 +403,13 @@ let maxPos = pos + len in let rec decode pos = if pos = maxPos then false else - match data.[pos] with + match data.{pos} with 'S' -> let length = decodeInt2 data (pos + 1) in if Trace.enabled "rsynctoken" then debugToken (fun() -> Util.msg "decompressing string (%d bytes)\n" length); - reallyWrite outfd data (pos + 3) length; + reallyWrite outfd (Bytearray.sub data (pos + 3) length) 0 length; progress := !progress + length; decode (pos + length + 3) | 'B' -> Modified: branches/2.32/src/transfer.mli =================================================================== --- branches/2.32/src/transfer.mli 2009-05-29 12:54:25 UTC (rev 345) +++ branches/2.32/src/transfer.mli 2009-05-29 14:00:18 UTC (rev 346) @@ -37,7 +37,7 @@ (* Transfer instruction giving data to build a file incrementally *) -type transfer_instruction = string * int * int +type transfer_instruction = Bytearray.t * int * int type transmitter = transfer_instruction -> unit Lwt.t From vouillon at seas.upenn.edu Fri May 29 11:30:21 2009 From: vouillon at seas.upenn.edu (vouillon@seas.upenn.edu) Date: Fri, 29 May 2009 11:30:21 -0400 Subject: [Unison-hackers] [unison-svn] r347 - in branches/2.27/src: . lwt win32rc Message-ID: <200905291530.n4TFULsW023769@yaws.seas.upenn.edu> Author: vouillon Date: 2009-05-29 11:30:16 -0400 (Fri, 29 May 2009) New Revision: 347 Modified: branches/2.27/src/RECENTNEWS branches/2.27/src/case.ml branches/2.27/src/case.mli branches/2.27/src/lwt/lwt_unix.ml branches/2.27/src/mkProjectInfo.ml branches/2.27/src/props.ml branches/2.27/src/uicommon.ml branches/2.27/src/update.ml branches/2.27/src/win32rc/U.ico branches/2.27/src/win32rc/unison.rc branches/2.27/src/win32rc/unison.res branches/2.27/src/win32rc/unison.res.lib Log: Backport to stable release: * Ignore one hour differences for deciding whether a file may have been updated. This avoids slow update detection after daylight saving time changes under Windows. This makes it slightly more likely to miss an update, but that should be safe enough. * Improved Unison icon under Windows * Fixed quotation of paths and names when writing to a preference file * Case sensitivity information put in the archive (in a backward compatible way) and checked when the archive is loaded * Uses improved emulation of "select" call provided by Ocaml 3.11 under Windows (the GUI does not freeze as much during synchronization) Modified: branches/2.27/src/RECENTNEWS =================================================================== --- branches/2.27/src/RECENTNEWS 2009-05-29 14:00:18 UTC (rev 346) +++ branches/2.27/src/RECENTNEWS 2009-05-29 15:30:16 UTC (rev 347) @@ -1,3 +1,18 @@ +CHANGES FROM VERSION 2.27.109 + +Backport to stable release: +* Ignore one hour differences for deciding whether a file may have + been updated. This avoids slow update detection after daylight + saving time changes under Windows. This makes it slightly more + likely to miss an update, but that should be safe enough. +* Improved Unison icon under Windows +* Fixed quotation of paths and names when writing to a preference file +* Case sensitivity information put in the archive (in a backward + compatible way) and checked when the archive is loaded +* Uses improved emulation of "select" call provided by Ocaml 3.11 + under Windows (the GUI does not freeze as much during synchronization) + +------------------------------- CHANGES FROM VERSION 2.27.101 * Applied a patch from Karl M to make the GTK2 version build with Modified: branches/2.27/src/case.ml =================================================================== --- branches/2.27/src/case.ml 2009-05-29 14:00:18 UTC (rev 346) +++ branches/2.27/src/case.ml 2009-05-29 15:30:16 UTC (rev 347) @@ -28,6 +28,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.27/src/case.mli =================================================================== --- branches/2.27/src/case.mli 2009-05-29 14:00:18 UTC (rev 346) +++ branches/2.27/src/case.mli 2009-05-29 15:30:16 UTC (rev 347) @@ -2,6 +2,7 @@ (* Copyright 1999-2007 (see COPYING for details) *) val insensitive : unit -> bool +val modeDescription : unit -> string val normalize : string -> string Modified: branches/2.27/src/lwt/lwt_unix.ml =================================================================== --- branches/2.27/src/lwt/lwt_unix.ml 2009-05-29 14:00:18 UTC (rev 346) +++ branches/2.27/src/lwt/lwt_unix.ml 2009-05-29 15:30:16 UTC (rev 347) @@ -14,6 +14,9 @@ - [connect] is blocking *) let windows_hack = Sys.os_type <> "Unix" +let recent_ocaml = + Scanf.sscanf Sys.ocaml_version "%d.%d" + (fun maj min -> (maj = 3 && min >= 11) || maj > 3) module SleepQueue = Pqueue.Make (struct @@ -112,7 +115,7 @@ let infds = List.map fst !inputs in let outfds = List.map fst !outputs in let (readers, writers, _) = - if windows_hack then + if windows_hack && not recent_ocaml then let writers = outfds in let readers = if delay = 0. || writers <> [] then [] else infds in @@ -129,6 +132,11 @@ ([], [], []) | Unix.Unix_error (Unix.EBADF, _, _) -> (List.filter bad_fd infds, List.filter bad_fd outfds, []) + | Unix.Unix_error (Unix.EPIPE, _, _) + when windows_hack && recent_ocaml -> + (* Workaround for a bug in Ocaml 3.11: select fails with an + EPIPE error when the file descriptor is remotely closed *) + (infds, [], []) in restart_threads !event_counter now; List.iter Modified: branches/2.27/src/mkProjectInfo.ml =================================================================== --- branches/2.27/src/mkProjectInfo.ml 2009-05-29 14:00:18 UTC (rev 346) +++ branches/2.27/src/mkProjectInfo.ml 2009-05-29 15:30:16 UTC (rev 347) @@ -78,3 +78,4 @@ + Modified: branches/2.27/src/props.ml =================================================================== --- branches/2.27/src/props.ml 2009-05-29 14:00:18 UTC (rev 346) +++ branches/2.27/src/props.ml 2009-05-29 15:30:16 UTC (rev 347) @@ -525,8 +525,11 @@ we have to compare then using "similar". *) let same p p' = match p, p' with - Synced _, Synced _ -> similar p p' - | _ -> extract p = extract p' + Synced _, Synced _ -> + similar p p' + | _ -> + let delta = extract p -. extract p' in + delta = 0. || delta = 3600. || delta = -3600. let init _ = () Modified: branches/2.27/src/uicommon.ml =================================================================== --- branches/2.27/src/uicommon.ml 2009-05-29 14:00:18 UTC (rev 346) +++ branches/2.27/src/uicommon.ml 2009-05-29 15:30:16 UTC (rev 347) @@ -344,7 +344,7 @@ let pos = ref 0 in for i = 0 to len - 1 do match s.[i] with - '*' | '?' | '[' | '{' as c -> + '*' | '?' | '[' | '{' | '}' | ',' | '\\' as c -> buf.[!pos] <- '\\'; buf.[!pos + 1] <- c; pos := !pos + 2 | c -> buf.[!pos] <- c; pos := !pos + 1 Modified: branches/2.27/src/update.ml =================================================================== --- branches/2.27/src/update.ml 2009-05-29 14:00:18 UTC (rev 346) +++ branches/2.27/src/update.ml 2009-05-29 15:30:16 UTC (rev 347) @@ -229,6 +229,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 *) (*****************************************************************************) @@ -301,8 +349,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) @@ -536,6 +586,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) @@ -732,18 +783,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) @@ -1556,7 +1595,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.27/src/win32rc/U.ico =================================================================== (Binary files differ) Modified: branches/2.27/src/win32rc/unison.rc =================================================================== --- branches/2.27/src/win32rc/unison.rc 2009-05-29 14:00:18 UTC (rev 346) +++ branches/2.27/src/win32rc/unison.rc 2009-05-29 15:30:16 UTC (rev 347) @@ -1,80 +1,3 @@ #include UNISON_ICON ICON "U.ico" -X_cursor CURSOR DISCARDABLE "cursor00.cur" -arrow CURSOR DISCARDABLE "cursor02.cur" -based_arrow_down CURSOR DISCARDABLE "cursor04.cur" -based_arrow_up CURSOR DISCARDABLE "cursor06.cur" -boat CURSOR DISCARDABLE "cursor08.cur" -bogosity CURSOR DISCARDABLE "cursor0a.cur" -bottom_left_corner CURSOR DISCARDABLE "cursor0c.cur" -bottom_right_corner CURSOR DISCARDABLE "cursor0e.cur" -bottom_side CURSOR DISCARDABLE "cursor10.cur" -bottom_tee CURSOR DISCARDABLE "cursor12.cur" -box_spiral CURSOR DISCARDABLE "cursor14.cur" -center_ptr CURSOR DISCARDABLE "cursor16.cur" -circle CURSOR DISCARDABLE "cursor18.cur" -clock CURSOR DISCARDABLE "cursor1a.cur" -coffee_mug CURSOR DISCARDABLE "cursor1c.cur" -cross CURSOR DISCARDABLE "cursor1e.cur" -cross_reverse CURSOR DISCARDABLE "cursor20.cur" -crosshair CURSOR DISCARDABLE "cursor22.cur" -diamond_cross CURSOR DISCARDABLE "cursor24.cur" -dot CURSOR DISCARDABLE "cursor26.cur" -dotbox CURSOR DISCARDABLE "cursor28.cur" -double_arrow CURSOR DISCARDABLE "cursor2a.cur" -draft_large CURSOR DISCARDABLE "cursor2c.cur" -draft_small CURSOR DISCARDABLE "cursor2e.cur" -draped_box CURSOR DISCARDABLE "cursor30.cur" -exchange CURSOR DISCARDABLE "cursor32.cur" -fleur CURSOR DISCARDABLE "cursor34.cur" -gobbler CURSOR DISCARDABLE "cursor36.cur" -gumby CURSOR DISCARDABLE "cursor38.cur" -hand1 CURSOR DISCARDABLE "cursor3a.cur" -hand2 CURSOR DISCARDABLE "cursor3c.cur" -heart CURSOR DISCARDABLE "cursor3e.cur" -icon CURSOR DISCARDABLE "cursor40.cur" -iron_cross CURSOR DISCARDABLE "cursor42.cur" -left_ptr CURSOR DISCARDABLE "cursor44.cur" -left_side CURSOR DISCARDABLE "cursor46.cur" -left_tee CURSOR DISCARDABLE "cursor48.cur" -leftbutton CURSOR DISCARDABLE "cursor4a.cur" -ll_angle CURSOR DISCARDABLE "cursor4c.cur" -lr_angle CURSOR DISCARDABLE "cursor4e.cur" -man CURSOR DISCARDABLE "cursor50.cur" -middlebutton CURSOR DISCARDABLE "cursor52.cur" -mouse CURSOR DISCARDABLE "cursor54.cur" -pencil CURSOR DISCARDABLE "cursor56.cur" -pirate CURSOR DISCARDABLE "cursor58.cur" -plus CURSOR DISCARDABLE "cursor5a.cur" -question_arrow CURSOR DISCARDABLE "cursor5c.cur" -right_ptr CURSOR DISCARDABLE "cursor5e.cur" -right_side CURSOR DISCARDABLE "cursor60.cur" -right_tee CURSOR DISCARDABLE "cursor62.cur" -rightbutton CURSOR DISCARDABLE "cursor64.cur" -rtl_logo CURSOR DISCARDABLE "cursor66.cur" -sailboat CURSOR DISCARDABLE "cursor68.cur" -sb_down_arrow CURSOR DISCARDABLE "cursor6a.cur" -sb_h_double_arrow CURSOR DISCARDABLE "cursor6c.cur" -sb_left_arrow CURSOR DISCARDABLE "cursor6e.cur" -sb_right_arrow CURSOR DISCARDABLE "cursor70.cur" -sb_up_arrow CURSOR DISCARDABLE "cursor72.cur" -sb_v_double_arrow CURSOR DISCARDABLE "cursor74.cur" -shuttle CURSOR DISCARDABLE "cursor76.cur" -sizing CURSOR DISCARDABLE "cursor78.cur" -spider CURSOR DISCARDABLE "cursor7a.cur" -spraycan CURSOR DISCARDABLE "cursor7c.cur" -star CURSOR DISCARDABLE "cursor7e.cur" -target CURSOR DISCARDABLE "cursor80.cur" -tcross CURSOR DISCARDABLE "cursor82.cur" -top_left_arrow CURSOR DISCARDABLE "cursor84.cur" -top_left_corner CURSOR DISCARDABLE "cursor86.cur" -top_right_corner CURSOR DISCARDABLE "cursor88.cur" -top_side CURSOR DISCARDABLE "cursor8a.cur" -top_tee CURSOR DISCARDABLE "cursor8c.cur" -trek CURSOR DISCARDABLE "cursor8e.cur" -ul_angle CURSOR DISCARDABLE "cursor90.cur" -umbrella CURSOR DISCARDABLE "cursor92.cur" -ur_angle CURSOR DISCARDABLE "cursor94.cur" -xterm CURSOR DISCARDABLE "cursor98.cur" -watch CURSOR DISCARDABLE "cursor96.cur" Modified: branches/2.27/src/win32rc/unison.res =================================================================== (Binary files differ) Modified: branches/2.27/src/win32rc/unison.res.lib =================================================================== (Binary files differ) From vouillon at seas.upenn.edu Fri May 29 13:14:50 2009 From: vouillon at seas.upenn.edu (vouillon@seas.upenn.edu) Date: Fri, 29 May 2009 13:14:50 -0400 Subject: [Unison-hackers] [unison-svn] r348 - in trunk/src: . uimacnew/uimacnew.xcodeproj Message-ID: <200905291714.n4THEoJa027710@yaws.seas.upenn.edu> Author: vouillon Date: 2009-05-29 13:14:48 -0400 (Fri, 29 May 2009) New Revision: 348 Modified: trunk/src/RECENTNEWS trunk/src/mkProjectInfo.ml trunk/src/uimacnew/uimacnew.xcodeproj/project.pbxproj Log: * Fix to the Mac GUI: the bigarray library is now required Modified: trunk/src/RECENTNEWS =================================================================== --- trunk/src/RECENTNEWS 2009-05-29 15:30:16 UTC (rev 347) +++ trunk/src/RECENTNEWS 2009-05-29 17:14:48 UTC (rev 348) @@ -1,5 +1,9 @@ CHANGES FROM VERSION 2.34.0 +* Fix to the Mac GUI: the bigarray library is now required +------------------------------- +CHANGES FROM VERSION 2.34.0 + * Case sensitivity information put in the archive (in a backward compatible way) and checked when the archive is loaded Modified: trunk/src/mkProjectInfo.ml =================================================================== --- trunk/src/mkProjectInfo.ml 2009-05-29 15:30:16 UTC (rev 347) +++ trunk/src/mkProjectInfo.ml 2009-05-29 17:14:48 UTC (rev 348) @@ -157,3 +157,4 @@ + Modified: trunk/src/uimacnew/uimacnew.xcodeproj/project.pbxproj =================================================================== --- trunk/src/uimacnew/uimacnew.xcodeproj/project.pbxproj 2009-05-29 15:30:16 UTC (rev 347) +++ trunk/src/uimacnew/uimacnew.xcodeproj/project.pbxproj 2009-05-29 17:14:48 UTC (rev 348) @@ -581,6 +581,7 @@ "-lunix", "-lthreadsnat", "-lstr", + "-lbigarray", "-lasmrun", ); PREBINDING = NO; @@ -617,6 +618,7 @@ "-lunix", "-lthreadsnat", "-lstr", + "-lbigarray", "-lasmrun", ); PREBINDING = NO; @@ -650,6 +652,7 @@ "-lunix", "-lthreadsnat", "-lstr", + "-lbigarray", "-lasmrun", ); PREBINDING = NO;