[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
Benjamin C. Pierce
bcpierce at seas.upenn.edu
Fri May 1 22:31:51 EDT 2009
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|.#<filename>.<serial>.unison.tmp|.
- [N.b. This was later changed to \verb|.unison.<filename>.<serial>.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 =
- <everything else>
-\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 = <string>|' 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 <name>+, 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|<return>|) 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=<pattern>| (where
-\verb|<pattern>| 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=<pattern>|
-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|<root>|
-(by adding \verb|-prefer <root>| to the command line or \verb|prefer=<root>|)
-to your profile) means that, if there is a conflict, the contents of
-\verb|<root>|
-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|<root>|
-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-<currentversionnumber>| 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 = <regexp>
-\end{verbatim}
- in your profile ({\tt .unison/default.prf}), you should put:
-\begin{verbatim}
- ignore = Regexp <regexp>
-\end{verbatim}
-Moreover, two other styles of pattern are also recognized:
-\begin{verbatim}
- ignore = Name <name>
-\end{verbatim}
-matches any path in which one component matches \verb|<name>|, while
-\begin{verbatim}
- ignore = Path <path>
-\end{verbatim}
-matches exactly the path \verb|<path>|.
-
-Standard ``globbing'' conventions can be used in \verb|<name>| and
-\verb|<path>|:
-\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|.#<filename>.<serial>.unison.tmp|.
+ [N.b. This was later changed to \verb|.unison.<filename>.<serial>.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 =
+ <everything else>
+\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 = <string>|' 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 <name>+, 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|<return>|) 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=<pattern>| (where
+\verb|<pattern>| 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=<pattern>|
+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|<root>|
+(by adding \verb|-prefer <root>| to the command line or \verb|prefer=<root>|)
+to your profile) means that, if there is a conflict, the contents of
+\verb|<root>|
+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|<root>|
+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-<currentversionnumber>| 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 = <regexp>
+\end{verbatim}
+ in your profile ({\tt .unison/default.prf}), you should put:
+\begin{verbatim}
+ ignore = Regexp <regexp>
+\end{verbatim}
+Moreover, two other styles of pattern are also recognized:
+\begin{verbatim}
+ ignore = Name <name>
+\end{verbatim}
+matches any path in which one component matches \verb|<name>|, while
+\begin{verbatim}
+ ignore = Path <path>
+\end{verbatim}
+matches exactly the path \verb|<path>|.
+
+Standard ``globbing'' conventions can be used in \verb|<name>| and
+\verb|<path>|:
+\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" <swift at a...> 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 '<meta http-equiv="expires" content="0">'
- 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 <nagya at inf.elte.hu>,
- 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" <swift at a...> 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 '<meta http-equiv="expires" content="0">'
+ 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 <nagya at inf.elte.hu>,
+ 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 <http://www.gnu.org/licenses/>.
+*)
+
+
+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 <http://www.gnu.org/licenses/>.
+*)
+
+
+(* 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 <http://www.gnu.org/licenses/>.
+*)
+
+
+(* 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@saul.cis.upenn.edu:4040/hello/world"
-let t2 = "ssh://tjim@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 <http://www.gnu.org/licenses/>.
+*)
+
+
+(*
+ 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@saul.cis.upenn.edu:4040/hello/world"
+let t2 = "ssh://tjim@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 <http://www.gnu.org/licenses/>.
+*)
+
+
+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 <http://www.gnu.org/licenses/>.
+*)
+
+
+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 <http://www.gnu.org/licenses/>.
+*)
+
+
+(*****************************************************************************)
+(* 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 <http://www.gnu.org/licenses/>.
+*)
+
+
+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 <http://www.gnu.org/licenses/>.
+*)
+
+
+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 <http://www.gnu.org/licenses/>.
+*)
+
+
+(* 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 <http://www.gnu.org/licenses/>.
+*)
+
+
+(* 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 <http://www.gnu.org/licenses/>.
+*)
+
+
+(* 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 <http://www.gnu.org/licenses/>.
+*)
+
+
+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 <http://www.gnu.org/licenses/>.
+*)
+
+
+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 <http://www.gnu.org/licenses/>.
+*)
+
+
+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 <http://www.gnu.org/licenses/>.
+*)
+
+
+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 <http://www.gnu.org/licenses/>.
+*)
+
+
+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 <http://www.gnu.org/licenses/>.
+*)
+
+
+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 <http://www.gnu.org/licenses/>.
+*)
+
+
+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 <topic>\" for detailed information about <topic>\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 <http://www.gnu.org/licenses/>.
+*)
+
+
+(* ---------------------------------------------------------------------- *)
+
+(* 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 <topic>\" for detailed information about <topic>\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 <http://www.gnu.org/licenses/>.
+*)
+
+
+(* 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 <http://www.gnu.org/licenses/>.
+*)
+
+
+(* 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 <http://www.gnu.org/licenses/>.
+*)
+
+
+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 <http://www.gnu.org/licenses/>.
+*)
+
+
+(* 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 <http://www.gnu.org/licenses/>.
+*)
+
+
+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 <http://www.gnu.org/licenses/>.
+*)
+
+
+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
- <TYPE> <PAT> [ -> <ASSOCIATED STRING> ]
- The associated string is ignored by [test] but can be looked up by [assoc].
-
- Three forms of <TYPE>/<PAT> are recognized:
- "Name <name>": ..../<name> (using globx)
- "Path <path>": <path>, not starting with "/" (using globx)
- "Regex <regex>": <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
+ <TYPE> <PAT> [ -> <ASSOCIATED STRING> ]
+ The associated string is ignored by [test] but can be looked up by [assoc].
+
+ Three forms of <TYPE>/<PAT> are recognized:
+ "Name <name>": ..../<name> (using globx)
+ "Path <path>": <path>, not starting with "/" (using globx)
+ "Regex <regex>": <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 <http://www.gnu.org/licenses/>.
+*)
+
+
+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" | <one of the two roots> *)
-(* 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 <ROOT>' and '-force <ROOT>' *)
-(* 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 <http://www.gnu.org/licenses/>.
+*)
+
+
+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" | <one of the two roots> *)
+(* 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 <ROOT>' and '-force <ROOT>' *)
+(* 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 <ROOT>' and '-force <ROOT>' *)
-(* 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 <ROOT>' and '-force <ROOT>' *)
+(* 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 <http://www.gnu.org/licenses/>.
+*)
+
+
+(*
+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
- <funcName>OnRoot and <funcName>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
+ <funcName>OnRoot and <funcName>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<l2 then -1 else if l2<l1 then 1 else 0
- else 0);
- (compare (Path.toString ri1.path) (Path.toString ri2.path))
- ] in
- dbgsort (fun() -> 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 <http://www.gnu.org/licenses/>.
+*)
+
+
+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<l2 then -1 else if l2<l1 then 1 else 0
+ else 0);
+ (compare (Path.toString ri1.path) (Path.toString ri2.path))
+ ] in
+ dbgsort (fun() -> 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 <http://www.gnu.org/licenses/>.
+*)
+
+
+(* --------------------------------------------------------------------------*)
+(* 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@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@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 = <value>\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 = <pathspec>\n\
- \n\
- \032 where <pathspec> 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 = <PATHSPEC> -> <MERGECMD>\n\
- \n\
- \032 The <PATHSPEC> 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 <PATHSPEC> 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 <MERGECMD> part of the preference specifies what external command\n\
- \032 should be invoked to merge files at paths matching the <PATHSPEC>.\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%;<SSHDIR>\n\
- \032 set HOME=<HOMEDIR>\n\
- \032 to the file C:\\AUTOEXEC.BAT, where <HOMEDIR> is the directory\n\
- \032 where you want ssh to create its .ssh directory, and <SSHDIR>\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 ;<SSHDIR> to\n\
- \032 it, where <SSHDIR> 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 <remote host> -l <login name>\n\
- \032 You should get a prompt for your password on <remote host>,\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 .#<filename>.<serial>.unison.tmp. [N.b. This was later\n\
- \032 changed to .unison.<filename>.<serial>.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 <everything else>\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 = <string>'\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 <name>,\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 <return>) 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=<pattern> (where <pattern> 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=<pattern> 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 <root> (by adding\n\
- \032 -prefer <root> to the command line or prefer=<root>) to your\n\
- \032 profile) means that, if there is a conflict, the contents of\n\
- \032 <root> 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 <root> 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-<currentversionnumber> 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 = <regexp>\n\
- \032 in your profile (.unison/default.prf), you should put:\n\
- \032 ignore = Regexp <regexp>\n\
- \032 Moreover, two other styles of pattern are also recognized:\n\
- \032 ignore = Name <name>\n\
- \032 matches any path in which one component matches <name>, while\n\
- \032 ignore = Path <path>\n\
- \032 matches exactly the path <path>.\n\
- \032 Standard \"globbing\" conventions can be used in <name> and <path>:\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@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@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 = <value>\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 = <pathspec>\n\
+ \n\
+ \032 where <pathspec> 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 = <PATHSPEC> -> <MERGECMD>\n\
+ \n\
+ \032 The <PATHSPEC> 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 <PATHSPEC> 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 <MERGECMD> part of the preference specifies what external command\n\
+ \032 should be invoked to merge files at paths matching the <PATHSPEC>.\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%;<SSHDIR>\n\
+ \032 set HOME=<HOMEDIR>\n\
+ \032 to the file C:\\AUTOEXEC.BAT, where <HOMEDIR> is the directory\n\
+ \032 where you want ssh to create its .ssh directory, and <SSHDIR>\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 ;<SSHDIR> to\n\
+ \032 it, where <SSHDIR> 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 <remote host> -l <login name>\n\
+ \032 You should get a prompt for your password on <remote host>,\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 .#<filename>.<serial>.unison.tmp. [N.b. This was later\n\
+ \032 changed to .unison.<filename>.<serial>.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 <everything else>\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 = <string>'\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 <name>,\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 <return>) 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=<pattern> (where <pattern> 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=<pattern> 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 <root> (by adding\n\
+ \032 -prefer <root> to the command line or prefer=<root>) to your\n\
+ \032 profile) means that, if there is a conflict, the contents of\n\
+ \032 <root> 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 <root> 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-<currentversionnumber> 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 = <regexp>\n\
+ \032 in your profile (.unison/default.prf), you should put:\n\
+ \032 ignore = Regexp <regexp>\n\
+ \032 Moreover, two other styles of pattern are also recognized:\n\
+ \032 ignore = Name <name>\n\
+ \032 matches any path in which one component matches <name>, while\n\
+ \032 ignore = Path <path>\n\
+ \032 matches exactly the path <path>.\n\
+ \032 Standard \"globbing\" conventions can be used in <name> and <path>:\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 <http://www.gnu.org/licenses/>.
+*)
+
+
+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 <http://www.gnu.org/licenses/>.
+*)
+
+
+(* 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] <desc>
- ...
- [END] <desc>
- **)
-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 <http://www.gnu.org/licenses/>.
+*)
+
+
+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] <desc>
+ ...
+ [END] <desc>
+ **)
+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 <http://www.gnu.org/licenses/>.
+*)
+
+
+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 <http://www.gnu.org/licenses/>.
+*)
+
+(*
+ 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 <http://www.gnu.org/licenses/>.
+*)
+
+
+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 <http://www.gnu.org/licenses/>.
+*)
+
+
+(* ---------------------------------------------------------------------- *)
+(* 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<blen then alen else blen in
- let rec loop i =
- if i>=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 <http://www.gnu.org/licenses/>.
+*)
+
+
+(*****************************************************************************)
+(* CASE INSENSITIVE COMPARISON *)
+(*****************************************************************************)
+let nocase_cmp a b =
+ let alen = String.length a in
+ let blen = String.length b in
+ let minlen = if alen<blen then alen else blen in
+ let rec loop i =
+ if i>=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 <http://www.gnu.org/licenses/>.
+*)
+
+
+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 "<span weight=\"bold\" size=\"larger\">%s</span>"
- (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 <http://www.gnu.org/licenses/>.
+*)
+
+
+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 "<span weight=\"bold\" size=\"larger\">%s</span>"
+ (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 = "<group>"; };
- 1058C7A1FEA54F0111CA2CBB /* Cocoa.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; name = Cocoa.framework; path = /System/Library/Frameworks/Cocoa.framework; sourceTree = "<absolute>"; };
- 29B97316FDCFA39411CA2CEA /* main.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = main.m; sourceTree = "<group>"; };
- 29B97319FDCFA39411CA2CEA /* English */ = {isa = PBXFileReference; lastKnownFileType = wrapper.nib; name = English; path = English.lproj/MainMenu.nib; sourceTree = "<group>"; };
- 2A3C3F3209922A8000E404E9 /* Growl.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; path = Growl.framework; sourceTree = "<group>"; };
- 2A3C3F7A09922D4900E404E9 /* NotificationController.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = NotificationController.h; sourceTree = "<group>"; };
- 2A3C3F7B09922D4900E404E9 /* NotificationController.m */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.objc; path = NotificationController.m; sourceTree = "<group>"; };
- 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 = "<group>"; };
- 44042CB30BE4FC9B00A6BBB2 /* ProgressCell.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = ProgressCell.h; sourceTree = "<group>"; };
- 44042CB40BE4FC9B00A6BBB2 /* ProgressCell.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = ProgressCell.m; sourceTree = "<group>"; };
- 44042D100BE52AED00A6BBB2 /* ProgressBarAdvanced.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarAdvanced.png; path = progressicons/ProgressBarAdvanced.png; sourceTree = "<group>"; };
- 44042D110BE52AED00A6BBB2 /* ProgressBarBlue.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarBlue.png; path = progressicons/ProgressBarBlue.png; sourceTree = "<group>"; };
- 44042D120BE52AED00A6BBB2 /* ProgressBarEndAdvanced.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarEndAdvanced.png; path = progressicons/ProgressBarEndAdvanced.png; sourceTree = "<group>"; };
- 44042D130BE52AED00A6BBB2 /* ProgressBarEndBlue.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarEndBlue.png; path = progressicons/ProgressBarEndBlue.png; sourceTree = "<group>"; };
- 44042D140BE52AED00A6BBB2 /* ProgressBarEndGray.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarEndGray.png; path = progressicons/ProgressBarEndGray.png; sourceTree = "<group>"; };
- 44042D150BE52AED00A6BBB2 /* ProgressBarEndGreen.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarEndGreen.png; path = progressicons/ProgressBarEndGreen.png; sourceTree = "<group>"; };
- 44042D160BE52AED00A6BBB2 /* ProgressBarEndWhite.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarEndWhite.png; path = progressicons/ProgressBarEndWhite.png; sourceTree = "<group>"; };
- 44042D170BE52AED00A6BBB2 /* ProgressBarGray.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarGray.png; path = progressicons/ProgressBarGray.png; sourceTree = "<group>"; };
- 44042D180BE52AED00A6BBB2 /* ProgressBarGreen.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarGreen.png; path = progressicons/ProgressBarGreen.png; sourceTree = "<group>"; };
- 44042D190BE52AED00A6BBB2 /* ProgressBarLightGreen.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarLightGreen.png; path = progressicons/ProgressBarLightGreen.png; sourceTree = "<group>"; };
- 44042D1A0BE52AED00A6BBB2 /* ProgressBarWhite.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarWhite.png; path = progressicons/ProgressBarWhite.png; sourceTree = "<group>"; };
- 440EEAF20C03EC3D00ACAAB0 /* Change_Created.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = Change_Created.png; sourceTree = "<group>"; };
- 440EEAF60C03F0B800ACAAB0 /* Change_Deleted.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = Change_Deleted.png; sourceTree = "<group>"; };
- 440EEAF70C03F0B800ACAAB0 /* Change_Modified.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = Change_Modified.png; sourceTree = "<group>"; };
- 440EEAF80C03F0B800ACAAB0 /* Change_PropsChanged.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = Change_PropsChanged.png; sourceTree = "<group>"; };
- 445A291A0BFA5B3300E4E641 /* Outline-Deep.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = "Outline-Deep.png"; sourceTree = "<group>"; };
- 445A29260BFA5C1200E4E641 /* Outline-Flat.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = "Outline-Flat.png"; sourceTree = "<group>"; };
- 445A29280BFA5C1B00E4E641 /* Outline-Flattened.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = "Outline-Flattened.png"; sourceTree = "<group>"; };
- 445A2A5B0BFAB6A100E4E641 /* ImageAndTextCell.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = ImageAndTextCell.h; sourceTree = "<group>"; };
- 445A2A5D0BFAB6C300E4E641 /* ImageAndTextCell.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = ImageAndTextCell.m; sourceTree = "<group>"; };
- 449F03DE0BE00DE9003F15C8 /* Bridge.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = Bridge.h; sourceTree = "<group>"; };
- 449F03DF0BE00DE9003F15C8 /* Bridge.m */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.objc; path = Bridge.m; sourceTree = "<group>"; };
- 44A794A00BE16C380069680C /* ExceptionHandling.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; name = ExceptionHandling.framework; path = /System/Library/Frameworks/ExceptionHandling.framework; sourceTree = "<absolute>"; };
- 44A797F10BE3F9B70069680C /* table-mixed.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-mixed.tif"; sourceTree = "<group>"; };
- 44F472AF0C0DB735006428EF /* Change_Absent.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = Change_Absent.png; sourceTree = "<group>"; };
- 44F472B00C0DB735006428EF /* Change_Unmodified.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = Change_Unmodified.png; sourceTree = "<group>"; };
- 690F564404F11EC300CF23A4 /* ProfileController.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = ProfileController.h; sourceTree = "<group>"; };
- 690F564504F11EC300CF23A4 /* ProfileController.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = ProfileController.m; sourceTree = "<group>"; };
- 691CE180051BB44A00CF23A4 /* ProfileTableView.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = ProfileTableView.h; sourceTree = "<group>"; };
- 691CE181051BB44A00CF23A4 /* ProfileTableView.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = ProfileTableView.m; sourceTree = "<group>"; };
- 69660DC604F08CC100CF23A4 /* MyController.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = MyController.h; sourceTree = "<group>"; };
- 69660DC704F08CC100CF23A4 /* MyController.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = MyController.m; sourceTree = "<group>"; };
- 697985CD050CFA2D00CF23A4 /* PreferencesController.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = PreferencesController.h; sourceTree = "<group>"; };
- 697985CE050CFA2D00CF23A4 /* PreferencesController.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = PreferencesController.m; sourceTree = "<group>"; };
- 69BA7DA804FD695200CF23A4 /* ReconTableView.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = ReconTableView.h; sourceTree = "<group>"; };
- 69BA7DA904FD695200CF23A4 /* ReconTableView.m */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.objc; path = ReconTableView.m; sourceTree = "<group>"; };
- 69C625CA0664E94E00B3C46A /* Unison.icns */ = {isa = PBXFileReference; lastKnownFileType = image.icns; path = Unison.icns; sourceTree = "<group>"; };
- 69C625F40664EC3300B3C46A /* Info.plist */ = {isa = PBXFileReference; lastKnownFileType = text.plist.xml; path = Info.plist; sourceTree = "<group>"; };
- 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 = "<group>"; };
- 69D3C6FA04F1CC3700CF23A4 /* ReconItem.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = ReconItem.h; sourceTree = "<group>"; };
- 69E407B907EB95AA00D37AA1 /* Security.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; name = Security.framework; path = /System/Library/Frameworks/Security.framework; sourceTree = "<absolute>"; };
- B518071209D6652100B1B21F /* add.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = add.tif; sourceTree = "<group>"; };
- B518071309D6652100B1B21F /* diff.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = diff.tif; sourceTree = "<group>"; };
- B518071409D6652100B1B21F /* go.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = go.tif; sourceTree = "<group>"; };
- B518071509D6652100B1B21F /* left.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = left.tif; sourceTree = "<group>"; };
- B518071609D6652100B1B21F /* merge.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = merge.tif; sourceTree = "<group>"; };
- B518071709D6652100B1B21F /* quit.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = quit.tif; sourceTree = "<group>"; };
- B518071809D6652100B1B21F /* restart.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = restart.tif; sourceTree = "<group>"; };
- B518071909D6652100B1B21F /* right.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = right.tif; sourceTree = "<group>"; };
- B518071A09D6652100B1B21F /* save.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = save.tif; sourceTree = "<group>"; };
- B518071B09D6652100B1B21F /* skip.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = skip.tif; sourceTree = "<group>"; };
- B554003E09C4E5A00089E1C3 /* UnisonToolbar.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = UnisonToolbar.h; sourceTree = "<group>"; };
- B554004009C4E5AA0089E1C3 /* UnisonToolbar.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = UnisonToolbar.m; sourceTree = "<group>"; };
- B5B44C1109DF61A4000DC7AF /* table-conflict.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-conflict.tif"; sourceTree = "<group>"; };
- B5B44C1209DF61A4000DC7AF /* table-error.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-error.tif"; sourceTree = "<group>"; };
- B5B44C1309DF61A4000DC7AF /* table-left-blue.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-left-blue.tif"; sourceTree = "<group>"; };
- B5B44C1409DF61A4000DC7AF /* table-left-green.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-left-green.tif"; sourceTree = "<group>"; };
- B5B44C1509DF61A4000DC7AF /* table-merge.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-merge.tif"; sourceTree = "<group>"; };
- B5B44C1609DF61A4000DC7AF /* table-right-blue.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-right-blue.tif"; sourceTree = "<group>"; };
- B5B44C1709DF61A4000DC7AF /* table-right-green.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-right-green.tif"; sourceTree = "<group>"; };
- B5B44C1809DF61A4000DC7AF /* table-skip.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-skip.tif"; sourceTree = "<group>"; };
- B5E03B3809E38B9E0058C7B9 /* rescan.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; name = rescan.tif; path = toolbar/rescan.tif; sourceTree = "<group>"; };
-/* 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 = "<group>";
- };
- 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 = "<group>";
- };
- 29B97315FDCFA39411CA2CEA /* Other Sources */ = {
- isa = PBXGroup;
- children = (
- 29B97316FDCFA39411CA2CEA /* main.m */,
- );
- name = "Other Sources";
- sourceTree = "<group>";
- };
- 29B97317FDCFA39411CA2CEA /* Resources */ = {
- isa = PBXGroup;
- children = (
- 29B97318FDCFA39411CA2CEA /* MainMenu.nib */,
- 089C165CFE840E0CC02AAC07 /* InfoPlist.strings */,
- 69C625CA0664E94E00B3C46A /* Unison.icns */,
- );
- name = Resources;
- sourceTree = "<group>";
- };
- 29B97323FDCFA39411CA2CEA /* Frameworks */ = {
- isa = PBXGroup;
- children = (
- 1058C7A1FEA54F0111CA2CBB /* Cocoa.framework */,
- 44A794A00BE16C380069680C /* ExceptionHandling.framework */,
- 2A3C3F3209922A8000E404E9 /* Growl.framework */,
- 69E407B907EB95AA00D37AA1 /* Security.framework */,
- );
- name = Frameworks;
- sourceTree = "<group>";
- };
- 2E282CB80D9AE16300439D01 /* External objects */ = {
- isa = PBXGroup;
- children = (
- 2E282CC70D9AE2B000439D01 /* unison-blob.o */,
- );
- name = "External objects";
- sourceTree = "<group>";
- };
- 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 = "<group>";
- };
- 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 = "<group>";
- };
- 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 = "<group>";
- };
- 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 = "<group>";
- };
-/* 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 = "<group>";
- };
- 29B97318FDCFA39411CA2CEA /* MainMenu.nib */ = {
- isa = PBXVariantGroup;
- children = (
- 29B97319FDCFA39411CA2CEA /* English */,
- );
- name = MainMenu.nib;
- sourceTree = "<group>";
- };
-/* 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 = "<group>"; };
+ 1058C7A1FEA54F0111CA2CBB /* Cocoa.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; name = Cocoa.framework; path = /System/Library/Frameworks/Cocoa.framework; sourceTree = "<absolute>"; };
+ 29B97316FDCFA39411CA2CEA /* main.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = main.m; sourceTree = "<group>"; };
+ 29B97319FDCFA39411CA2CEA /* English */ = {isa = PBXFileReference; lastKnownFileType = wrapper.nib; name = English; path = English.lproj/MainMenu.nib; sourceTree = "<group>"; };
+ 2A3C3F3209922A8000E404E9 /* Growl.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; path = Growl.framework; sourceTree = "<group>"; };
+ 2A3C3F7A09922D4900E404E9 /* NotificationController.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = NotificationController.h; sourceTree = "<group>"; };
+ 2A3C3F7B09922D4900E404E9 /* NotificationController.m */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.objc; path = NotificationController.m; sourceTree = "<group>"; };
+ 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 = "<group>"; };
+ 44042CB30BE4FC9B00A6BBB2 /* ProgressCell.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = ProgressCell.h; sourceTree = "<group>"; };
+ 44042CB40BE4FC9B00A6BBB2 /* ProgressCell.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = ProgressCell.m; sourceTree = "<group>"; };
+ 44042D100BE52AED00A6BBB2 /* ProgressBarAdvanced.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarAdvanced.png; path = progressicons/ProgressBarAdvanced.png; sourceTree = "<group>"; };
+ 44042D110BE52AED00A6BBB2 /* ProgressBarBlue.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarBlue.png; path = progressicons/ProgressBarBlue.png; sourceTree = "<group>"; };
+ 44042D120BE52AED00A6BBB2 /* ProgressBarEndAdvanced.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarEndAdvanced.png; path = progressicons/ProgressBarEndAdvanced.png; sourceTree = "<group>"; };
+ 44042D130BE52AED00A6BBB2 /* ProgressBarEndBlue.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarEndBlue.png; path = progressicons/ProgressBarEndBlue.png; sourceTree = "<group>"; };
+ 44042D140BE52AED00A6BBB2 /* ProgressBarEndGray.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarEndGray.png; path = progressicons/ProgressBarEndGray.png; sourceTree = "<group>"; };
+ 44042D150BE52AED00A6BBB2 /* ProgressBarEndGreen.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarEndGreen.png; path = progressicons/ProgressBarEndGreen.png; sourceTree = "<group>"; };
+ 44042D160BE52AED00A6BBB2 /* ProgressBarEndWhite.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarEndWhite.png; path = progressicons/ProgressBarEndWhite.png; sourceTree = "<group>"; };
+ 44042D170BE52AED00A6BBB2 /* ProgressBarGray.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarGray.png; path = progressicons/ProgressBarGray.png; sourceTree = "<group>"; };
+ 44042D180BE52AED00A6BBB2 /* ProgressBarGreen.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarGreen.png; path = progressicons/ProgressBarGreen.png; sourceTree = "<group>"; };
+ 44042D190BE52AED00A6BBB2 /* ProgressBarLightGreen.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarLightGreen.png; path = progressicons/ProgressBarLightGreen.png; sourceTree = "<group>"; };
+ 44042D1A0BE52AED00A6BBB2 /* ProgressBarWhite.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = ProgressBarWhite.png; path = progressicons/ProgressBarWhite.png; sourceTree = "<group>"; };
+ 440EEAF20C03EC3D00ACAAB0 /* Change_Created.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = Change_Created.png; sourceTree = "<group>"; };
+ 440EEAF60C03F0B800ACAAB0 /* Change_Deleted.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = Change_Deleted.png; sourceTree = "<group>"; };
+ 440EEAF70C03F0B800ACAAB0 /* Change_Modified.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = Change_Modified.png; sourceTree = "<group>"; };
+ 440EEAF80C03F0B800ACAAB0 /* Change_PropsChanged.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = Change_PropsChanged.png; sourceTree = "<group>"; };
+ 445A291A0BFA5B3300E4E641 /* Outline-Deep.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = "Outline-Deep.png"; sourceTree = "<group>"; };
+ 445A29260BFA5C1200E4E641 /* Outline-Flat.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = "Outline-Flat.png"; sourceTree = "<group>"; };
+ 445A29280BFA5C1B00E4E641 /* Outline-Flattened.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = "Outline-Flattened.png"; sourceTree = "<group>"; };
+ 445A2A5B0BFAB6A100E4E641 /* ImageAndTextCell.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = ImageAndTextCell.h; sourceTree = "<group>"; };
+ 445A2A5D0BFAB6C300E4E641 /* ImageAndTextCell.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = ImageAndTextCell.m; sourceTree = "<group>"; };
+ 449F03DE0BE00DE9003F15C8 /* Bridge.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = Bridge.h; sourceTree = "<group>"; };
+ 449F03DF0BE00DE9003F15C8 /* Bridge.m */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.objc; path = Bridge.m; sourceTree = "<group>"; };
+ 44A794A00BE16C380069680C /* ExceptionHandling.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; name = ExceptionHandling.framework; path = /System/Library/Frameworks/ExceptionHandling.framework; sourceTree = "<absolute>"; };
+ 44A797F10BE3F9B70069680C /* table-mixed.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-mixed.tif"; sourceTree = "<group>"; };
+ 44F472AF0C0DB735006428EF /* Change_Absent.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = Change_Absent.png; sourceTree = "<group>"; };
+ 44F472B00C0DB735006428EF /* Change_Unmodified.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = Change_Unmodified.png; sourceTree = "<group>"; };
+ 690F564404F11EC300CF23A4 /* ProfileController.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = ProfileController.h; sourceTree = "<group>"; };
+ 690F564504F11EC300CF23A4 /* ProfileController.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = ProfileController.m; sourceTree = "<group>"; };
+ 691CE180051BB44A00CF23A4 /* ProfileTableView.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = ProfileTableView.h; sourceTree = "<group>"; };
+ 691CE181051BB44A00CF23A4 /* ProfileTableView.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = ProfileTableView.m; sourceTree = "<group>"; };
+ 69660DC604F08CC100CF23A4 /* MyController.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = MyController.h; sourceTree = "<group>"; };
+ 69660DC704F08CC100CF23A4 /* MyController.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = MyController.m; sourceTree = "<group>"; };
+ 697985CD050CFA2D00CF23A4 /* PreferencesController.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = PreferencesController.h; sourceTree = "<group>"; };
+ 697985CE050CFA2D00CF23A4 /* PreferencesController.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = PreferencesController.m; sourceTree = "<group>"; };
+ 69BA7DA804FD695200CF23A4 /* ReconTableView.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = ReconTableView.h; sourceTree = "<group>"; };
+ 69BA7DA904FD695200CF23A4 /* ReconTableView.m */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.objc; path = ReconTableView.m; sourceTree = "<group>"; };
+ 69C625CA0664E94E00B3C46A /* Unison.icns */ = {isa = PBXFileReference; lastKnownFileType = image.icns; path = Unison.icns; sourceTree = "<group>"; };
+ 69C625F40664EC3300B3C46A /* Info.plist */ = {isa = PBXFileReference; lastKnownFileType = text.plist.xml; path = Info.plist; sourceTree = "<group>"; };
+ 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 = "<group>"; };
+ 69D3C6FA04F1CC3700CF23A4 /* ReconItem.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = ReconItem.h; sourceTree = "<group>"; };
+ 69E407B907EB95AA00D37AA1 /* Security.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; name = Security.framework; path = /System/Library/Frameworks/Security.framework; sourceTree = "<absolute>"; };
+ B518071209D6652100B1B21F /* add.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = add.tif; sourceTree = "<group>"; };
+ B518071309D6652100B1B21F /* diff.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = diff.tif; sourceTree = "<group>"; };
+ B518071409D6652100B1B21F /* go.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = go.tif; sourceTree = "<group>"; };
+ B518071509D6652100B1B21F /* left.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = left.tif; sourceTree = "<group>"; };
+ B518071609D6652100B1B21F /* merge.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = merge.tif; sourceTree = "<group>"; };
+ B518071709D6652100B1B21F /* quit.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = quit.tif; sourceTree = "<group>"; };
+ B518071809D6652100B1B21F /* restart.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = restart.tif; sourceTree = "<group>"; };
+ B518071909D6652100B1B21F /* right.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = right.tif; sourceTree = "<group>"; };
+ B518071A09D6652100B1B21F /* save.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = save.tif; sourceTree = "<group>"; };
+ B518071B09D6652100B1B21F /* skip.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = skip.tif; sourceTree = "<group>"; };
+ B554003E09C4E5A00089E1C3 /* UnisonToolbar.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; path = UnisonToolbar.h; sourceTree = "<group>"; };
+ B554004009C4E5AA0089E1C3 /* UnisonToolbar.m */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.objc; path = UnisonToolbar.m; sourceTree = "<group>"; };
+ B5B44C1109DF61A4000DC7AF /* table-conflict.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-conflict.tif"; sourceTree = "<group>"; };
+ B5B44C1209DF61A4000DC7AF /* table-error.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-error.tif"; sourceTree = "<group>"; };
+ B5B44C1309DF61A4000DC7AF /* table-left-blue.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-left-blue.tif"; sourceTree = "<group>"; };
+ B5B44C1409DF61A4000DC7AF /* table-left-green.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-left-green.tif"; sourceTree = "<group>"; };
+ B5B44C1509DF61A4000DC7AF /* table-merge.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-merge.tif"; sourceTree = "<group>"; };
+ B5B44C1609DF61A4000DC7AF /* table-right-blue.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-right-blue.tif"; sourceTree = "<group>"; };
+ B5B44C1709DF61A4000DC7AF /* table-right-green.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-right-green.tif"; sourceTree = "<group>"; };
+ B5B44C1809DF61A4000DC7AF /* table-skip.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = "table-skip.tif"; sourceTree = "<group>"; };
+ B5E03B3809E38B9E0058C7B9 /* rescan.tif */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; name = rescan.tif; path = toolbar/rescan.tif; sourceTree = "<group>"; };
+/* 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 = "<group>";
+ };
+ 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 = "<group>";
+ };
+ 29B97315FDCFA39411CA2CEA /* Other Sources */ = {
+ isa = PBXGroup;
+ children = (
+ 29B97316FDCFA39411CA2CEA /* main.m */,
+ );
+ name = "Other Sources";
+ sourceTree = "<group>";
+ };
+ 29B97317FDCFA39411CA2CEA /* Resources */ = {
+ isa = PBXGroup;
+ children = (
+ 29B97318FDCFA39411CA2CEA /* MainMenu.nib */,
+ 089C165CFE840E0CC02AAC07 /* InfoPlist.strings */,
+ 69C625CA0664E94E00B3C46A /* Unison.icns */,
+ );
+ name = Resources;
+ sourceTree = "<group>";
+ };
+ 29B97323FDCFA39411CA2CEA /* Frameworks */ = {
+ isa = PBXGroup;
+ children = (
+ 1058C7A1FEA54F0111CA2CBB /* Cocoa.framework */,
+ 44A794A00BE16C380069680C /* ExceptionHandling.framework */,
+ 2A3C3F3209922A8000E404E9 /* Growl.framework */,
+ 69E407B907EB95AA00D37AA1 /* Security.framework */,
+ );
+ name = Frameworks;
+ sourceTree = "<group>";
+ };
+ 2E282CB80D9AE16300439D01 /* External objects */ = {
+ isa = PBXGroup;
+ children = (
+ 2E282CC70D9AE2B000439D01 /* unison-blob.o */,
+ );
+ name = "External objects";
+ sourceTree = "<group>";
+ };
+ 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 = "<group>";
+ };
+ 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 = "<group>";
+ };
+ 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 = "<group>";
+ };
+ 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 = "<group>";
+ };
+/* 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 = "<group>";
+ };
+ 29B97318FDCFA39411CA2CEA /* MainMenu.nib */ = {
+ isa = PBXVariantGroup;
+ children = (
+ 29B97319FDCFA39411CA2CEA /* English */,
+ );
+ name = MainMenu.nib;
+ sourceTree = "<group>";
+ };
+/* 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
- "" -> "<ret>"
- | " " -> "<spc>"
- | 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 <CR> as a default. But I got talked out of offering a default
- here, because of safety considerations (too easy to press <CR> 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 <http://www.gnu.org/licenses/>.
+*)
+
+
+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
+ "" -> "<ret>"
+ | " " -> "<spc>"
+ | 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 <CR> as a default. But I got talked out of offering a default
+ here, because of safety considerations (too easy to press <CR> 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 `<a> ->
- <b>' *)
-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 <http://www.gnu.org/licenses/>.
+*)
+
+
+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 `<a> ->
+ <b>' *)
+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 "<dummy>" 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 <http://www.gnu.org/licenses/>.
+*)
+
+
+(*****************************************************************************)
+(* 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 "<dummy>" 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 <http://www.gnu.org/licenses/>.
+*)
+
+
+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
More information about the Unison-hackers
mailing list