unison-2.32.52/0000755000076500000000000000000011222164527012634 5ustar bcpiercewheelunison-2.32.52/.depend0000644000076500000000000004043211207765162014104 0ustar bcpiercewheelabort.cmi: uutil.cmi bytearray.cmi: case.cmi: checksum.cmi: clroot.cmi: common.cmi: uutil.cmi props.cmi path.cmi osx.cmi os.cmi name.cmi fspath.cmi \ fileinfo.cmi copy.cmi: uutil.cmi props.cmi path.cmi osx.cmi os.cmi lwt/lwt.cmi fspath.cmi \ common.cmi external.cmi: fileinfo.cmi: props.cmi path.cmi osx.cmi fspath.cmi files.cmi: uutil.cmi props.cmi path.cmi lwt/lwt_util.cmi lwt/lwt.cmi \ common.cmi fileutil.cmi: fingerprint.cmi: uutil.cmi path.cmi fspath.cmi fspath.cmi: path.cmi name.cmi globals.cmi: ubase/prefs.cmi path.cmi lwt/lwt.cmi common.cmi lock.cmi: name.cmi: os.cmi: props.cmi path.cmi name.cmi fspath.cmi fileinfo.cmi osx.cmi: uutil.cmi ubase/prefs.cmi path.cmi fspath.cmi fingerprint.cmi path.cmi: name.cmi pred.cmi: props.cmi: uutil.cmi ubase/prefs.cmi path.cmi osx.cmi fspath.cmi recon.cmi: path.cmi common.cmi remote.cmi: ubase/prefs.cmi lwt/lwt.cmi fspath.cmi common.cmi clroot.cmi \ bytearray.cmi sortri.cmi: common.cmi stasher.cmi: ubase/prefs.cmi path.cmi os.cmi fspath.cmi strings.cmi: terminal.cmi: test.cmi: transfer.cmi: uutil.cmi lwt/lwt.cmi bytearray.cmi transport.cmi: uutil.cmi lwt/lwt.cmi common.cmi tree.cmi: uicommon.cmi: uutil.cmi ubase/prefs.cmi path.cmi lwt/lwt.cmi common.cmi uigtk2.cmi: uicommon.cmi uigtk.cmi: uicommon.cmi ui.cmi: uitext.cmi: uicommon.cmi update.cmi: tree.cmi props.cmi path.cmi osx.cmi os.cmi name.cmi lwt/lwt.cmi \ fspath.cmi fileinfo.cmi common.cmi uutil.cmi: xferhint.cmi: ubase/prefs.cmi path.cmi os.cmi fspath.cmi abort.cmo: uutil.cmi ubase/util.cmi ubase/trace.cmi ubase/safelist.cmi \ abort.cmi abort.cmx: uutil.cmx ubase/util.cmx ubase/trace.cmx ubase/safelist.cmx \ abort.cmi bytearray.cmo: bytearray.cmi bytearray.cmx: bytearray.cmi case.cmo: ubase/prefs.cmi case.cmi case.cmx: ubase/prefs.cmx case.cmi checksum.cmo: checksum.cmi checksum.cmx: checksum.cmi clroot.cmo: ubase/util.cmi ubase/rx.cmi ubase/prefs.cmi clroot.cmi clroot.cmx: ubase/util.cmx ubase/rx.cmx ubase/prefs.cmx clroot.cmi common.cmo: uutil.cmi ubase/util.cmi ubase/safelist.cmi props.cmi path.cmi \ osx.cmi os.cmi name.cmi fspath.cmi fileinfo.cmi common.cmi common.cmx: uutil.cmx ubase/util.cmx ubase/safelist.cmx props.cmx path.cmx \ osx.cmx os.cmx name.cmx fspath.cmx fileinfo.cmx common.cmi copy.cmo: xferhint.cmi uutil.cmi ubase/util.cmi transfer.cmi ubase/trace.cmi \ ubase/safelist.cmi remote.cmi props.cmi ubase/prefs.cmi path.cmi osx.cmi \ os.cmi lwt/lwt_util.cmi lwt/lwt.cmi globals.cmi fspath.cmi fileinfo.cmi \ external.cmi common.cmi clroot.cmi bytearray.cmi abort.cmi copy.cmi copy.cmx: xferhint.cmx uutil.cmx ubase/util.cmx transfer.cmx ubase/trace.cmx \ ubase/safelist.cmx remote.cmx props.cmx ubase/prefs.cmx path.cmx osx.cmx \ os.cmx lwt/lwt_util.cmx lwt/lwt.cmx globals.cmx fspath.cmx fileinfo.cmx \ external.cmx common.cmx clroot.cmx bytearray.cmx abort.cmx copy.cmi external.cmo: ubase/util.cmi ubase/safelist.cmi lwt/lwt_util.cmi \ lwt/lwt_unix.cmi lwt/lwt.cmi external.cmi external.cmx: ubase/util.cmx ubase/safelist.cmx lwt/lwt_util.cmx \ lwt/lwt_unix.cmx lwt/lwt.cmx external.cmi fileinfo.cmo: ubase/util.cmi props.cmi ubase/prefs.cmi path.cmi osx.cmi \ fspath.cmi fileinfo.cmi fileinfo.cmx: ubase/util.cmx props.cmx ubase/prefs.cmx path.cmx osx.cmx \ fspath.cmx fileinfo.cmi files.cmo: uutil.cmi ubase/util.cmi update.cmi ubase/trace.cmi stasher.cmi \ ubase/safelist.cmi ubase/rx.cmi remote.cmi props.cmi ubase/prefs.cmi \ path.cmi osx.cmi os.cmi lwt/lwt_util.cmi lwt/lwt_unix.cmi lwt/lwt.cmi \ globals.cmi fspath.cmi fingerprint.cmi fileinfo.cmi external.cmi copy.cmi \ common.cmi abort.cmi files.cmi files.cmx: uutil.cmx ubase/util.cmx update.cmx ubase/trace.cmx stasher.cmx \ ubase/safelist.cmx ubase/rx.cmx remote.cmx props.cmx ubase/prefs.cmx \ path.cmx osx.cmx os.cmx lwt/lwt_util.cmx lwt/lwt_unix.cmx lwt/lwt.cmx \ globals.cmx fspath.cmx fingerprint.cmx fileinfo.cmx external.cmx copy.cmx \ common.cmx abort.cmx files.cmi fileutil.cmo: fileutil.cmi fileutil.cmx: fileutil.cmi fingerprint.cmo: uutil.cmi ubase/util.cmi fspath.cmi fingerprint.cmi fingerprint.cmx: uutil.cmx ubase/util.cmx fspath.cmx fingerprint.cmi fspath.cmo: ubase/util.cmi ubase/rx.cmi path.cmi name.cmi fileutil.cmi \ fspath.cmi fspath.cmx: ubase/util.cmx ubase/rx.cmx path.cmx name.cmx fileutil.cmx \ fspath.cmi globals.cmo: ubase/util.cmi ubase/trace.cmi ubase/safelist.cmi remote.cmi \ ubase/prefs.cmi pred.cmi path.cmi os.cmi name.cmi lwt/lwt_util.cmi \ lwt/lwt_unix.cmi lwt/lwt.cmi common.cmi clroot.cmi globals.cmi globals.cmx: ubase/util.cmx ubase/trace.cmx ubase/safelist.cmx remote.cmx \ ubase/prefs.cmx pred.cmx path.cmx os.cmx name.cmx lwt/lwt_util.cmx \ lwt/lwt_unix.cmx lwt/lwt.cmx common.cmx clroot.cmx globals.cmi linkgtk2.cmo: uigtk2.cmi main.cmo linkgtk2.cmx: uigtk2.cmx main.cmx linkgtk.cmo: uigtk.cmi main.cmo linkgtk.cmx: uigtk.cmx main.cmx linktext.cmo: uitext.cmi main.cmo linktext.cmx: uitext.cmx main.cmx linktk.cmo: main.cmo linktk.cmx: main.cmx lock.cmo: ubase/util.cmi lock.cmi lock.cmx: ubase/util.cmx lock.cmi main.cmo: uutil.cmi ubase/util.cmi uitext.cmi uicommon.cmi strings.cmi \ ubase/safelist.cmi remote.cmi ubase/prefs.cmi os.cmi fspath.cmi main.cmx: uutil.cmx ubase/util.cmx uitext.cmx uicommon.cmx strings.cmx \ ubase/safelist.cmx remote.cmx ubase/prefs.cmx os.cmx fspath.cmx mkProjectInfo.cmo: mkProjectInfo.cmx: name.cmo: ubase/util.cmi case.cmi name.cmi name.cmx: ubase/util.cmx case.cmx name.cmi os.cmo: uutil.cmi ubase/util.cmi ubase/safelist.cmi props.cmi ubase/prefs.cmi \ path.cmi osx.cmi name.cmi fspath.cmi fingerprint.cmi fileinfo.cmi os.cmi os.cmx: uutil.cmx ubase/util.cmx ubase/safelist.cmx props.cmx ubase/prefs.cmx \ path.cmx osx.cmx name.cmx fspath.cmx fingerprint.cmx fileinfo.cmx os.cmi osx.cmo: uutil.cmi ubase/util.cmi ubase/safelist.cmi ubase/prefs.cmi path.cmi \ name.cmi fspath.cmi fingerprint.cmi osx.cmi osx.cmx: uutil.cmx ubase/util.cmx ubase/safelist.cmx ubase/prefs.cmx path.cmx \ name.cmx fspath.cmx fingerprint.cmx osx.cmi path.cmo: ubase/util.cmi ubase/safelist.cmi ubase/rx.cmi pred.cmi name.cmi \ fileutil.cmi case.cmi path.cmi path.cmx: ubase/util.cmx ubase/safelist.cmx ubase/rx.cmx pred.cmx name.cmx \ fileutil.cmx case.cmx path.cmi pixmaps.cmo: pixmaps.cmx: pred.cmo: ubase/util.cmi ubase/safelist.cmi ubase/rx.cmi ubase/prefs.cmi \ case.cmi pred.cmi pred.cmx: ubase/util.cmx ubase/safelist.cmx ubase/rx.cmx ubase/prefs.cmx \ case.cmx pred.cmi props.cmo: uutil.cmi ubase/util.cmi ubase/prefs.cmi path.cmi osx.cmi \ fspath.cmi external.cmi props.cmi props.cmx: uutil.cmx ubase/util.cmx ubase/prefs.cmx path.cmx osx.cmx \ fspath.cmx external.cmx props.cmi recon.cmo: ubase/util.cmi update.cmi tree.cmi ubase/trace.cmi sortri.cmi \ ubase/safelist.cmi props.cmi ubase/prefs.cmi pred.cmi path.cmi name.cmi \ globals.cmi fileinfo.cmi common.cmi recon.cmi recon.cmx: ubase/util.cmx update.cmx tree.cmx ubase/trace.cmx sortri.cmx \ ubase/safelist.cmx props.cmx ubase/prefs.cmx pred.cmx path.cmx name.cmx \ globals.cmx fileinfo.cmx common.cmx recon.cmi remote.cmo: uutil.cmi ubase/util.cmi ubase/trace.cmi terminal.cmi \ ubase/safelist.cmi ubase/prefs.cmi os.cmi lwt/lwt_unix.cmi lwt/lwt.cmi \ fspath.cmi common.cmi clroot.cmi bytearray.cmi remote.cmi remote.cmx: uutil.cmx ubase/util.cmx ubase/trace.cmx terminal.cmx \ ubase/safelist.cmx ubase/prefs.cmx os.cmx lwt/lwt_unix.cmx lwt/lwt.cmx \ fspath.cmx common.cmx clroot.cmx bytearray.cmx remote.cmi sortri.cmo: ubase/util.cmi ubase/safelist.cmi ubase/prefs.cmi pred.cmi \ path.cmi common.cmi sortri.cmi sortri.cmx: ubase/util.cmx ubase/safelist.cmx ubase/prefs.cmx pred.cmx \ path.cmx common.cmx sortri.cmi stasher.cmo: ubase/util.cmi ubase/safelist.cmi remote.cmi props.cmi \ ubase/prefs.cmi pred.cmi path.cmi osx.cmi os.cmi lwt/lwt_unix.cmi \ lwt/lwt.cmi globals.cmi fspath.cmi fingerprint.cmi fileutil.cmi \ fileinfo.cmi copy.cmi common.cmi stasher.cmi stasher.cmx: ubase/util.cmx ubase/safelist.cmx remote.cmx props.cmx \ ubase/prefs.cmx pred.cmx path.cmx osx.cmx os.cmx lwt/lwt_unix.cmx \ lwt/lwt.cmx globals.cmx fspath.cmx fingerprint.cmx fileutil.cmx \ fileinfo.cmx copy.cmx common.cmx stasher.cmi strings.cmo: strings.cmi strings.cmx: strings.cmi terminal.cmo: ubase/safelist.cmi ubase/rx.cmi lwt/lwt_unix.cmi lwt/lwt.cmi \ terminal.cmi terminal.cmx: ubase/safelist.cmx ubase/rx.cmx lwt/lwt_unix.cmx lwt/lwt.cmx \ terminal.cmi test.cmo: uutil.cmi ubase/util.cmi update.cmi uicommon.cmi transport.cmi \ ubase/trace.cmi stasher.cmi ubase/safelist.cmi remote.cmi recon.cmi \ ubase/prefs.cmi path.cmi os.cmi lwt/lwt_util.cmi lwt/lwt_unix.cmi \ lwt/lwt.cmi globals.cmi fspath.cmi fingerprint.cmi common.cmi test.cmi test.cmx: uutil.cmx ubase/util.cmx update.cmx uicommon.cmx transport.cmx \ ubase/trace.cmx stasher.cmx ubase/safelist.cmx remote.cmx recon.cmx \ ubase/prefs.cmx path.cmx os.cmx lwt/lwt_util.cmx lwt/lwt_unix.cmx \ lwt/lwt.cmx globals.cmx fspath.cmx fingerprint.cmx common.cmx test.cmi transfer.cmo: uutil.cmi ubase/util.cmi ubase/trace.cmi ubase/safelist.cmi \ lwt/lwt.cmi checksum.cmi bytearray.cmi transfer.cmi transfer.cmx: uutil.cmx ubase/util.cmx ubase/trace.cmx ubase/safelist.cmx \ lwt/lwt.cmx checksum.cmx bytearray.cmx transfer.cmi transport.cmo: uutil.cmi ubase/util.cmi update.cmi ubase/trace.cmi \ stasher.cmi remote.cmi props.cmi ubase/prefs.cmi path.cmi osx.cmi \ lwt/lwt_util.cmi lwt/lwt.cmi globals.cmi files.cmi common.cmi abort.cmi \ transport.cmi transport.cmx: uutil.cmx ubase/util.cmx update.cmx ubase/trace.cmx \ stasher.cmx remote.cmx props.cmx ubase/prefs.cmx path.cmx osx.cmx \ lwt/lwt_util.cmx lwt/lwt.cmx globals.cmx files.cmx common.cmx abort.cmx \ transport.cmi tree.cmo: ubase/safelist.cmi tree.cmi tree.cmx: ubase/safelist.cmx tree.cmi uicommon.cmo: xferhint.cmi uutil.cmi ubase/util.cmi update.cmi \ ubase/trace.cmi stasher.cmi ubase/safelist.cmi remote.cmi recon.cmi \ props.cmi ubase/prefs.cmi path.cmi osx.cmi os.cmi name.cmi \ lwt/lwt_unix.cmi lwt/lwt.cmi globals.cmi fspath.cmi files.cmi \ fileinfo.cmi common.cmi clroot.cmi case.cmi uicommon.cmi uicommon.cmx: xferhint.cmx uutil.cmx ubase/util.cmx update.cmx \ ubase/trace.cmx stasher.cmx ubase/safelist.cmx remote.cmx recon.cmx \ props.cmx ubase/prefs.cmx path.cmx osx.cmx os.cmx name.cmx \ lwt/lwt_unix.cmx lwt/lwt.cmx globals.cmx fspath.cmx files.cmx \ fileinfo.cmx common.cmx clroot.cmx case.cmx uicommon.cmi uigtk2.cmo: uutil.cmi ubase/util.cmi update.cmi uitext.cmi uicommon.cmi \ transport.cmi ubase/trace.cmi strings.cmi sortri.cmi ubase/safelist.cmi \ remote.cmi recon.cmi ubase/prefs.cmi pixmaps.cmo path.cmi os.cmi \ lwt/lwt_util.cmi lwt/lwt_unix.cmi lwt/lwt.cmi globals.cmi fspath.cmi \ files.cmi common.cmi clroot.cmi uigtk2.cmi uigtk2.cmx: uutil.cmx ubase/util.cmx update.cmx uitext.cmx uicommon.cmx \ transport.cmx ubase/trace.cmx strings.cmx sortri.cmx ubase/safelist.cmx \ remote.cmx recon.cmx ubase/prefs.cmx pixmaps.cmx path.cmx os.cmx \ lwt/lwt_util.cmx lwt/lwt_unix.cmx lwt/lwt.cmx globals.cmx fspath.cmx \ files.cmx common.cmx clroot.cmx uigtk2.cmi uigtk.cmo: uutil.cmi ubase/util.cmi update.cmi uitext.cmi uicommon.cmi \ transport.cmi ubase/trace.cmi strings.cmi sortri.cmi ubase/safelist.cmi \ remote.cmi recon.cmi ubase/prefs.cmi pixmaps.cmo path.cmi os.cmi \ lwt/lwt_util.cmi lwt/lwt_unix.cmi lwt/lwt.cmi globals.cmi fspath.cmi \ files.cmi common.cmi clroot.cmi uigtk.cmi uigtk.cmx: uutil.cmx ubase/util.cmx update.cmx uitext.cmx uicommon.cmx \ transport.cmx ubase/trace.cmx strings.cmx sortri.cmx ubase/safelist.cmx \ remote.cmx recon.cmx ubase/prefs.cmx pixmaps.cmx path.cmx os.cmx \ lwt/lwt_util.cmx lwt/lwt_unix.cmx lwt/lwt.cmx globals.cmx fspath.cmx \ files.cmx common.cmx clroot.cmx uigtk.cmi uimacbridge.cmo: xferhint.cmi uutil.cmi ubase/util.cmi update.cmi \ uicommon.cmi transport.cmi ubase/trace.cmi terminal.cmi stasher.cmi \ ubase/safelist.cmi remote.cmi recon.cmi ubase/prefs.cmi path.cmi os.cmi \ main.cmo lwt/lwt_util.cmi lwt/lwt_unix.cmi lwt/lwt.cmi globals.cmi \ fspath.cmi files.cmi common.cmi clroot.cmi uimacbridge.cmx: xferhint.cmx uutil.cmx ubase/util.cmx update.cmx \ uicommon.cmx transport.cmx ubase/trace.cmx terminal.cmx stasher.cmx \ ubase/safelist.cmx remote.cmx recon.cmx ubase/prefs.cmx path.cmx os.cmx \ main.cmx lwt/lwt_util.cmx lwt/lwt_unix.cmx lwt/lwt.cmx globals.cmx \ fspath.cmx files.cmx common.cmx clroot.cmx uimacbridgenew.cmo: xferhint.cmi uutil.cmi ubase/util.cmi update.cmi \ uicommon.cmi transport.cmi ubase/trace.cmi terminal.cmi stasher.cmi \ ubase/safelist.cmi remote.cmi recon.cmi ubase/prefs.cmi path.cmi os.cmi \ main.cmo lwt/lwt_util.cmi lwt/lwt_unix.cmi lwt/lwt.cmi globals.cmi \ fspath.cmi files.cmi common.cmi clroot.cmi uimacbridgenew.cmx: xferhint.cmx uutil.cmx ubase/util.cmx update.cmx \ uicommon.cmx transport.cmx ubase/trace.cmx terminal.cmx stasher.cmx \ ubase/safelist.cmx remote.cmx recon.cmx ubase/prefs.cmx path.cmx os.cmx \ main.cmx lwt/lwt_util.cmx lwt/lwt_unix.cmx lwt/lwt.cmx globals.cmx \ fspath.cmx files.cmx common.cmx clroot.cmx uitext.cmo: uutil.cmi ubase/util.cmi update.cmi uicommon.cmi transport.cmi \ ubase/trace.cmi ubase/safelist.cmi remote.cmi recon.cmi ubase/prefs.cmi \ path.cmi lwt/lwt_util.cmi lwt/lwt_unix.cmi lwt/lwt.cmi globals.cmi \ common.cmi uitext.cmi uitext.cmx: uutil.cmx ubase/util.cmx update.cmx uicommon.cmx transport.cmx \ ubase/trace.cmx ubase/safelist.cmx remote.cmx recon.cmx ubase/prefs.cmx \ path.cmx lwt/lwt_util.cmx lwt/lwt_unix.cmx lwt/lwt.cmx globals.cmx \ common.cmx uitext.cmi update.cmo: xferhint.cmi uutil.cmi ubase/util.cmi tree.cmi ubase/trace.cmi \ stasher.cmi ubase/safelist.cmi ubase/rx.cmi remote.cmi props.cmi \ ubase/prefs.cmi pred.cmi path.cmi osx.cmi os.cmi name.cmi ubase/myMap.cmi \ lwt/lwt_unix.cmi lwt/lwt.cmi lock.cmi globals.cmi fspath.cmi \ fingerprint.cmi fileinfo.cmi external.cmi common.cmi case.cmi update.cmi update.cmx: xferhint.cmx uutil.cmx ubase/util.cmx tree.cmx ubase/trace.cmx \ stasher.cmx ubase/safelist.cmx ubase/rx.cmx remote.cmx props.cmx \ ubase/prefs.cmx pred.cmx path.cmx osx.cmx os.cmx name.cmx ubase/myMap.cmx \ lwt/lwt_unix.cmx lwt/lwt.cmx lock.cmx globals.cmx fspath.cmx \ fingerprint.cmx fileinfo.cmx external.cmx common.cmx case.cmx update.cmi uutil.cmo: ubase/util.cmi ubase/trace.cmi ubase/projectInfo.cmo uutil.cmi uutil.cmx: ubase/util.cmx ubase/trace.cmx ubase/projectInfo.cmx uutil.cmi xferhint.cmo: ubase/util.cmi ubase/trace.cmi ubase/prefs.cmi path.cmi os.cmi \ fspath.cmi xferhint.cmi xferhint.cmx: ubase/util.cmx ubase/trace.cmx ubase/prefs.cmx path.cmx os.cmx \ fspath.cmx xferhint.cmi lwt/lwt.cmo: lwt/lwt.cmi lwt/lwt.cmx: lwt/lwt.cmi lwt/lwt_unix.cmo: lwt/pqueue.cmi lwt/lwt.cmi lwt/lwt_unix.cmi lwt/lwt_unix.cmx: lwt/pqueue.cmx lwt/lwt.cmx lwt/lwt_unix.cmi lwt/lwt_util.cmo: lwt/lwt.cmi lwt/lwt_util.cmi lwt/lwt_util.cmx: lwt/lwt.cmx lwt/lwt_util.cmi lwt/pqueue.cmo: lwt/pqueue.cmi lwt/pqueue.cmx: lwt/pqueue.cmi ubase/myMap.cmo: ubase/myMap.cmi ubase/myMap.cmx: ubase/myMap.cmi ubase/prefs.cmo: ubase/util.cmi ubase/uarg.cmi ubase/safelist.cmi \ ubase/prefs.cmi ubase/prefs.cmx: ubase/util.cmx ubase/uarg.cmx ubase/safelist.cmx \ ubase/prefs.cmi ubase/projectInfo.cmo: ubase/projectInfo.cmx: ubase/rx.cmo: ubase/rx.cmi ubase/rx.cmx: ubase/rx.cmi ubase/safelist.cmo: ubase/safelist.cmi ubase/safelist.cmx: ubase/safelist.cmi ubase/trace.cmo: ubase/util.cmi ubase/safelist.cmi ubase/prefs.cmi \ ubase/trace.cmi ubase/trace.cmx: ubase/util.cmx ubase/safelist.cmx ubase/prefs.cmx \ ubase/trace.cmi ubase/uarg.cmo: ubase/util.cmi ubase/safelist.cmi ubase/uarg.cmi ubase/uarg.cmx: ubase/util.cmx ubase/safelist.cmx ubase/uarg.cmi ubase/uprintf.cmo: ubase/uprintf.cmi ubase/uprintf.cmx: ubase/uprintf.cmi ubase/util.cmo: ubase/uprintf.cmi ubase/safelist.cmi ubase/util.cmi ubase/util.cmx: ubase/uprintf.cmx ubase/safelist.cmx ubase/util.cmi lwt/lwt.cmi: lwt/lwt_unix.cmi: lwt/lwt.cmi lwt/lwt_util.cmi: lwt/lwt.cmi lwt/pqueue.cmi: ubase/myMap.cmi: ubase/prefs.cmi: ubase/util.cmi ubase/rx.cmi: ubase/safelist.cmi: ubase/trace.cmi: ubase/prefs.cmi ubase/uarg.cmi: ubase/uprintf.cmi: ubase/util.cmi: unison-2.32.52/abort.ml0000644000076500000000000000256011176730177014310 0ustar bcpiercewheel(* Unison file synchronizer: src/abort.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) let debug = Trace.debug "abort" let files = ref ([] : Uutil.File.t list) let abortAll = ref false (****) let reset () = files := []; abortAll := false (****) let file id = debug (fun() -> Util.msg "Aborting line %s\n" (Uutil.File.toString id)); files := id :: !files let all () = abortAll := true (****) let check id = debug (fun() -> Util.msg "Checking line %s\n" (Uutil.File.toString id)); if !abortAll || Safelist.mem id !files then begin debug (fun() -> Util.msg "Abort failure for line %s\n" (Uutil.File.toString id)); raise (Util.Transient "Aborted") end let testException e = e = Util.Transient "Aborted" unison-2.32.52/abort.mli0000644000076500000000000000072611176730177014463 0ustar bcpiercewheel (* Clear the list of aborted item. *) val reset : unit -> unit (* Abort transfer for either one particular item or all items. *) (* These functions should only be called on the client. *) val file : Uutil.File.t -> unit val all : unit -> unit (* Check whether an item is being aborted. A transient exception is raised if this is the case. *) val check : Uutil.File.t -> unit (* Test whether the exeption is an abort exception. *) val testException : exn -> bool unison-2.32.52/BUGS.txt0000644000076500000000000003413211176730177014150 0ustar bcpiercewheel OUTSTANDING UNISON BUGS ======================= SHOWSTOPPERS ============ Mac OSX, Windows XP: - Unison does not understand extended attributes (OSX) or alternate data streams (XP) and will not synchronize them properly. Linux, Solaris: - None known. --------------------------------------------------------------------------- SERIOUS ======= [June 2006, Schmitt and Newton] Alan said: I realized yesterday that I had xferbycopying set to false, so I turned it back on. However some automatic unison synchronization failed last night, with the message: > Shortcut: copying 1148507176.26619_0.top.inrialpes.fr:2,ST from > local file Maildir/.Caml/cur/1148507176.26619_0.top.inrialpes.fr:2, > Uncaught exception Not_found > Fatal error: Lost connection with the server Ryan Newton later sent BCP a debug trace showing this happening, but it did not elucidate the problem. For the moment, I've (BCP) just protected the tryCopyMovedFile function with a call to convertUnixErrorsToTransient, which should help if the Not_found is being raised from there. (In the debug trace, we see "success" printed by this function and then the crash. An obvious culprit is the call to Xferhint.insert, but my reading of the code is that this should not fail.) [June 2006, Jim] By the way, there is a bug if you are doing a merge and are propagating times, the times of the merged file end up different so you have to sync again. I guess this might be a feature, I don't know which way to propagate the times... ==> Best to make them both equal to the time of merging [May 2006, Schmitt] In presence of path that cannot be propagated, Unison may have a fatal error "archives not identical". Here is the setting: replica A: tmp/ubug/foo tmp/toto/foo replica B: tmp/ profile: root = /Users/schmitta/tmp root = ssh://beauty/tmp # common options sshargs = -C servercmd = bin/unison path = ubug/foo path = toto The run: (* message that there are no archive *) local beauty.local error ubug/foo path ubug/foo is not valid because ubug is not a directory in one of the replicas dir ----> toto [f] Proceed with propagating updates? [] y Propagating updates UNISON 2.19.2 started propagating changes at 17:40:47 on 30 May 2006 [ERROR] Skipping ubug/foo path ubug/foo is not valid because ubug is not a directory in one of the replicas [BGN] Copying toto from /Users/schmitta/tmp to //beauty.local//Users/schmitta/tmp [END] Copying toto UNISON 2.19.2 finished propagating changes at 17:40:47 on 30 May 2006 Saving synchronizer state Dumping archives to ~/unison.dump on both hosts Finished dumping archives Fatal error: Internal error: New archives are not identical. Retaining original archives. Please run Unison again to bring them up to date. ===> This one was recently [March 07] fixed by Jerome [July 2002, Findler] I get this message from unison: Fatal error: Internal error: New archives are not identical. Retaining original archives. Please run Unison again to bring them up to date. If you get this message again, please notify unison-help@cis.upenn.edu. and I think that I know what's going wrong. Unison is somehow using a key consisting of the result of `hostname' (and maybe other stuff) to uniquely identify an archive. I have two macos x machine and I use both of them to sync to a third (solaris) place. The problem seems to be that unison can't tell the difference between two macos x machines, since the default setup under macos x always gives the hostname "localhost". -- So, I wonder if there is some other way to distinguish the two hostnames. Things that come to mind: ip addresses (but that can be bad if the machine moves around), ethernet addresses (but my laptop has two of them -- still better than ip addresses, I think) or perhaps some macos-specific mechanism for getting the macos name of the computer. -- For now, I've just changed the result of `hostname' on one of my machines, but I just made up something that no DNS server agrees with, so that might cause me trouble down the line, I'd bet. ===> We should use some more information to make sure the archive names are unique enough. But what, exactly? [Aug 2002] OSX native filesystems are case insensitive, like Windows, but Unison does not currently recognize this. A workaround is to set the 'ignorecase' preference explicitly to true. [July 2002] Unison does not understand Windows' non-Latin character set encodings. For some other character sets (e.g. European characters such as u-umlaut), only the display is affected. For character sets that use multi-byte encoding schemes (e.g. Japanese), Unison can actually get confused and synchronize incorrectly. (One case where this can happen is if the second byte of a two-byte character is actually a slash!) ==> This would be hard to fix, given OCaml's current poor support for localization. Jacques Garrigue made some suggestions (bcp has them in a mail message) that might be the basis for looking at this if someone is really motivated, but they look like real work. ==> The right think to do is to use the Windows Unicode API [APril 2002, Jason Eisner] Recently I found an aliasing problem that may endanger Unison's semantics. -- The problem is with the "follow" directive, which is documented like this: "Including the preference -follow causes Unison to treat symbolic links matching as 'invisible' and behave as if the thing pointed to by the link had appeared literally at this place in the replica." -- If one of these invisible (elsewhere called "transparent") symlinks points outside the replica, all is well and good. But if it points to something in the replica, then Unison now has two names for the same file. It doesn't currently detect the aliasing. As a result, it keeps separate information for the two names in the archive files. [A long example is in a mailmessage in BCP's files] [April 2002] File times are reported incorrectly under Win32 after a switch to/from daylight saving time. Here is a link, to shed some light on why this might be happening: http://www.codeproject.com/datetime/dstbugs.asp FIXED (a difference of exactly one hour is ignored) starting Unison on two non-existent local directories leads to an assertion failure in path.ml --------------------------------------------------------------------------- MINOR ===== Sascha Kuzins [July 2002] The server crashes everytime the client is finished. "Fatal Error: Error in waiting on port: " "The network name is not available anymore" (rough translation from German) I use Unison on two XP Professional machines, German versions, with the simple tcp connection. Andy Starrer [Aug 2002] After connecting to server and trying to do first original sync with empty client dir, the server searches a while and then shows a dialog: -- Uncaught exception File "/usr/ports/net/unison/work/unison-2.9.1/path.ml, line 0, characters 1785-1797: Assertion failed -- using an awk line & char numbering print, these char #s in path.ml fall on the "assert false" on line 69 (first line of file shows char count of 0) -- 66 1707 let parent path = 67 1725 match rtl path with 68 1747 RTL(_::p) -> RTL(p) 69 1771 | RTL [] -> assert false 70 1798 | LTR _ -> assert false -- ===> Who is calling parent on an empty path??? Another report of the same (?) bug by Ruslan Ermolov: Attempting to symlink ~/.unison/backup to another (real) directory results in the following uncaught exception: -- : $ ls -ld ~/.unison/*backup : lrwx------ 1 ru sunbay 10 Aug 6 15:22 /home/ru/.unison/backup -> realbackup : drwx------ 2 ru sunbay 512 Aug 6 15:22 /home/ru/.unison/realbackup : $ unison -batch -backup='Name *' /tmp/replica1 /tmp/replica2 : Contacting server... : Looking for changes : Reconciling changes : : replica1 replica2 : deleted ----> a : replica1 : deleted : replica2 : unchanged file : modified at 15:22 on 6 Aug, 2002 size 0 rw------- : Propagating updates : : : UNISON started propagating changes at 15:26:04 on 06 Aug 2002 : [BGN] Deleting a : from /tmp/replica2 : Uncaught exception File "/usr/ports/net/unison/work/unison-2.9.1/path.ml", line 0, characters 1785-1797: Assertion failed -- OTOH, Unison follows ~/.unison if it's symlinked, and I use this feature when using SSH as a transport. Jamey Leifer [July 2002] * [graphic ui, bug] If one of the files "has unknown type" (i.e. is a system file), then pressing "f" (i.e. "Retry on unsynchronised items") results in an error window and unison quiting. To me "Retry" implies less drastic behaviour. It should just report errors as normal. BCP [May 2002] The "rescan paths that failed previous sync" function misses some files. E.g., if a directory has failed to transfer because the disk ran out of space and I hit 'f', it will come back with "Everything is up to date", even though doing a full re-sync will again recognize the directory as needing to be transferred. Jason Eisner [April, 2002] The Merge feature does not appear to modify file times. Thus, when times=true, using the Merge feature on changed ? changed myfile turns it into props ? props myfile and to finish the sync, I have to decide which file time "wins." This differs from the behavior that I would expect and find more convenient: namely, if I perform the merge at 3pm, then it counts as a change to BOTH replicas of myfile and they should both end up with a time of 3pm. So I'd suggest that myfile in the local replica should have its modtime as well as its contents changed to that of #unisonmerged-myfile (the temporary file produced by the Merge program). Then this modtime and contents should be propagated to the remote myfile as usual, handling clock skew as for any other propagation. Other file properties should probably NOT be propagated. Unison should report a better error message when a modified file slips through the fast check and is later detected during transport. I got this C:\CygWin\home\kmoerder>unison a ssh://moerder/a kmoerder@moerder's password: C:\CygWin\home\kmoerder>Fatal error: Error in grabbing: Broken pipe [read()] This should be caught and reported cleanly: ~/.unison> unison ~/.unison/mail Uncaught exception Invalid_argument("Os.string2name('/home/bcpierce/.unison/mail.prf' contains a '/')") dworley: Unison sometimes aborts if one of the files it is synchronizing changes during the run. Most of the time, it can step over the file correctly, but sometimes it bails out. This can be a problem in an environment where you cannot guarantee that the two filesystems are stable during the Unison run. ==> More information needed Karl Moerder: The statusdepth doesn't seem to change anything (like it is being ignored). I set it to 2 ("statusdepth = 2" in my .prf file) and got the same display as the default (setting of 1). I didn't check if the default really acted like 1, so it could be that I need to set it to a higher value. I can play with it more later if you need me to. Karl Moerder: The synchronization of modification times does not work on directories (WinNT folders) or on read-only files. I found this when I tried to synchronize mod times on an otherwise synchronized tree. It failed gracefully on these. The "[click..." message is a nice touch. ==> [Nothing we can do for read-only files; need to patch ocaml for directories...] Bob H. reported an abnormal failure during transport that apparently led to an immediate, dirty termination instead of a clean failure, trapped and properly displayed in the user interface: - on Windows (of course) - Unison was trying to propagate a file onto a file that was open in another application; in Windows, this causes an error - the error was apparently not caught in the usual way, but instead terminated Unison, leaving a DANGER.README file "After I synchronized two directories I created a new profile, which defaulted to the same directories. I synchronized again (no changes, which was fine) but the Unison program did not save the directory names in the new profile. Later attemts to use that new profile failed, of course, and further random clicking resulted in a message asking me to delete non-existent lock files. I responded by exiting the program, manually deleting the .prf file, and starting over. This is a minor bug, I suppose, the root cause of which is the failure to save the directory names in a new profile when they were copied unchanged from a previous profile and/or no files had changed in these directories -- the type of bug that can only affect a new user, and so easy to overlook in testing." The "Diff" window [under Windows] sometimes shows nothing. Does this arise from a missing "Diff" program? We should detect this case! "Hanrahan, Donald" Finally, I discovered that a preceeding "/" in a "defaultpath" entry (e.g., defaultpath=/myshare/myfolder vs. defaultpath=myshare/myfolder) seems to cause an unhandled exception (Invalid_argument <"os.string2path">) to occur. --------------------------------------------------------------------------- COSMETIC ======== Interactively adding an ignore pattern for src will not make src/RECENTNEWS immediately disappear (as it does not directly match the pattern)... [Mar 2002] When transferring by copying, copies on the remote side are not taken into account by the progress meter. progress bar calculation is not quite right -- e.g. dir sizes are not always accurate? [One needs to consider simultaneously the archive and the update to compute the size a directory (consider a directory with some updates deep inside] [also, Diff has an effect on the progress bar!] unison-2.32.52/bytearray.ml0000644000076500000000000000520211207765162015174 0ustar bcpiercewheel(* Unison file synchronizer: src/bytearray.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) open Bigarray type t = (char, int8_unsigned_elt, c_layout) Array1.t let length = Bigarray.Array1.dim let create l = Bigarray.Array1.create Bigarray.char Bigarray.c_layout l (* let unsafe_blit_from_string s i a j l = for k = 0 to l - 1 do a.{j + k} <- s.[i + k] done let unsafe_blit_to_string a i s j l = for k = 0 to l - 1 do s.[j + k] <- a.{i + k} done *) external unsafe_blit_from_string : string -> int -> t -> int -> int -> unit = "ml_blit_string_to_bigarray" "noalloc" external unsafe_blit_to_string : t -> int -> string -> int -> int -> unit = "ml_blit_bigarray_to_string" "noalloc" let to_string a = let l = length a in if l > Sys.max_string_length then invalid_arg "Bytearray.to_string" else let s = String.create l in unsafe_blit_to_string a 0 s 0 l; s let of_string s = let l = String.length s in let a = create l in unsafe_blit_from_string s 0 a 0 l; a let sub a ofs len = if ofs < 0 || len < 0 || ofs > length a - len || len > Sys.max_string_length then invalid_arg "Bytearray.sub" else begin let s = String.create len in unsafe_blit_to_string a ofs s 0 len; s end let rec prefix_rec a i a' i' l = l = 0 || (a.{i} = a'.{i'} && prefix_rec a (i + 1) a' (i' + 1) (l - 1)) let prefix a a' i = let l = length a in let l' = length a' in i <= l' - l && prefix_rec a 0 a' i l let blit_from_string s i a j l = if l < 0 || i < 0 || i > String.length s - l || j < 0 || j > length a - l then invalid_arg "Bytearray.blit_from_string" else unsafe_blit_from_string s i a j l let blit_to_string a i s j l = if l < 0 || i < 0 || i > length a - l || j < 0 || j > String.length s - l then invalid_arg "Bytearray.blit_to_string" else unsafe_blit_to_string a i s j l external marshal : 'a -> Marshal.extern_flags list -> t = "ml_marshal_to_bigarray" external unmarshal : t -> int -> 'a = "ml_unmarshal_from_bigarray" unison-2.32.52/bytearray.mli0000644000076500000000000000112311207765162015343 0ustar bcpiercewheel(* Unison file synchronizer: src/bytearray.mli *) (* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) type t = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t val create : int -> t val length : t -> int val to_string : t -> string val of_string : string -> t val sub : t -> int -> int -> string val blit_from_string : string -> int -> t -> int -> int -> unit val blit_to_string : t -> int -> string -> int -> int -> unit val prefix : t -> t -> int -> bool val marshal : 'a -> Marshal.extern_flags list -> t val unmarshal : t -> int -> 'a unison-2.32.52/bytearray_stubs.c0000644000076500000000000000227111207765162016231 0ustar bcpiercewheel/* Unison file synchronizer: src/bytearray_stubs.c */ /* Copyright 1999-2009 (see COPYING for details) */ #include #include "caml/intext.h" #include "caml/bigarray.h" CAMLprim value ml_marshal_to_bigarray(value v, value flags) { char *buf; long len; output_value_to_malloc(v, flags, &buf, &len); return alloc_bigarray(BIGARRAY_UINT8 | BIGARRAY_C_LAYOUT | BIGARRAY_MANAGED, 1, buf, &len); } #define Array_data(a, i) (((char *) a->data) + Long_val(i)) CAMLprim value ml_unmarshal_from_bigarray(value b, value ofs) { struct caml_bigarray *b_arr = Bigarray_val(b); return input_value_from_block (Array_data (b_arr, ofs), b_arr->dim[0] - Long_val(ofs)); } CAMLprim value ml_blit_string_to_bigarray (value s, value i, value a, value j, value l) { char *src = String_val(s) + Int_val(i); char *dest = Array_data(Bigarray_val(a), j); memcpy(dest, src, Long_val(l)); return Val_unit; } CAMLprim value ml_blit_bigarray_to_string (value a, value i, value s, value j, value l) { char *src = Array_data(Bigarray_val(a), i); char *dest = String_val(s) + Long_val(j); memcpy(dest, src, Long_val(l)); return Val_unit; } unison-2.32.52/case.ml0000644000076500000000000001001011207755401014071 0ustar bcpiercewheel(* Unison file synchronizer: src/case.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) (* The update detector, reconciler, and transporter behave differently *) (* depending on whether the local and/or remote file system is case *) (* insensitive. This pref is set during the initial handshake if any one of *) (* the hosts is case insensitive. *) let caseInsensitiveMode = Prefs.createString "ignorecase" "default" "!identify upper/lowercase filenames (true/false/default)" ("When set to {\\tt true}, this flag causes Unison to treat " ^ "filenames as case insensitive---i.e., files in the two " ^ "replicas whose names differ in (upper- and lower-case) `spelling' " ^ "are treated as the same file. When the flag is set to {\\tt false}, Unison " ^ "will treat all filenames as case sensitive. Ordinarily, when the flag is " ^ "set to {\\tt default}, " ^ "filenames are automatically taken to be case-insensitive if " ^ "either host is running Windows or OSX. In rare circumstances it is " ^ "useful to set the flag manually (e.g. when running Unison on a " ^ "Unix system with a FAT [Windows] volume mounted).") (* Defining this variable as a preference ensures that it will be propagated to the other host during initialization *) let someHostIsInsensitive = Prefs.createBool "someHostIsInsensitive" false "*Pseudo-preference for internal use only" "" (* Note: this function must be fast *) let insensitive () = Prefs.read someHostIsInsensitive let modeDescription () = if insensitive () then "Latin-1 case insensitive" else "case sensitive" let needNormalization s = let rec iter s pos len wasDot = if pos = len then wasDot else 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)) unison-2.32.52/case.mli0000644000076500000000000000036511207755401014256 0ustar bcpiercewheel(* Unison file synchronizer: src/case.mli *) (* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) val insensitive : unit -> bool val modeDescription : unit -> string val normalize : string -> string val init : bool -> unit unison-2.32.52/checksum.ml0000644000076500000000000000532711176730177015007 0ustar bcpiercewheel(* Unison file synchronizer: src/checksum.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) (* The checksum (or fast fingerprinting) algorithm must be fast and has to *) (* be called in a rolling fashion (i.e. we must be able to calculate a new *) (* checksum when provided the current checksum, the outgoing character and *) (* the incoming one). *) (* Definition: cksum([c_n, c_{n-1}, ..., c_0]) = Sum c_i * 16381 ^ i *) type t = int type u = int array (* [power v n] computes [v ^ n] *) let rec power v n = if n = 0 then 1 else let v' = power v (n / 2) in let v'' = v' * v' in if n land 1 <> 0 then v * v'' else v'' (* Takes the block length and returns a pre-computed table for the function *) (* roll: If [init l] => I, then I_n = n * 16381 ^ (l + 1), for 0 <= n < 256 *) (* NB: 256 is the upper-bound of ASCII code returned by Char.code *) let init l = let p = power 16381 (l + 1) in Array.init 256 (fun i -> (i * p) land 0x7fffffff) (* Function [roll] computes fixed-length checksum from previous checksum *) (* Roughly: given the pre-computed table, compute the new checksum from the *) (* old one along with the outgoing and incoming characters, i.e., *) (* - *) (* [roll cksum([c_n, ..., c_0]) c_n c'] => cksum([c_{n-1}, ..., c_0, c']) *) (* - *) let roll init cksum cout cin = let v = cksum + Char.code cin in (v lsl 14 - (v + v + v) (* v * 16381 *) - Array.unsafe_get init (Char.code cout)) land 0x7fffffff (* Function [substring] computes checksum for a given substring in one batch *) (* process: [substring s p l] => cksum([s_p, ..., s_{p + l - 1}]) *) let substring s p l = let cksum = ref 0 in for i = p to p + l - 1 do let v = !cksum + Char.code (String.unsafe_get s i) in cksum := (v lsl 14 - (v + v + v)) (* v * 16381 *) done; !cksum land 0x7fffffff unison-2.32.52/checksum.mli0000644000076500000000000000112711176730177015152 0ustar bcpiercewheel(* 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 unison-2.32.52/clroot.ml0000644000076500000000000002027711176730177014510 0ustar bcpiercewheel(* Unison file synchronizer: src/clroot.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) (* This file parses the unison command-line arguments that specify replicas. The syntax for replicas is based on that of URI's, described in RFC 2396. They have the following grammar: replica ::= [protocol:]//[user@][host][:port][/path] | path protocol ::= file | socket | ssh | rsh user ::= [-_a-zA-Z0-9]+ host ::= [-_a-zA-Z0-9.]+ port ::= [0-9]+ path is any string that does not begin with protocol: or //. *) (* Command-line roots *) type clroot = ConnectLocal of string option (* root *) | ConnectByShell of string (* shell = "rsh" or "ssh" *) * string (* name of host *) * string option (* user name to log in as *) * string option (* port *) * string option (* root of replica in host fs *) | ConnectBySocket of string (* name of host *) * string (* port where server should be listening *) * string option (* root of replica in host fs *) (* Internal datatypes used in parsing command-line roots *) type protocol = File | Rsh | Socket | Ssh type uri = protocol (* - a protocol *) * string option (* - an optional user *) * string option (* - an optional host *) * int option (* - an optional port *) * string option (* - an optional path *) (* Regular expressions, used in parsing *) let protocolColonSlashSlashRegexp = Str.regexp "[a-zA-Z]+://" let protocolColonRegexp = Str.regexp "[a-zA-Z]+:" let slashSlashRegexp = Str.regexp "//" let getProtocolSlashSlash s = if Str.string_match protocolColonSlashSlashRegexp s 0 then let matched = Str.matched_string s in let len = String.length matched in let remainder = Str.string_after s len in let protocolName = String.sub matched 0 (len-3) in let protocol = match protocolName with "file" -> File | "rsh" -> Rsh | "socket" -> Socket | "ssh" -> Ssh | "unison" -> raise(Invalid_argument (Printf.sprintf "protocol unison has been deprecated, use file, ssh, rsh, or socket instead" )) | _ -> raise(Invalid_argument (Printf.sprintf "unrecognized protocol %s" protocolName)) in Some(protocol,remainder) else if Str.string_match slashSlashRegexp s 0 then Some(File,String.sub s 2 (String.length s - 2)) else if Str.string_match protocolColonRegexp s 0 then let matched = Str.matched_string s in match matched with "file:" | "ssh:" | "rsh:" | "socket:" -> raise(Util.Fatal (Printf.sprintf "ill-formed root specification %s (%s must be followed by //)" s matched)) | _ -> None else None let userAtRegexp = Str.regexp "[-_a-zA-Z0-9.]+@" let getUser s = if Str.string_match userAtRegexp s 0 then let userAt = Str.matched_string s in let len = String.length userAt in let afterAt = Str.string_after s len in let beforeAt = String.sub userAt 0 (len-1) in (Some beforeAt,afterAt) else (None,s) let hostRegexp = Str.regexp "[-_a-zA-Z0-9.]+" let getHost s = if Str.string_match hostRegexp s 0 then let host = Str.matched_string s in let s' = Str.string_after s (String.length host) in (Some host,s') else (None,s) let colonPortRegexp = Str.regexp ":[^/]+" let getPort s = if Str.string_match colonPortRegexp s 0 then let colonPort = Str.matched_string s in let len = String.length colonPort in let port = String.sub colonPort 1 (len-1) in let s' = Str.string_after s len in (Some port,s') else (None,s) (* parseUri : string -> protocol * user option * host option * port option * path option where user, host, port, and path are strings, and path is guaranteed to be non-empty *) let parseUri s = match getProtocolSlashSlash s with None -> (File,None,None,None,Some s) | Some(protocol,s0) -> let (userOpt,s1) = getUser s0 in let (hostOpt,s2) = getHost s1 in let (portOpt,s3) = getPort s2 in let pathOpt = let len = String.length s3 in if len <= 0 then None else if String.get s3 0 = '/' then if len=1 then None else Some(String.sub s3 1 (len-1)) else raise(Util.Fatal (Printf.sprintf "ill-formed root specification %s" s)) in (protocol,userOpt,hostOpt,portOpt,pathOpt) (* These should succeed *) let t1 = "socket://tjim@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 unison-2.32.52/clroot.mli0000644000076500000000000000134411176730177014653 0ustar bcpiercewheel(* 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 unison-2.32.52/common.ml0000644000076500000000000001651211176730177014473 0ustar bcpiercewheel(* Unison file synchronizer: src/common.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) type hostname = string (* Canonized roots *) type host = Local | Remote of hostname type root = host * Fspath.t type 'a oneperpath = ONEPERPATH of 'a list (* ------------------------------------------------------------------------- *) (* Printing *) (* ------------------------------------------------------------------------- *) let root2hostname root = match root with (Local, _) -> "local" | (Remote host, _) -> host let root2string root = match root with (Local, fspath) -> Fspath.toString fspath | (Remote host, fspath) -> "//"^host^"/"^(Fspath.toString fspath) (* ------------------------------------------------------------------------- *) (* Root comparison *) (* ------------------------------------------------------------------------- *) let compareRoots x y = match x,y with (Local,fspath1), (Local,fspath2) -> (* FIX: This is a path comparison, should it take case sensitivity into account ? *) compare (Fspath.toString fspath1) (Fspath.toString fspath2) | (Local,_), (Remote _,_) -> -1 | (Remote _,_), (Local,_) -> 1 | (Remote host1, fspath1), (Remote host2, fspath2) -> let result = (* FIX: Should this ALWAYS be a case insensitive compare? *) compare host1 host2 in if result = 0 then (* FIX: This is a path comparison, should it take case sensitivity into account ? *) compare (Fspath.toString fspath1) (Fspath.toString fspath2) else result let sortRoots rootList = Safelist.sort compareRoots rootList (* ---------------------------------------------------------------------- *) type prevState = Previous of Fileinfo.typ * Props.t * Os.fullfingerprint * Osx.ressStamp | New type contentschange = ContentsSame | ContentsUpdated of Os.fullfingerprint * Fileinfo.stamp * Osx.ressStamp type permchange = PropsSame | PropsUpdated type updateItem = NoUpdates (* Path not changed *) | Updates (* Path changed in this replica *) of updateContent (* - new state *) * prevState (* - summary of old state *) | Error (* Error while detecting updates *) of string (* - description of error *) and updateContent = Absent (* Path refers to nothing *) | File (* Path refers to an ordinary file *) of Props.t (* - summary of current state *) * contentschange (* - hint to transport agent *) | Dir (* Path refers to a directory *) of Props.t (* - summary of current state *) * (Name.t * updateItem) list (* - children; MUST KEEP SORTED for recon *) * permchange (* - did permissions change? *) * bool (* - is the directory now empty? *) | Symlink (* Path refers to a symbolic link *) of string (* - link text *) (* ------------------------------------------------------------------------- *) type status = [ `Deleted | `Modified | `PropsChanged | `Created | `Unchanged ] type replicaContent = Fileinfo.typ * status * Props.t * updateItem type direction = Conflict | Merge | Replica1ToReplica2 | Replica2ToReplica1 let direction2string = function Conflict -> "conflict" | Merge -> "merge" | Replica1ToReplica2 -> "replica1 to replica2" | Replica2ToReplica1 -> "replica2 to replica1" type replicas = Problem of string (* There was a problem during update detection *) | Different (* Replicas differ *) of replicaContent (* - content of first replica *) * replicaContent (* - content of second replica *) * direction ref (* - action to take *) * direction (* - default action to take *) type reconItem = {path : Path.t; replicas : replicas} let ucLength = function File(desc,_) -> Props.length desc | Dir(desc,_,_,_) -> Props.length desc | _ -> Uutil.Filesize.zero let uiLength = function Updates(uc,_) -> ucLength uc | _ -> Uutil.Filesize.zero let riAction (_, s, _, _) (_, s', _, _) = match s, s' with `Deleted, _ -> `Delete | (`Unchanged | `PropsChanged), (`Unchanged | `PropsChanged) -> `SetProps | _ -> `Copy let rcLength ((_, _, p, _) as rc) rc' = if riAction rc rc' = `SetProps then Uutil.Filesize.zero else Props.length p let riLength ri = match ri.replicas with Different(rc1, rc2, dir, _) -> begin match !dir with Replica1ToReplica2 -> rcLength rc1 rc2 | Replica2ToReplica1 -> rcLength rc2 rc1 | Conflict -> Uutil.Filesize.zero | Merge -> Uutil.Filesize.zero (* underestimate :-*) end | _ -> Uutil.Filesize.zero let fileInfos ui1 ui2 = match ui1, ui2 with (Updates (File (desc1, ContentsUpdated (fp1, _, ress1)), Previous (`FILE, desc2, fp2, ress2)), NoUpdates) | (Updates (File (desc1, ContentsUpdated (fp1, _, ress1)), Previous (`FILE, desc2, fp2, ress2)), Updates (File (_, ContentsSame), _)) | (NoUpdates, Updates (File (desc2, ContentsUpdated (fp2, _, ress2)), Previous (`FILE, desc1, fp1, ress1))) | (Updates (File (_, ContentsSame), _), Updates (File (desc2, ContentsUpdated (fp2, _, ress2)), Previous (`FILE, desc1, fp1, ress1))) | (Updates (File (desc1, ContentsUpdated (fp1, _, ress1)), _), Updates (File (desc2, ContentsUpdated (fp2, _, ress2)), _)) -> (desc1, fp1, ress1, desc2, fp2, ress2) | _ -> raise (Util.Transient "Can't diff") let problematic ri = match ri.replicas with Problem _ -> true | Different (_,_,d,_) -> (!d = Conflict) let isDeletion ri = match ri.replicas with Different(rc1, rc2, rDir, _) -> (match (!rDir, rc1, rc2) with (Replica1ToReplica2, (`ABSENT, _, _, _), _) -> true | (Replica2ToReplica1, _, (`ABSENT, _, _, _)) -> true | _ -> false) | _ -> false let rcType (fi, _, _, _) = Fileinfo.type2string fi let riFileType ri = match ri.replicas with Different(rc1, rc2, dir, _) -> begin match !dir with Replica2ToReplica1 -> rcType rc2 | _ -> rcType rc1 end | _ -> "nonexistent" unison-2.32.52/common.mli0000644000076500000000000001152311176730177014641 0ustar bcpiercewheel(* 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 unison-2.32.52/CONTRIB0000644000076500000000000000421511176730177013671 0ustar bcpiercewheelINFORMATION FOR CONTRIBUTORS ============================ Unison is a part-time project for its developers: we work on it because we enjoy making something useful for us and for the community, but we all have other jobs to do. If you like Unison and you want to help us make it better, we'd be glad to have you on the team! HOW YOU CAN HELP ---------------- There are lots of ways... * Telling us how you like Unison, whether the installation went smoothly, and what you use it for. * Submitting bug reports (we're always glad to have these...) * Submitting bug FIXES (... especially when accompanied by these! :-) * Reading the code. One of Unison's main design goals is robustness. Help us reach that goal by reading our code and seeing whether you understand and believe it. * Proposing ideas for new functionality. * Undertaking serious development work. See the file TODO.txt for a "wish list" of improvements that are waiting for someone to take them on. DOWNLOADING THE DEVELOPER SOURCES --------------------------------- If you just want to read the code, then the source distribution has everything you need. If you want to do any serious hacking on Unison, you should begin by grabbing a copy of the full distribution from here: http://www.cis.upenn.edu/~bcpierce/unison/resources/developers-only The tar file you'll find contains a mirror of our whole source tree (including the sources for the documentation, various small tools, working notes, etc.). It is copied every night from our central repository, so it is not guaranteed to be consistent, working, compilable, etc. SUBMITTING CHANGES ------------------ If you've made a change that you're happy with and think ought to become part of a future release of Unison, you can send it to us like this: cd make submit This will tar up the whole tree and mail it off to us, so that we can play with it, compare it to what's in the repository, and easily commit the changes. FINDING YOUR WAY AROUND ----------------------- See the file ROADMAP.txt for some suggestions on how to start reading the sources. unison-2.32.52/copy.ml0000644000076500000000000006631211213501736014145 0ustar bcpiercewheel(* Unison file synchronizer: src/copy.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) let (>>=) = Lwt.bind let debug = Trace.debug "copy" (****) let openFileIn fspath path kind = match kind with `DATA -> open_in_gen [Open_rdonly; Open_binary] 0o444 (Fspath.concatToString fspath path) | `RESS _ -> Osx.openRessIn fspath path let openFileOut fspath path kind = match kind with `DATA -> let fullpath = Fspath.concatToString fspath path in let flags = [Unix.O_WRONLY;Unix.O_CREAT] in let perm = 0o600 in begin match Util.osType with `Win32 -> open_out_gen [Open_wronly; Open_creat; Open_excl; Open_binary] perm fullpath | `Unix -> let fd = try Unix.openfile fullpath (Unix.O_EXCL :: flags) perm with Unix.Unix_error ((Unix.EOPNOTSUPP | Unix.EUNKNOWNERR 524), _, _) -> (* O_EXCL not supported under a Netware NFS-mounted filesystem. Solaris and Linux report different errors. *) Unix.openfile fullpath (Unix.O_TRUNC :: flags) perm in Unix.out_channel_of_descr fd end | `RESS len -> Osx.openRessOut fspath path len let protect f g = try f () with Sys_error _ | Unix.Unix_error _ | Util.Transient _ as e -> begin try g () with Sys_error _ | Unix.Unix_error _ -> () end; raise e let lwt_protect f g = Lwt.catch f (fun e -> begin match e with Sys_error _ | Unix.Unix_error _ | Util.Transient _ -> begin try g () with Sys_error _ | Unix.Unix_error _ -> () end | _ -> () end; Lwt.fail e) (****) let setFileinfo fspathTo pathTo realPathTo update desc = match update with `Update _ -> Fileinfo.set fspathTo pathTo (`Copy realPathTo) desc | `Copy -> Fileinfo.set fspathTo pathTo (`Set Props.fileDefault) desc 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; setFileinfo fspathTo pathTo realPathTo update 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 = Bytearray.length buf - pos - 4 in (Remote.decodeInt buf pos, (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 () -> setFileinfo fspathTo pathTo realPathTo update desc; 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) = setFileinfo fspathTo pathTo pathTo `Copy (*FIX: should be realPathTo and update *) desc; Lwt.return () let setFileinfoOnRoot = Remote.registerRootCmdWithConnection "setFileinfo" setFileinfoLocal let targetExists checkSize fspathTo pathTo = let info = Fileinfo.get false fspathTo pathTo in info.Fileinfo.typ = `FILE && (match checkSize with `MakeWriteableAndCheckNonempty -> let perms = Props.perms info.Fileinfo.desc in let perms' = perms lor 0o600 in Util.convertUnixErrorsToTransient "making target writable" (fun () -> Unix.chmod (Fspath.concatToString fspathTo pathTo) perms'); Props.length info.Fileinfo.desc > Uutil.Filesize.zero | `CheckDataSize desc -> Props.length info.Fileinfo.desc = Props.length desc | `CheckSize (desc,ress) -> Props.length info.Fileinfo.desc = Props.length desc && Osx.ressLength info.Fileinfo.osX.Osx.ressInfo = Osx.ressLength ress) let targetExistsLocal connFrom (checkSize, fspathTo, pathTo) = Lwt.return (targetExists checkSize fspathTo pathTo) 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)); (* Make sure the file information is right *) setFileinfoOnRoot rootTo rootFrom (fspathTo, pathTo, desc) (* 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 ()) unison-2.32.52/copy.mli0000644000076500000000000000223711176730177014325 0ustar bcpiercewheel (* Transfer a file from a replica to the other *) val file : Common.root (* root of source *) -> Path.local (* path of source *) -> Common.root (* root of target *) -> Fspath.t (* fspath of target *) -> Path.local (* path of target *) -> Path.local (* path of "real" [original] target *) -> [`Update of (Uutil.Filesize.t * Uutil.Filesize.t) | `Copy] -> Props.t (* permissions for new file *) -> Os.fullfingerprint (* fingerprint of file *) -> Osx.ressStamp (* ressource info of file *) -> Uutil.File.t (* file's index in UI (for progress bars) *) -> unit Lwt.t val localFile : Fspath.t (* fspath of source *) -> Path.local (* path of source *) -> Fspath.t (* fspath of target *) -> Path.local (* path of target *) -> Path.local (* path of "real" [original] target *) -> [`Update of (Uutil.Filesize.t * Uutil.Filesize.t) | `Copy] -> Props.t (* permissions for new file *) -> Uutil.Filesize.t (* fork length *) -> Uutil.File.t option (* file's index in UI (for progress bars), as appropriate *) -> unit unison-2.32.52/COPYING0000644000076500000000000010451311176730177013703 0ustar bcpiercewheel GNU GENERAL PUBLIC LICENSE Version 3, 29 June 2007 Copyright (C) 2007 Free Software Foundation, Inc. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The GNU General Public License is a free, copyleft license for software and other kinds of works. The licenses for most software and other practical works are designed to take away your freedom to share and change the works. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change all versions of a program--to make sure it remains free software for all its users. We, the Free Software Foundation, use the GNU General Public License for most of our software; it applies also to any other work released this way by its authors. You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for them if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs, and that you know you can do these things. To protect your rights, we need to prevent others from denying you these rights or asking you to surrender the rights. Therefore, you have certain responsibilities if you distribute copies of the software, or if you modify it: responsibilities to respect the freedom of others. For example, if you distribute copies of such a program, whether gratis or for a fee, you must pass on to the recipients the same freedoms that you received. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. Developers that use the GNU GPL protect your rights with two steps: (1) assert copyright on the software, and (2) offer you this License giving you legal permission to copy, distribute and/or modify it. For the developers' and authors' protection, the GPL clearly explains that there is no warranty for this free software. For both users' and authors' sake, the GPL requires that modified versions be marked as changed, so that their problems will not be attributed erroneously to authors of previous versions. Some devices are designed to deny users access to install or run modified versions of the software inside them, although the manufacturer can do so. This is fundamentally incompatible with the aim of protecting users' freedom to change the software. The systematic pattern of such abuse occurs in the area of products for individuals to use, which is precisely where it is most unacceptable. Therefore, we have designed this version of the GPL to prohibit the practice for those products. If such problems arise substantially in other domains, we stand ready to extend this provision to those domains in future versions of the GPL, as needed to protect the freedom of users. Finally, every program is threatened constantly by software patents. States should not allow patents to restrict development and use of software on general-purpose computers, but in those that do, we wish to avoid the special danger that patents applied to a free program could make it effectively proprietary. To prevent this, the GPL assures that patents cannot be used to render the program non-free. The precise terms and conditions for copying, distribution and modification follow. TERMS AND CONDITIONS 0. Definitions. "This License" refers to version 3 of the GNU General Public License. "Copyright" also means copyright-like laws that apply to other kinds of works, such as semiconductor masks. "The Program" refers to any copyrightable work licensed under this License. Each licensee is addressed as "you". "Licensees" and "recipients" may be individuals or organizations. To "modify" a work means to copy from or adapt all or part of the work in a fashion requiring copyright permission, other than the making of an exact copy. The resulting work is called a "modified version" of the earlier work or a work "based on" the earlier work. A "covered work" means either the unmodified Program or a work based on the Program. To "propagate" a work means to do anything with it that, without permission, would make you directly or secondarily liable for infringement under applicable copyright law, except executing it on a computer or modifying a private copy. Propagation includes copying, distribution (with or without modification), making available to the public, and in some countries other activities as well. To "convey" a work means any kind of propagation that enables other parties to make or receive copies. Mere interaction with a user through a computer network, with no transfer of a copy, is not conveying. An interactive user interface displays "Appropriate Legal Notices" to the extent that it includes a convenient and prominently visible feature that (1) displays an appropriate copyright notice, and (2) tells the user that there is no warranty for the work (except to the extent that warranties are provided), that licensees may convey the work under this License, and how to view a copy of this License. If the interface presents a list of user commands or options, such as a menu, a prominent item in the list meets this criterion. 1. Source Code. The "source code" for a work means the preferred form of the work for making modifications to it. "Object code" means any non-source form of a work. A "Standard Interface" means an interface that either is an official standard defined by a recognized standards body, or, in the case of interfaces specified for a particular programming language, one that is widely used among developers working in that language. The "System Libraries" of an executable work include anything, other than the work as a whole, that (a) is included in the normal form of packaging a Major Component, but which is not part of that Major Component, and (b) serves only to enable use of the work with that Major Component, or to implement a Standard Interface for which an implementation is available to the public in source code form. A "Major Component", in this context, means a major essential component (kernel, window system, and so on) of the specific operating system (if any) on which the executable work runs, or a compiler used to produce the work, or an object code interpreter used to run it. The "Corresponding Source" for a work in object code form means all the source code needed to generate, install, and (for an executable work) run the object code and to modify the work, including scripts to control those activities. However, it does not include the work's System Libraries, or general-purpose tools or generally available free programs which are used unmodified in performing those activities but which are not part of the work. For example, Corresponding Source includes interface definition files associated with source files for the work, and the source code for shared libraries and dynamically linked subprograms that the work is specifically designed to require, such as by intimate data communication or control flow between those subprograms and other parts of the work. The Corresponding Source need not include anything that users can regenerate automatically from other parts of the Corresponding Source. The Corresponding Source for a work in source code form is that same work. 2. Basic Permissions. All rights granted under this License are granted for the term of copyright on the Program, and are irrevocable provided the stated conditions are met. This License explicitly affirms your unlimited permission to run the unmodified Program. The output from running a covered work is covered by this License only if the output, given its content, constitutes a covered work. This License acknowledges your rights of fair use or other equivalent, as provided by copyright law. You may make, run and propagate covered works that you do not convey, without conditions so long as your license otherwise remains in force. You may convey covered works to others for the sole purpose of having them make modifications exclusively for you, or provide you with facilities for running those works, provided that you comply with the terms of this License in conveying all material for which you do not control copyright. Those thus making or running the covered works for you must do so exclusively on your behalf, under your direction and control, on terms that prohibit them from making any copies of your copyrighted material outside their relationship with you. Conveying under any other circumstances is permitted solely under the conditions stated below. Sublicensing is not allowed; section 10 makes it unnecessary. 3. Protecting Users' Legal Rights From Anti-Circumvention Law. No covered work shall be deemed part of an effective technological measure under any applicable law fulfilling obligations under article 11 of the WIPO copyright treaty adopted on 20 December 1996, or similar laws prohibiting or restricting circumvention of such measures. When you convey a covered work, you waive any legal power to forbid circumvention of technological measures to the extent such circumvention is effected by exercising rights under this License with respect to the covered work, and you disclaim any intention to limit operation or modification of the work as a means of enforcing, against the work's users, your or third parties' legal rights to forbid circumvention of technological measures. 4. Conveying Verbatim Copies. You may convey verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice; keep intact all notices stating that this License and any non-permissive terms added in accord with section 7 apply to the code; keep intact all notices of the absence of any warranty; and give all recipients a copy of this License along with the Program. You may charge any price or no price for each copy that you convey, and you may offer support or warranty protection for a fee. 5. Conveying Modified Source Versions. You may convey a work based on the Program, or the modifications to produce it from the Program, in the form of source code under the terms of section 4, provided that you also meet all of these conditions: a) The work must carry prominent notices stating that you modified it, and giving a relevant date. b) The work must carry prominent notices stating that it is released under this License and any conditions added under section 7. This requirement modifies the requirement in section 4 to "keep intact all notices". c) You must license the entire work, as a whole, under this License to anyone who comes into possession of a copy. This License will therefore apply, along with any applicable section 7 additional terms, to the whole of the work, and all its parts, regardless of how they are packaged. This License gives no permission to license the work in any other way, but it does not invalidate such permission if you have separately received it. d) If the work has interactive user interfaces, each must display Appropriate Legal Notices; however, if the Program has interactive interfaces that do not display Appropriate Legal Notices, your work need not make them do so. A compilation of a covered work with other separate and independent works, which are not by their nature extensions of the covered work, and which are not combined with it such as to form a larger program, in or on a volume of a storage or distribution medium, is called an "aggregate" if the compilation and its resulting copyright are not used to limit the access or legal rights of the compilation's users beyond what the individual works permit. Inclusion of a covered work in an aggregate does not cause this License to apply to the other parts of the aggregate. 6. Conveying Non-Source Forms. You may convey a covered work in object code form under the terms of sections 4 and 5, provided that you also convey the machine-readable Corresponding Source under the terms of this License, in one of these ways: a) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by the Corresponding Source fixed on a durable physical medium customarily used for software interchange. b) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by a written offer, valid for at least three years and valid for as long as you offer spare parts or customer support for that product model, to give anyone who possesses the object code either (1) a copy of the Corresponding Source for all the software in the product that is covered by this License, on a durable physical medium customarily used for software interchange, for a price no more than your reasonable cost of physically performing this conveying of source, or (2) access to copy the Corresponding Source from a network server at no charge. c) Convey individual copies of the object code with a copy of the written offer to provide the Corresponding Source. This alternative is allowed only occasionally and noncommercially, and only if you received the object code with such an offer, in accord with subsection 6b. d) Convey the object code by offering access from a designated place (gratis or for a charge), and offer equivalent access to the Corresponding Source in the same way through the same place at no further charge. You need not require recipients to copy the Corresponding Source along with the object code. If the place to copy the object code is a network server, the Corresponding Source may be on a different server (operated by you or a third party) that supports equivalent copying facilities, provided you maintain clear directions next to the object code saying where to find the Corresponding Source. Regardless of what server hosts the Corresponding Source, you remain obligated to ensure that it is available for as long as needed to satisfy these requirements. e) Convey the object code using peer-to-peer transmission, provided you inform other peers where the object code and Corresponding Source of the work are being offered to the general public at no charge under subsection 6d. A separable portion of the object code, whose source code is excluded from the Corresponding Source as a System Library, need not be included in conveying the object code work. A "User Product" is either (1) a "consumer product", which means any tangible personal property which is normally used for personal, family, or household purposes, or (2) anything designed or sold for incorporation into a dwelling. In determining whether a product is a consumer product, doubtful cases shall be resolved in favor of coverage. For a particular product received by a particular user, "normally used" refers to a typical or common use of that class of product, regardless of the status of the particular user or of the way in which the particular user actually uses, or expects or is expected to use, the product. A product is a consumer product regardless of whether the product has substantial commercial, industrial or non-consumer uses, unless such uses represent the only significant mode of use of the product. "Installation Information" for a User Product means any methods, procedures, authorization keys, or other information required to install and execute modified versions of a covered work in that User Product from a modified version of its Corresponding Source. The information must suffice to ensure that the continued functioning of the modified object code is in no case prevented or interfered with solely because modification has been made. If you convey an object code work under this section in, or with, or specifically for use in, a User Product, and the conveying occurs as part of a transaction in which the right of possession and use of the User Product is transferred to the recipient in perpetuity or for a fixed term (regardless of how the transaction is characterized), the Corresponding Source conveyed under this section must be accompanied by the Installation Information. But this requirement does not apply if neither you nor any third party retains the ability to install modified object code on the User Product (for example, the work has been installed in ROM). The requirement to provide Installation Information does not include a requirement to continue to provide support service, warranty, or updates for a work that has been modified or installed by the recipient, or for the User Product in which it has been modified or installed. Access to a network may be denied when the modification itself materially and adversely affects the operation of the network or violates the rules and protocols for communication across the network. Corresponding Source conveyed, and Installation Information provided, in accord with this section must be in a format that is publicly documented (and with an implementation available to the public in source code form), and must require no special password or key for unpacking, reading or copying. 7. Additional Terms. "Additional permissions" are terms that supplement the terms of this License by making exceptions from one or more of its conditions. Additional permissions that are applicable to the entire Program shall be treated as though they were included in this License, to the extent that they are valid under applicable law. If additional permissions apply only to part of the Program, that part may be used separately under those permissions, but the entire Program remains governed by this License without regard to the additional permissions. When you convey a copy of a covered work, you may at your option remove any additional permissions from that copy, or from any part of it. (Additional permissions may be written to require their own removal in certain cases when you modify the work.) You may place additional permissions on material, added by you to a covered work, for which you have or can give appropriate copyright permission. Notwithstanding any other provision of this License, for material you add to a covered work, you may (if authorized by the copyright holders of that material) supplement the terms of this License with terms: a) Disclaiming warranty or limiting liability differently from the terms of sections 15 and 16 of this License; or b) Requiring preservation of specified reasonable legal notices or author attributions in that material or in the Appropriate Legal Notices displayed by works containing it; or c) Prohibiting misrepresentation of the origin of that material, or requiring that modified versions of such material be marked in reasonable ways as different from the original version; or d) Limiting the use for publicity purposes of names of licensors or authors of the material; or e) Declining to grant rights under trademark law for use of some trade names, trademarks, or service marks; or f) Requiring indemnification of licensors and authors of that material by anyone who conveys the material (or modified versions of it) with contractual assumptions of liability to the recipient, for any liability that these contractual assumptions directly impose on those licensors and authors. All other non-permissive additional terms are considered "further restrictions" within the meaning of section 10. If the Program as you received it, or any part of it, contains a notice stating that it is governed by this License along with a term that is a further restriction, you may remove that term. If a license document contains a further restriction but permits relicensing or conveying under this License, you may add to a covered work material governed by the terms of that license document, provided that the further restriction does not survive such relicensing or conveying. If you add terms to a covered work in accord with this section, you must place, in the relevant source files, a statement of the additional terms that apply to those files, or a notice indicating where to find the applicable terms. Additional terms, permissive or non-permissive, may be stated in the form of a separately written license, or stated as exceptions; the above requirements apply either way. 8. Termination. You may not propagate or modify a covered work except as expressly provided under this License. Any attempt otherwise to propagate or modify it is void, and will automatically terminate your rights under this License (including any patent licenses granted under the third paragraph of section 11). However, if you cease all violation of this License, then your license from a particular copyright holder is reinstated (a) provisionally, unless and until the copyright holder explicitly and finally terminates your license, and (b) permanently, if the copyright holder fails to notify you of the violation by some reasonable means prior to 60 days after the cessation. Moreover, your license from a particular copyright holder is reinstated permanently if the copyright holder notifies you of the violation by some reasonable means, this is the first time you have received notice of violation of this License (for any work) from that copyright holder, and you cure the violation prior to 30 days after your receipt of the notice. Termination of your rights under this section does not terminate the licenses of parties who have received copies or rights from you under this License. If your rights have been terminated and not permanently reinstated, you do not qualify to receive new licenses for the same material under section 10. 9. Acceptance Not Required for Having Copies. You are not required to accept this License in order to receive or run a copy of the Program. Ancillary propagation of a covered work occurring solely as a consequence of using peer-to-peer transmission to receive a copy likewise does not require acceptance. However, nothing other than this License grants you permission to propagate or modify any covered work. These actions infringe copyright if you do not accept this License. Therefore, by modifying or propagating a covered work, you indicate your acceptance of this License to do so. 10. Automatic Licensing of Downstream Recipients. Each time you convey a covered work, the recipient automatically receives a license from the original licensors, to run, modify and propagate that work, subject to this License. You are not responsible for enforcing compliance by third parties with this License. An "entity transaction" is a transaction transferring control of an organization, or substantially all assets of one, or subdividing an organization, or merging organizations. If propagation of a covered work results from an entity transaction, each party to that transaction who receives a copy of the work also receives whatever licenses to the work the party's predecessor in interest had or could give under the previous paragraph, plus a right to possession of the Corresponding Source of the work from the predecessor in interest, if the predecessor has it or can get it with reasonable efforts. You may not impose any further restrictions on the exercise of the rights granted or affirmed under this License. For example, you may not impose a license fee, royalty, or other charge for exercise of rights granted under this License, and you may not initiate litigation (including a cross-claim or counterclaim in a lawsuit) alleging that any patent claim is infringed by making, using, selling, offering for sale, or importing the Program or any portion of it. 11. Patents. A "contributor" is a copyright holder who authorizes use under this License of the Program or a work on which the Program is based. The work thus licensed is called the contributor's "contributor version". A contributor's "essential patent claims" are all patent claims owned or controlled by the contributor, whether already acquired or hereafter acquired, that would be infringed by some manner, permitted by this License, of making, using, or selling its contributor version, but do not include claims that would be infringed only as a consequence of further modification of the contributor version. For purposes of this definition, "control" includes the right to grant patent sublicenses in a manner consistent with the requirements of this License. Each contributor grants you a non-exclusive, worldwide, royalty-free patent license under the contributor's essential patent claims, to make, use, sell, offer for sale, import and otherwise run, modify and propagate the contents of its contributor version. In the following three paragraphs, a "patent license" is any express agreement or commitment, however denominated, not to enforce a patent (such as an express permission to practice a patent or covenant not to sue for patent infringement). To "grant" such a patent license to a party means to make such an agreement or commitment not to enforce a patent against the party. If you convey a covered work, knowingly relying on a patent license, and the Corresponding Source of the work is not available for anyone to copy, free of charge and under the terms of this License, through a publicly available network server or other readily accessible means, then you must either (1) cause the Corresponding Source to be so available, or (2) arrange to deprive yourself of the benefit of the patent license for this particular work, or (3) arrange, in a manner consistent with the requirements of this License, to extend the patent license to downstream recipients. "Knowingly relying" means you have actual knowledge that, but for the patent license, your conveying the covered work in a country, or your recipient's use of the covered work in a country, would infringe one or more identifiable patents in that country that you have reason to believe are valid. If, pursuant to or in connection with a single transaction or arrangement, you convey, or propagate by procuring conveyance of, a covered work, and grant a patent license to some of the parties receiving the covered work authorizing them to use, propagate, modify or convey a specific copy of the covered work, then the patent license you grant is automatically extended to all recipients of the covered work and works based on it. A patent license is "discriminatory" if it does not include within the scope of its coverage, prohibits the exercise of, or is conditioned on the non-exercise of one or more of the rights that are specifically granted under this License. You may not convey a covered work if you are a party to an arrangement with a third party that is in the business of distributing software, under which you make payment to the third party based on the extent of your activity of conveying the work, and under which the third party grants, to any of the parties who would receive the covered work from you, a discriminatory patent license (a) in connection with copies of the covered work conveyed by you (or copies made from those copies), or (b) primarily for and in connection with specific products or compilations that contain the covered work, unless you entered into that arrangement, or that patent license was granted, prior to 28 March 2007. Nothing in this License shall be construed as excluding or limiting any implied license or other defenses to infringement that may otherwise be available to you under applicable patent law. 12. No Surrender of Others' Freedom. If conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot convey a covered work so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not convey it at all. For example, if you agree to terms that obligate you to collect a royalty for further conveying from those to whom you convey the Program, the only way you could satisfy both those terms and this License would be to refrain entirely from conveying the Program. 13. Use with the GNU Affero General Public License. Notwithstanding any other provision of this License, you have permission to link or combine any covered work with a work licensed under version 3 of the GNU Affero General Public License into a single combined work, and to convey the resulting work. The terms of this License will continue to apply to the part which is the covered work, but the special requirements of the GNU Affero General Public License, section 13, concerning interaction through a network will apply to the combination as such. 14. Revised Versions of this License. The Free Software Foundation may publish revised and/or new versions of the GNU General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies that a certain numbered version of the GNU General Public License "or any later version" applies to it, you have the option of following the terms and conditions either of that numbered version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the GNU General Public License, you may choose any version ever published by the Free Software Foundation. If the Program specifies that a proxy can decide which future versions of the GNU General Public License can be used, that proxy's public statement of acceptance of a version permanently authorizes you to choose that version for the Program. Later license versions may give you additional or different permissions. However, no additional obligations are imposed on any author or copyright holder as a result of your choosing to follow a later version. 15. Disclaimer of Warranty. THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. Limitation of Liability. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. 17. Interpretation of Sections 15 and 16. If the disclaimer of warranty and limitation of liability provided above cannot be given local legal effect according to their terms, reviewing courts shall apply local law that most closely approximates an absolute waiver of all civil liability in connection with the Program, unless a warranty or assumption of liability accompanies a copy of the Program in return for a fee. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively state the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 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 . Also add information on how to contact you by electronic and paper mail. If the program does terminal interaction, make it output a short notice like this when it starts in an interactive mode: Copyright (C) This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, your program's commands might be different; for a GUI interface, you would use an "about box". You should also get your employer (if you work as a programmer) or school, if any, to sign a "copyright disclaimer" for the program, if necessary. For more information on this, and how to apply and follow the GNU GPL, see . The GNU General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Lesser General Public License instead of this License. But first, please read . unison-2.32.52/external.ml0000644000076500000000000000647611176730177015035 0ustar bcpiercewheel(* Unison file synchronizer: src/external.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) (*****************************************************************************) (* RUNNING EXTERNAL PROGRAMS *) (*****************************************************************************) let debug = Util.debug "external" let (>>=) = Lwt.bind open Lwt let readChannelTillEof c = let rec loop lines = try let l = input_line c in (* Util.msg "%s\n" l; *) loop (l::lines) with End_of_file -> lines in String.concat "\n" (Safelist.rev (loop [])) let readChannelTillEof_lwt c = let rec loop lines = let lo = try Some(Lwt_unix.run (Lwt_unix.input_line c)) with End_of_file -> None in match lo with Some l -> loop (l :: lines) | None -> lines in String.concat "\n" (Safelist.rev (loop [])) let readChannelsTillEof l = let rec suckitdry lines c = Lwt.catch (fun() -> Lwt_unix.input_line c >>= (fun l -> return (Some l))) (fun e -> match e with End_of_file -> return None | _ -> raise e) >>= (fun lo -> match lo with None -> return lines | Some l -> suckitdry (l :: lines) c) in Lwt_util.map (fun c -> suckitdry [] c >>= (fun res -> return (String.concat "\n" (Safelist.rev res)))) l let runExternalProgram cmd = if Util.osType = `Win32 && not Util.isCygwin then begin debug (fun()-> Util.msg "Executing external program windows-style\n"); let c = Unix.open_process_in ("\"" ^ cmd ^ "\"") in let log = readChannelTillEof c in let returnValue = Unix.close_process_in c in let mergeResultLog = cmd ^ (if log <> "" then "\n\n" ^ log else "") ^ (if returnValue <> Unix.WEXITED 0 then "\n\n" ^ Util.process_status_to_string returnValue else "") in (returnValue,mergeResultLog) end else Lwt_unix.run ( Lwt_unix.open_process_full cmd (Unix.environment ()) >>= (fun (out, ipt, err) -> readChannelsTillEof [out;err] >>= (function [logOut;logErr] -> Lwt_unix.close_process_full (out, ipt, err) >>= (fun returnValue -> let logOut = Util.trimWhitespace logOut in let logErr = Util.trimWhitespace logErr in return (returnValue, ( (* cmd ^ "\n\n" ^ *) (if logOut = "" || logErr = "" then logOut ^ logErr else logOut ^ "\n\n" ^ ("Error Output:" ^ logErr)) ^ (if returnValue = Unix.WEXITED 0 then "" else "\n\n" ^ Util.process_status_to_string returnValue)))) (* Stop typechechecker from complaining about non-exhaustive pattern above *) | _ -> assert false))) unison-2.32.52/external.mli0000644000076500000000000000035011176730177015167 0ustar bcpiercewheel(* 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 unison-2.32.52/fileinfo.ml0000644000076500000000000001451511206734622014770 0ustar bcpiercewheel(* Unison file synchronizer: src/fileinfo.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) let debugV = Util.debug "fileinfo+" type typ = [ `ABSENT | `FILE | `DIRECTORY | `SYMLINK ] let type2string = function `ABSENT -> "nonexistent" | `FILE -> "file" | `DIRECTORY -> "dir" | `SYMLINK -> "symlink" type t = { typ : typ; inode : int; ctime : float; desc : Props.t; osX : Osx.info} (* Stat function that pays attention to pref for following links *) let statFn fromRoot fspath path = let fullpath = Fspath.concat fspath path in let stats = Fspath.lstat fullpath in if stats.Unix.LargeFile.st_kind = Unix.S_LNK && fromRoot && Path.followLink path then try Fspath.stat fullpath with Unix.Unix_error((Unix.ENOENT | Unix.ENOTDIR),_,_) -> raise (Util.Transient (Printf.sprintf "Path %s is marked 'follow' but its target is missing" (Fspath.toString fullpath))) else stats let get fromRoot fspath path = Util.convertUnixErrorsToTransient "querying file information" (fun () -> try let stats = statFn fromRoot fspath path in debugV (fun () -> Util.msg "%s: %b %f %f\n" (Fspath.concatToString fspath path) fromRoot stats.Unix.LargeFile.st_ctime stats.Unix.LargeFile.st_mtime); let typ = match stats.Unix.LargeFile.st_kind with Unix.S_REG -> `FILE | Unix.S_DIR -> `DIRECTORY | Unix.S_LNK -> `SYMLINK | _ -> raise (Util.Transient ("path " ^ (Fspath.concatToString fspath path) ^ " has unknown file type")) in let osxInfos = Osx.getFileInfos fspath path typ in { typ = typ; inode = (* The inode number is truncated so that it fits in a 31 bit ocaml integer *) stats.Unix.LargeFile.st_ino land 0x3FFFFFFF; ctime = stats.Unix.LargeFile.st_ctime; desc = Props.get stats osxInfos; osX = osxInfos } with Unix.Unix_error((Unix.ENOENT | Unix.ENOTDIR),_,_) -> { typ = `ABSENT; inode = 0; ctime = 0.0; desc = Props.dummy; osX = Osx.getFileInfos fspath path `ABSENT }) let check fspath path props = Util.convertUnixErrorsToTransient "checking file information" (fun () -> 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) unison-2.32.52/fileinfo.mli0000644000076500000000000000156211176730177015146 0ustar bcpiercewheel(* 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) unison-2.32.52/files.ml0000644000076500000000000012145411213501736014274 0ustar bcpiercewheel(* Unison file synchronizer: src/files.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) open Common open Lwt open Fileinfo let debug = Trace.debug "files" let debugverbose = Trace.debug "files+" (* ------------------------------------------------------------ *) let commitLogName = Util.fileInHomeDir "DANGER.README" let writeCommitLog source target tempname = let sourcename = Fspath.toString source in let targetname = Fspath.toString target in debug (fun() -> Util.msg "Writing commit log: renaming %s to %s via %s\n" sourcename targetname tempname); Util.convertUnixErrorsToFatal "writing commit log" (fun () -> let c = open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_excl] 0o600 commitLogName in Printf.fprintf c "Warning: the last run of %s terminated abnormally " Uutil.myName; Printf.fprintf c "while moving\n %s\nto\n %s\nvia\n %s\n\n" sourcename targetname tempname; Printf.fprintf c "Please check the state of these files immediately\n"; Printf.fprintf c "(and delete this notice when you've done so).\n"; close_out c) let clearCommitLog () = debug (fun() -> (Util.msg "Deleting commit log\n")); Util.convertUnixErrorsToFatal "clearing commit log" (fun () -> Unix.unlink commitLogName) let processCommitLog () = if Sys.file_exists commitLogName then begin raise(Util.Fatal( Printf.sprintf "Warning: the previous run of %s terminated in a dangerous state. Please consult the file %s, delete it, and try again." Uutil.myName commitLogName)) end else Lwt.return () let processCommitLogOnHost = Remote.registerHostCmd "processCommitLog" processCommitLog let processCommitLogs() = Lwt_unix.run (Globals.allHostsIter (fun h -> processCommitLogOnHost h ())) (* ------------------------------------------------------------ *) let deleteLocal (fspath, (workingDirOpt, path)) = (* when the workingDirectory is set, we are dealing with a temporary file *) (* so we don't call the stasher in this case. *) begin match workingDirOpt with Some p -> debug (fun () -> Util.msg "deleteLocal [%s] (%s, %s)\n" (Fspath.toString fspath) (Fspath.toString p) (Path.toString path)); Os.delete p path | None -> debug (fun () -> Util.msg "deleteLocal [%s] (None, %s)\n" (Fspath.toString fspath) (Path.toString path)); Stasher.backup fspath path `AndRemove end; Lwt.return () let performDelete = Remote.registerRootCmd "delete" deleteLocal (* FIX: maybe we should rename the destination before making any check ? *) let delete rootFrom pathFrom rootTo pathTo ui = Update.transaction (fun id -> Update.replaceArchive rootFrom pathFrom None Update.NoArchive id true false >>= (fun _ -> (* Unison do the next line cause we want to keep a backup of the file. FIX: We only need this when we are making backups *) Update.updateArchive rootTo pathTo ui id >>= (fun _ -> Update.replaceArchive rootTo pathTo None Update.NoArchive id true false >>= (fun localPathTo -> (* Make sure the target is unchanged *) (* (There is an unavoidable race condition here.) *) Update.checkNoUpdates rootTo pathTo ui >>= (fun () -> performDelete rootTo (None, localPathTo)))))) (* ------------------------------------------------------------ *) let setPropRemote = Remote.registerRootCmd "setProp" (fun (fspath, (workingDir, path, kind, newDesc)) -> Fileinfo.set workingDir path kind newDesc; Lwt.return ()) let setPropRemote2 = Remote.registerRootCmd "setProp2" (fun (fspath, (path, kind, newDesc)) -> let (workingDir,realPath) = Fspath.findWorkingDir fspath path in Fileinfo.set workingDir realPath kind newDesc; Lwt.return ()) (* FIX: we should check there has been no update before performing the change *) let setProp fromRoot fromPath toRoot toPath newDesc oldDesc uiFrom uiTo = debug (fun() -> Util.msg "setProp %s %s %s\n %s %s %s\n" (root2string fromRoot) (Path.toString fromPath) (Props.toString newDesc) (root2string toRoot) (Path.toString toPath) (Props.toString oldDesc)); Update.transaction (fun id -> Update.updateProps fromRoot fromPath None uiFrom id >>= (fun _ -> (* [uiTo] provides the modtime while [desc] provides the other file properties *) Update.updateProps toRoot toPath (Some newDesc) uiTo id >>= (fun toLocalPath -> setPropRemote2 toRoot (toLocalPath, `Update oldDesc, newDesc)))) (* ------------------------------------------------------------ *) let mkdirRemote = Remote.registerRootCmd "mkdir" (fun (fspath,(workingDir,path)) -> let info = Fileinfo.get false workingDir path in if info.Fileinfo.typ = `DIRECTORY then begin begin try (* Make sure the directory is writable *) Unix.chmod (Fspath.concatToString workingDir path) (Props.perms info.Fileinfo.desc lor 0o700) with Unix.Unix_error _ -> () end; Lwt.return info.Fileinfo.desc end else begin if info.Fileinfo.typ <> `ABSENT then Os.delete workingDir path; Os.createDir workingDir path Props.dirDefault; Lwt.return (Fileinfo.get false workingDir path).Fileinfo.desc end) 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)))))) (* ------------------------------------------------------------ *) 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)) unison-2.32.52/files.mli0000644000076500000000000000764711176730177014467 0ustar bcpiercewheel(* 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 unison-2.32.52/fileutil.ml0000644000076500000000000000247511176730177015023 0ustar bcpiercewheel(* Unison file synchronizer: src/fileutil.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) (* Convert backslashes in a string to forward slashes. Useful in Windows. *) let backslashes2forwardslashes s0 = try ignore(String.index s0 '\\'); (* avoid alloc if possible *) let n = String.length s0 in let s = String.create n in for i = 0 to n-1 do let c = String.get s0 i in if c = '\\' then String.set s i '/' else String.set s i c done; s with Not_found -> s0 let rec removeTrailingSlashes s = let len = String.length s in if len>0 && String.get s (len-1) = '/' then removeTrailingSlashes (String.sub s 0 (len-1)) else s unison-2.32.52/fileutil.mli0000644000076500000000000000045011176730177015163 0ustar bcpiercewheel(* 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 unison-2.32.52/fingerprint.ml0000644000076500000000000000510311176730177015524 0ustar bcpiercewheel(* Unison file synchronizer: src/fingerprint.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) (* NOTE: IF YOU CHANGE TYPE "FINGERPRINT", THE ARCHIVE FORMAT CHANGES; *) (* INCREMENT "UPDATE.ARCHIVEFORMAT" *) type t = string (* Assumes that (fspath, path) is a file and gives its ``digest '', that is *) (* a short string of cryptographic quality representing it. *) let file fspath path = let f = Fspath.toString (Fspath.concat fspath path) in Util.convertUnixErrorsToTransient ("digesting " ^ f) (fun () -> Digest.file f) let maxLength = Uutil.Filesize.ofInt max_int let subfile path offset len = if len > maxLength then raise (Util.Transient (Format.sprintf "File '%s' too big for fingerprinting" path)); Util.convertUnixErrorsToTransient "digesting subfile" (fun () -> let inch = open_in_bin path in begin try LargeFile.seek_in inch offset; let res = Digest.channel inch (Uutil.Filesize.toInt len) in close_in inch; res with End_of_file -> close_in_noerr inch; raise (Util.Transient (Format.sprintf "Error in digesting subfile '%s': truncated file" path)) | e -> close_in_noerr inch; raise e end) let int2hexa quartet = if quartet < 10 then (char_of_int ((int_of_char '0') + quartet)) else char_of_int ((int_of_char 'a') + quartet - 10) let hexaCode theChar = let intCode = int_of_char theChar in let first = intCode / 16 in let second = intCode mod 16 in (int2hexa first, int2hexa second) let toString md5 = let length = String.length md5 in let string = String.create (length * 2) in for i=0 to (length - 1) do let c1, c2 = hexaCode (md5.[i]) in string.[2*i] <- c1; string.[2*i + 1] <- c2; done; string let string = Digest.string let dummy = "" unison-2.32.52/fingerprint.mli0000644000076500000000000000072311176730177015700 0ustar bcpiercewheel(* 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 unison-2.32.52/fspath.ml0000644000076500000000000003172411176730177014472 0ustar bcpiercewheel(* Unison file synchronizer: src/fspath.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) (* Defines an abstract type of absolute filenames (fspaths). Keeping the *) (* type abstract lets us enforce some invariants which are important for *) (* correct behavior of some system calls. *) (* - *) (* Invariants: *) (* Fspath "" is not allowed *) (* All root directories end in / *) (* All non-root directories end in some other character *) (* All separator characters are /, even in Windows *) (* All fspaths are absolute *) (* - *) let debug = Util.debug "fspath" let debugverbose = Util.debug "fspath+" type t = Fspath of string let toString (Fspath f) = f (* Needed to hack around some ocaml/Windows bugs, see comment at stat, below *) let winRootRx = Rx.rx "(([a-zA-Z]:)?/|//[^/]+/[^/]+/)" (* FIX I think we could just check the last character of [d]. *) let isRootDir d = (* We assume all path separators are slashes in d *) d="/" || (Util.osType = `Win32 && Rx.match_string winRootRx d) let winRootFixRx = Rx.rx "//[^/]+/[^/]+" let winRootFix d = if Rx.match_string winRootFixRx d then d^"/" else d (* [differentSuffix: fspath -> fspath -> (string * string)] returns the *) (* least distinguishing suffixes of two fspaths, for displaying in the user *) (* interface. *) let differentSuffix (Fspath f1) (Fspath f2) = if isRootDir f1 or isRootDir f2 then (f1,f2) else begin (* We use the invariant that neither f1 nor f2 ends in slash *) let len1 = String.length f1 in let len2 = String.length f2 in let n = (* The position of the character from the right where the fspaths *) (* differ *) let rec loop n = let i1 = len1-n in if i1<0 then n+1 else let i2 = len2-n in if i2<0 then n+1 else if compare (String.get f1 i1) (String.get f2 i2) = 0 then loop (n+1) else n in loop 1 in let suffix f len = try let n' = String.rindex_from f (len-n) '/' in String.sub f (n'+1) (len-n'-1) with _ -> f in let s1 = suffix f1 len1 in let s2 = suffix f2 len2 in (s1,s2) end (* When an HFS file is stored on a non-HFS system it is stored as two files, the data fork, and the rest of the file including resource fork is stored in the AppleDouble file, which has the same name as the data fork file with ._ prepended. *) let appleDouble (Fspath f) = if isRootDir f then raise(Invalid_argument "Fspath.appleDouble") else let len = String.length f in let i = String.rindex f '/' in let before = String.sub f 0 i in let after = String.sub f (i+1) (len-i-1) in Fspath(before^"/._"^after) let rsrc (Fspath f) = if isRootDir f then raise(Invalid_argument "Fspath.appleDouble") else Fspath(f^"/..namedfork/rsrc") (* WRAPPED SYSTEM CALLS *) (* CAREFUL! Windows porting issue: Unix.LargeFile.stat "c:\\windows\\" will fail, you must use Unix.LargeFile.stat "c:\\windows" instead. The standard file selection dialog, however, will return a directory with a trailing backslash. Therefore, be careful to remove a trailing slash or backslash before calling this in Windows. BUT Windows shares are weird! //raptor/trevor and //raptor/trevor/mirror are directories and //raptor/trevor/.bashrc is a file. We observe the following: Unix.LargeFile.stat "//raptor" will fail. Unix.LargeFile.stat "//raptor/" will fail. Unix.LargeFile.stat "//raptor/trevor" will fail. Unix.LargeFile.stat "//raptor/trevor/" will succeed. Unix.LargeFile.stat "//raptor/trevor/mirror" will succeed. Unix.LargeFile.stat "//raptor/trevor/mirror/" will fail. Unix.LargeFile.stat "//raptor/trevor/.bashrc/" will fail. Unix.LargeFile.stat "//raptor/trevor/.bashrc" will succeed. Not sure what happens for, e.g., Unix.LargeFile.stat "//raptor/FOO" where //raptor/FOO is a file. I guess the best we can do is: To stat //host/xxx, assume xxx is a directory, and use Unix.LargeFile.stat "//host/xxx/". If xxx is not a directory, who knows. To stat //host/path where path has length >1, don't use a trailing slash. The way I did this was to assume //host/xxx/ is a root directory. Then by the invariants of fspath it should always end in /. Unix.LargeFile.stat "c:" will fail. Unix.LargeFile.stat "c:/" will succeed. Unix.LargeFile.stat "c://" will fail. (The Unix version of ocaml handles either a trailing slash or no trailing slash.) *) (* Invariant on fspath will guarantee that argument is OK for stat *) let stat (Fspath f) = Unix.LargeFile.stat f let lstat (Fspath f) = Unix.LargeFile.lstat f (* HACK: Under Windows 98, Unix.opendir "c:/" fails Unix.opendir "c:/*" works Unix.opendir "/" fails Under Windows 2000, Unix.opendir "c:/" works Unix.opendir "c:/*" fails Unix.opendir "/" fails Unix.opendir "c:" works as well, but, this refers to the current working directory AFAIK. *) let opendir (Fspath d) = if Util.osType<>`Win32 || not(isRootDir d) then Unix.opendir d else try Unix.opendir d with Unix.Unix_error _ -> Unix.opendir (d^"*") let child (Fspath f) n = (* Note, f is not "" by invariants on Fspath *) if (* We use the invariant that f ends in / iff f is a root filename *) isRootDir f then Fspath(Printf.sprintf "%s%s" f (Name.toString n)) else Fspath (Printf.sprintf "%s%c%s" f '/' (Name.toString n)) let concat fspath path = if Path.isEmpty path then fspath else begin let Fspath fspath = fspath in if (* We use the invariant that f ends in / iff f is a root filename *) isRootDir fspath then Fspath (fspath ^ Path.toString path) else let p = Path.toString path in let l = String.length fspath in let l' = String.length p in let s = String.create (l + l' + 1) in String.blit fspath 0 s 0 l; s.[l] <- '/'; String.blit p 0 s (l + 1) l'; Fspath s end (* Filename.dirname is screwed up in Windows so we use this function. It *) (* assumes that path separators are slashes. *) let winBadDirnameArg = Rx.rx "[a-zA-Z]:/[^/]*" let myDirname s = if Util.osType=`Win32 && Rx.match_string winBadDirnameArg s then String.sub s 0 3 else Filename.dirname s (*****************************************************************************) (* CANONIZING PATHS *) (*****************************************************************************) (* Convert a string to an fspath. HELP ENFORCE INVARIANTS listed above. *) let localString2fspath s = (* Force path separators to be slashes in Windows, handle weirdness in *) (* Windows network names *) let s = if Util.osType = `Win32 then winRootFix (Fileutil.backslashes2forwardslashes s) else s in (* Note: s may still contain backslashes under Unix *) if isRootDir s then Fspath s else if String.length s > 0 then let s' = Fileutil.removeTrailingSlashes s in if String.length s' = 0 then Fspath "/" (* E.g., s="///" *) else Fspath s' else (* Prevent Fspath "" *) raise(Invalid_argument "Os.localString2fspath") (* Return the canonical fspath of a filename (string), relative to the *) (* current host, current directory. *) (* THIS IS A HACK. It has to take account of some porting issues between *) (* the Unix and Windows versions of ocaml, etc. In particular, the Unix, *) (* Filename, and Sys modules of ocaml have subtle differences under Windows *) (* and Unix. So, be very careful with any changes !!! *) let canonizeFspath p0 = let p = match p0 with None -> "." | Some "" -> "." | Some s -> s in let p' = begin let original = Sys.getcwd() in try let newp = (Sys.chdir p; (* This might raise Sys_error *) Sys.getcwd()) in Sys.chdir original; newp with Sys_error why -> (* We could not chdir to p. Either *) (* - *) (* (1) p does not exist *) (* (2) p is a file *) (* (3) p is a dir but we don't have permission *) (* - *) (* In any case, we try to cd to the parent of p, and if that *) (* fails, we just quit. This works nicely for most cases of (1), *) (* it works for (2), and on (3) it may leave a mess for someone *) (* else to pick up. *) let p = if Util.osType = `Win32 then Fileutil.backslashes2forwardslashes p else p in if isRootDir p then raise (Util.Fatal (Printf.sprintf "Cannot find canonical name of root directory %s\n(%s)" p why)); let parent = myDirname p in let parent' = begin (try Sys.chdir parent with Sys_error why2 -> raise (Util.Fatal (Printf.sprintf "Cannot find canonical name of %s: unable to cd either to it\n (%s)\nor to its parent %s\n(%s)" p why parent why2))); Sys.getcwd() end in Sys.chdir original; let bn = Filename.basename p in if bn="" then parent' else toString(child (localString2fspath parent') (Name.fromString bn)) end in localString2fspath p' (* (* TJ--I'm disabling this for now. It is causing directories to be created *) (* with the wrong case, e.g., an upper case directory that needs to be *) (* propagated will be created with a lower case name. We'll see if the *) (* weird problem with changing case is still happening. *) if Util.osType<>`Win32 then localString2fspath p' else (* A strange bug turns up in Windows: sometimes p' has mixed case, *) (* sometimes it is all lower case. (Sys.getcwd seems to make a random *) (* choice.) Since file names are not case-sensitive in Windows we just *) (* force everything to lower case. *) (* NOTE: WE DON'T ENFORCE THAT FSPATHS CREATED BY CHILDFSPATH ARE ALL *) (* LOWER CASE!! *) let p' = String.lowercase p' in localString2fspath p' *) let canonize x = Util.convertUnixErrorsToFatal "canonizing path" (fun () -> canonizeFspath x) let concatToString fspath path = toString (concat fspath path) let maxlinks = 100 let findWorkingDir fspath path = let abspath = concatToString fspath path in let realpath = if not (Path.followLink path) then abspath else let rec followlinks n p = if n>=maxlinks then raise (Util.Transient (Printf.sprintf "Too many symbolic links from %s" abspath)); try let link = Unix.readlink p in let linkabs = if Filename.is_relative link then Filename.concat (Filename.dirname p) link else link in followlinks (n+1) linkabs with Unix.Unix_error _ -> p in followlinks 0 abspath in if isRootDir realpath then raise (Util.Transient(Printf.sprintf "The path %s is a root directory" abspath)); let realpath = Fileutil.removeTrailingSlashes realpath in let p = Filename.basename realpath in debug (fun() -> Util.msg "Os.findWorkingDir(%s,%s) = (%s,%s)\n" (toString fspath) (Path.toString path) (myDirname realpath) p); (localString2fspath (myDirname realpath), Path.fromString p) unison-2.32.52/fspath.mli0000644000076500000000000000252411176730177014637 0ustar bcpiercewheel(* 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 unison-2.32.52/globals.ml0000644000076500000000000002602711176730177014630 0ustar bcpiercewheel(* Unison file synchronizer: src/globals.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) open Common let debug = Trace.debug "globals" (*****************************************************************************) (* ROOTS and PATHS *) (*****************************************************************************) let rawroots = Prefs.createStringList "root" "root of a replica (should be used exactly twice)" ("Each use of this preference names the root of one of the replicas " ^ "for Unison to synchronize. Exactly two roots are needed, so normal " ^ "modes of usage are either to give two values for \\verb|root| in the " ^ "profile, or to give no values in the profile and provide two " ^ "on the command line. " ^ "Details of the syntax of roots can be found in " ^ "\\sectionref{roots}{Roots}.\n\n" ^ "The two roots can be given in either order; Unison will sort them " ^ "into a canonical order before doing anything else. It also tries to " ^ "`canonize' the machine names and paths that appear in the roots, so " ^ "that, if Unison is invoked later with a slightly different name " ^ "for the same root, it will be able to locate the correct archives.") let setRawRoots l = Prefs.set rawroots l let rawRoots () = Prefs.read rawroots let rootsInitialName () = match rawRoots () with [r2; r1] -> (r1, r2) | _ -> assert false let theroots = ref [] open Lwt let installRoots termInteract = let roots = rawRoots () in if Safelist.length roots <> 2 then raise (Util.Fatal (Printf.sprintf "Wrong number of roots: 2 expected, but %d provided (%s)\n(Maybe you specified roots both on the command line and in the profile?)" (Safelist.length roots) (String.concat ", " roots) )); Safelist.fold_right (fun r cont -> Remote.canonizeRoot r (Clroot.parseRoot r) termInteract >>= (fun r' -> cont >>= (fun l -> return (r' :: l)))) roots (return []) >>= (fun roots' -> theroots := Safelist.rev roots'; return ()) (* Alternate interface, should replace old interface eventually *) let installRoots2 () = debug (fun () -> Util.msg "Installing roots..."); let roots = rawRoots () in theroots := Safelist.map Remote.canonize ((Safelist.map Clroot.parseRoot) roots); theroots := Safelist.rev !theroots (* Not sure why this is needed... *) let roots () = match !theroots with [root1;root2] -> (root1,root2) | _ -> assert false let rootsList() = !theroots let rootsInCanonicalOrder() = Common.sortRoots (!theroots) let reorderCanonicalListToUsersOrder l = if rootsList() = rootsInCanonicalOrder() then l else Safelist.rev l let rec nice_rec i : unit Lwt.t = if i <= 0 then Lwt.return () else Lwt_unix.yield() >>= (fun () -> nice_rec (i - 1)) (* [nice r] yields 5 times on local roots [r] to give processes corresponding to remote roots a chance to run *) let nice r = if List.exists (fun r -> fst r <> Local) (rootsList ()) && fst r = Local then nice_rec 5 else Lwt.return () let allRootsIter f = Lwt_util.iter (fun r -> nice r >>= (fun () -> f r)) (rootsInCanonicalOrder ()) let allRootsIter2 f l = let l = Safelist.combine (rootsList ()) l in Lwt_util.iter (fun (r, v) -> nice r >>= (fun () -> f r v)) (Safelist.sort (fun (r, _) (r', _) -> Common.compareRoots r r') l) let allRootsMap f = Lwt_util.map (fun r -> nice r >>= (fun () -> f r >>= (fun v -> return (r, v)))) (rootsInCanonicalOrder ()) >>= (fun l -> return (Safelist.map snd (reorderCanonicalListToUsersOrder l))) let allRootsMapWithWaitingAction f wa = Lwt_util.map_with_waiting_action (fun r -> nice r >>= (fun () -> f r >>= (fun v -> return (r, v)))) (fun r -> wa r) (rootsInCanonicalOrder ()) >>= (fun l -> return (Safelist.map snd (reorderCanonicalListToUsersOrder l))) let replicaHostnames () = Safelist.map (function (Local, _) -> "" | (Remote h,_) -> h) (rootsList()) let allHostsIter f = let rec iter l = match l with [] -> return () | root :: rem -> f root >>= (fun () -> iter rem) in iter (replicaHostnames ()) let allHostsMap f = Safelist.map f (replicaHostnames()) let paths = Prefs.create "path" [] "path to synchronize" ("When no \\verb|path| preference is given, Unison will simply synchronize " ^ "the two entire replicas, beginning from the given pair of roots. " ^ "If one or more \\verb|path| preferences are given, then Unison will " ^ "synchronize only these paths and their children. (This is useful " ^ "for doing a fast sync of just one directory, for example.) " ^ "Note that {\\tt path} preferences are intepreted literally---they " ^ "are not regular expressions.") (fun oldpaths string -> Safelist.append oldpaths [Path.fromString string]) (fun l -> Safelist.map Path.toString l) (* FIX: this does weird things in case-insensitive mode... *) let globPath lr p = let p = Path.magic p in debug (fun() -> Util.msg "Checking path '%s' for expansions\n" (Path.toDebugString p) ); match Path.deconstructRev p with Some(n,parent) when (Name.toString n = "*") -> begin debug (fun() -> Util.msg "Expanding path %s\n" (Path.toString p)); match lr with None -> raise (Util.Fatal (Printf.sprintf "Path %s ends with *, %s" (Path.toString p) "but first root (after canonizing) is non-local")) | Some lrfspath -> Safelist.map (fun c -> Path.magic' (Path.child parent c)) (Os.childrenOf lrfspath parent) end | _ -> [Path.magic' p] let expandWildcardPaths() = let lr = match rootsInCanonicalOrder() with [(Local, fspath); _] -> Some fspath | _ -> None in Prefs.set paths (Safelist.flatten_map (globPath lr) (Prefs.read paths)) (*****************************************************************************) (* PROPAGATION OF PREFERENCES *) (*****************************************************************************) let propagatePrefsTo = Remote.registerHostCmd "installPrefs" (fun prefs -> return (Prefs.load prefs)) let propagatePrefs () = let prefs = Prefs.dump() in let toHost root = match root with (Local, _) -> return () | (Remote host,_) -> propagatePrefsTo host prefs in allRootsIter toHost (*****************************************************************************) (* PREFERENCES AND PREDICATES *) (*****************************************************************************) let batch = Prefs.createBool "batch" false "batch mode: ask no questions at all" ("When this is set to {\\tt true}, the user " ^ "interface will ask no questions at all. Non-conflicting changes " ^ "will be propagated; conflicts will be skipped.") let confirmBigDeletes = Prefs.createBool "confirmbigdel" true "!ask about whole-replica (or path) deletes" ("!When this is set to {\\tt true}, Unison will request an extra confirmation if it appears " ^ "that the entire replica has been deleted, before propagating the change. If the {\\tt batch} " ^ "flag is also set, synchronization will be aborted. When the {\\tt path} preference is used, " ^ "the same confirmation will be requested for top-level paths. (At the moment, this flag only " ^ "affects the text user interface.) See also the {\\tt mountpoint} preference.") let () = Prefs.alias confirmBigDeletes "confirmbigdeletes" let ignore = Pred.create "ignore" ("Including the preference \\texttt{-ignore \\ARG{pathspec}} causes Unison to " ^ "completely ignore paths that match \\ARG{pathspec} (as well as their " ^ "children). This is useful for avoiding synchronizing temporary " ^ "files, object files, etc. The syntax of \\ARG{pathspec} is " ^ "described in \\sectionref{pathspec}{Path Specification}, and further " ^ "details on ignoring paths is found in" ^ " \\sectionref{ignore}{Ignoring Paths}.") let ignorenot = Pred.create "ignorenot" ("This preference overrides the preference \\texttt{ignore}. It gives a list of patterns (in the same format as \\verb|ignore|) for paths that should definitely {\\em not} be ignored, whether or not they happen to match one of the \\verb|ignore| patterns. \\par Note that the semantics of {\\tt ignore} and {\\tt ignorenot} is a little counter-intuitive. When detecting updates, Unison examines paths in depth-first order, starting from the roots of the replicas and working downwards. Before examining each path, it checks whether it matches {\\tt ignore} and does not match {\\tt ignorenot}; in this case it skips this path {\\em and all its descendants}. This means that, if some parent of a given path matches an {\\tt ignore} pattern, then it will be skipped even if the path itself matches an {\\tt ignorenot} pattern. In particular, putting {\\tt ignore = Path *} in your profile and then using {\tt ignorenot} to select particular paths to be synchronized will not work. Instead, you should use the {\\tt path} preference to choose particular paths to synchronize.") let shouldIgnore p = let p = Path.toString p in (Pred.test ignore p) && not (Pred.test ignorenot p) let addRegexpToIgnore re = let oldRE = Pred.extern ignore in let newRE = re::oldRE in Pred.intern ignore newRE let merge = Pred.create "merge" ~advanced:true ("This preference can be used to run a merge program which will create " ^ "a new version for each of the files and the backup, " ^ "with the last backup and the both replicas. Setting the {\\tt merge} " ^ "preference for a path will also cause this path to be backed up, " ^ "just like {\tt backup}. " ^ "The syntax of \\ARG{pathspec>cmd} is " ^ "described in \\sectionref{pathspec}{Path Specification}, and further " ^ "details on Merging functions are present in " ^ "\\sectionref{merge}{Merging files}.") let shouldMerge p = Pred.test merge (Path.toString p) let mergeCmdForPath p = Pred.assoc merge (Path.toString p) let someHostIsRunningWindows = Prefs.createBool "someHostIsRunningWindows" false "*" "" let allHostsAreRunningWindows = Prefs.createBool "allHostsAreRunningWindows" false "*" "" unison-2.32.52/globals.mli0000644000076500000000000000733111176730177014776 0ustar bcpiercewheel(* 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 unison-2.32.52/INSTALL0000644000076500000000000002221211176730177013674 0ustar bcpiercewheel Installation Unison is designed to be easy to install. The following sequence of steps should get you a fully working installation in a few minutes. (If you run into trouble, you may find the suggestions in the section ``FAQ'' helpful.) Unison can be used with either of two user interfaces: 1. a simple textual interface, suitable for dumb terminals (and running from scripts), and 2. a more sophisticated grapical interface, based on Gtk. You will need to install a copy of Unison on every machine that you want to synchronize. However, you only need the version with a graphical user interface (if you want a GUI at all) on the machine where you're actually going to display the interface (the CLIENT machine). Other machines that you synchronize with can get along just fine with the textual version. Downloading Unison If a pre-built binary of Unison is available for the client machine's architecture, just download it and put it somewhere in your search path (if you're going to invoke it from the command line) or on your desktop (if you'll be click-starting it). The executable file for the graphical version (with a name including gtkui) actually provides both interfaces: the graphical one appears by default, while the textual interface can be selected by including -ui text on the command line. The textui executable provides just the textual interface. If you don't see a pre-built executable for your architecture, you'll need to build it yourself. See the section ``Building Unison'' . (There are also a small number of ``contributed ports'' to other architectures that are not maintained by us. See the section ``Contributed Ports'' to check what's available.) Check to make sure that what you have downloaded is really executable. Either click-start it, or type "unison -version" at the command line. Unison can be used in several different modes: with different directories on a single machine, with a remote machine over a direct socket connection, with a remote machine using rsh (on Unix systems), or with a remote Unix system (from either a Unix or a Windows client) using ssh for authentication and secure transfer. If you intend to use the last option, you may need to install ssh; see the section ``Installing Ssh'' . Running Unison Once you've got Unison installed on at least one system, read the section ``Tutorial'' of the user manual (or type "unison -doc tutorial") for instructions on how to get started. Upgrading Upgrading to a new version of Unison should be as simple as throwing away the old binary and installing the new one. Before upgrading, it is a good idea to use the old version to make sure all your replicas are completely synchronized. A new version of Unison will sometimes introduce a different format for the archive files used to remember information about the previous state of the replicas. In this case, the old archive will be ignored (not deleted --- if you roll back to the previous version of Unison, you will find the old archives intact), which means that any differences between the replicas will show up as conflicts and need to be resolved manually. Contributed Ports A few people have offered to maintain pre-built executables, easy installation scripts, etc., for particular architectures. They are not maintained by us and are not guaranteed to work, be kept up to date with our latest releases, etc., but you may find them useful. Here's what's available at the moment: * Dan Pelleg (mailto:daniel+upenn@pelleg.org) has ported unison to FreeBSD. This means that any FreeBSD user with an up-to-date ``ports'' collection can install unison by doing: cd /usr/ports/net/unison; make && make install. (Make sure your ``ports'' collection is fully up to date before doing this, to ensure that you get the most recent Unison version that has been compiled for FreeBSD.) FreeBSD binaries can also be obtained directly from http://www.freebsd.org/cgi/ports.cgi?query=unison&stype=all. * Andrew Pitts has built binaries for some versions of Unison for the Linux-PPC platform. They can be found in ftp://ftp.cl.cam.ac.uk/papers/amp12/unison/. * Robert McQueen (mailto:robot101@debian.org) maintains a Debian package for Unison. The homepage is located at http://packages.debian.org/testing/non-us/unison.html. * Chris Cocosco (mailto:crisco+unison@bic.mni.mcgill.ca) provides binaries for Unison under SGI IRIX (6.5). They can be found in www.bic.mni.mcgill.ca/users/crisco/unison.irix/. Building Unison from Scratch If a pre-built image is not available, you will need to compile it from scratch; the sources are available from the same place as the binaries. In principle, Unison should work on any platform to which OCaml has been ported and on which the Unix module is fully implemented. In particular, it has been tested on many flavors of Windows (98, NT, 2000) and Unix (Solaris, Linux, FreeBSD), and on both 32- and 64-bit architectures. Unison partly works on Mac OSX (see the section ``FAQ'' for caveats); it does not work on earlier MacOS systems. Unix You'll need the Objective Caml compiler (version 3.04 or later[1]1), which is available from its official site http://caml.inria.fr. Building and installing OCaml on Unix systems is very straightforward; follow the instructions in the distribution. You'll probably want to build the native-code compiler in addition to the bytecode compiler, but this is not absolutely necessary. (Quick start: on many systems, the following sequence of commands will get you a working and installed compiler: first do make world opt, then su to root, then do make install.) You'll also need the GNU make utility, standard on many Unix systems. (Type "make --version" to check that you've got the GNU version.) Once you've got OCaml installed, grab a copy of the Unison sources, unzip and untar them, change to the new "unison" directory, and type make UISTYLE=text The result should be an executable file called "unison". Type "./unison" to make sure the program is executable. You should get back a usage message. If you want to build a graphical user interface, choose one of the following: * Gtk interface: You will need Gtk (version 1.2 or later, available from http://www.gtk.org and standard on many Unix installations). You also need the get LablGtk (version 1.1.3 is known to work). Grab the developers' tarball from http://wwwfun.kurims.kyoto-u.ac.jp/soft/olabl/lablgtk.html, untar it, and follow the instructions to build and install it. (Quick start: make configure, then make, then make opt, then su and make install.) Now build unison. If your search paths are set up correctly, typing make UISTYLE=gtk2 should build a unison executable with a Gtk graphical interface. If this step does not work, don't worry: Unison works fine with the textual interface. Put the unison executable somewhere in your search path, either by adding the Unison directory to your PATH variable or by copying the executable to some standard directory where executables are stored. Windows Although the binary distribution should work on any version of Windows, some people may want to build Unison from scratch on those systems too. Bytecode version: The simpler but slower compilation option to build a Unison executable is to build a bytecode version. You need first install Windows version of the OCaml compiler (version 3.04 or later, available from http://caml.inria.fr). Then grab a copy of Unison sources and type make UISTYLE=text NATIVE=false to compile the bytecode. The result should be an executable file called unison.exe. Native version: To build a more efficient, native version of Unison on Windows, you can choose between two options. Both options require the OCaml distribution version 3.04 as well as the Cygwin layer, which provides certain GNU tools. The two options differ in the C compiler employed: MS Visual C++ (MSVC) vs. Cygwin GNU C. The tradeoff? * Only the MSVC option can produce statically linked Unison executable. * The Cygwin GNU C option requires only free software. The files ``INSTALL.win32-msvc'' and ``INSTALL.win32-cygwin-gnuc'' describe the building procedures for the respective options. Installation Options The Makefile in the distribution includes several switches that can be used to control how Unison is built. Here are the most useful ones: * Building with NATIVE=true uses the native-code OCaml compiler, yielding an executable that will run quite a bit faster. We use this for building distribution versions. * Building with make DEBUGGING=true generates debugging symbols. * Building with make STATIC=true generates a (mostly) statically linked executable. We use this for building distribution versions, for portability. unison-2.32.52/INSTALL.gtk20000644000076500000000000000303711176730177014546 0ustar bcpiercewheelWe are happy to announce a new version of Unison with a user interface based on Gtk 2.2, enabling display of filenames with any locale encoding. Installation instructions follow: ----------------------------- LINUX (and maybe other Unixes): In order to use gtk2 with unison, 1) install glib, pango, gtk (version >2.2) from http://www.gtk.org/ 2) install lablgtk2 (version >20030423) from http://wwwfun.kurims.kyoto-u.ac.jp/soft/olabl/lablgtk.html 3) install unison (version >2.9.36) from http://www.cis.upenn.edu/~bcpierce/unison/ Simply type 'make'. Makefile will detect the presence of lablgtk2 directory $(OCAMLLIBDIR)/lablgtk2 (such as /usr/local/lib/ocaml/lablgtk2/) and use UISTYLE=gtk2 by default. If absent, it falls back to lablgtk with UISTYLE=gtk, then back to UISTYLE=text. You can force the selection by make UISTYLE=gtk2 or make UISTYLE=gtk or make UISTYLE=text 4) setup your locale environment properly for example, export LANG=zh_HK.BIG5-HKSCS otherwise, you will get Uncaught exception Glib.GError("Invalid byte sequence in conversion input") 5) enjoy unison with i18n! ----------------------------- OS X: 1) Install gtk2 using fink: sudo /sw/bin/fink install gtk+2 Then proceed from step 2 above. In our tests, the linker generates lots of error messages, but appears to build a working executable. Also, we have not yet been able to get this build to work with 'STATIC=true'. ----------------------------- WINDOWS: (Anybody want to contribute instructions??) unison-2.32.52/INSTALL.win320000644000076500000000000000110611176730177014634 0ustar bcpiercewheelInstallation notes to build Unison on Windows systems We provide two options for building Unison on MS Windows. Both options require the Cygwin layer to be able to use a few GNU tools as well as the OCaml distribution version. The options differ in the C compiler employed: MS Visual C++ (MSVC) vs Cygwin GNU C. Tradeoff? . Only the MSVC option can produce statically linked Unison executable. . The Cygwin GNU C option requires only free software. The files "INSTALL.win32-msvc" and "INSTALL.win32-cygwin-gnuc" describe the building procedures for the respective options. unison-2.32.52/INSTALL.win32-cygwin-gnuc0000644000076500000000000001360111176730177017067 0ustar bcpiercewheelInstallation notes to build Unison on Windows systems, with Cygwin GNU C (unison-help@cis.upenn.edu) [The following instructions were tested for Unison 2.9.1 on a Windows XP machine running OCaml 3.08.] Since OCaml is now included in Cygwin, things have gotten pretty simple (at least for the text user interface). - Download and run the cygwin installer - make sure to select the make (from Devel) and ocaml (from Interpreters) packages; you may also want the subversion package, if you intend to check out the latest unison sources from the live subversion repository. - Download the desired version of the Unison source tarball from the Unison home page and unpack it, or else grab the sources using svn. - In the main directory, type "make" - The result should be an executable file called "unison" (or, if you grabbed the whole svn repository, perhaps "src/unison"). Put this somewhere on your search path and you should be good to go. (You'll need to do something about setting up ssh, etc., but that's beyond the scope of this document.) ------------------------------------------------------------------------- AN OLDER VERSION: [The following instructions were tested for Unison 2.9.1 on a Windows 2000 machine running OCaml 3.04.] Contents 1.Setting up the Windows system 1.1 General requirements 1.2 A Unix-like layer: CygWin and GNU C compiler 1.3 The OCaml compiler 2.Compiling Unison 2.1 Text user interface 2.2 Gtk user interface Section 1 - Setting up the Windows system 1.1 General requirements We will assume your are logged in as a regular user. We will mention cases when you need to be granted administrator permissions. We will work in your home directory. For a complete installation from scratch, you will need about 300 Mb. A Unix-like layer such as CygWin is needed to be able to use a few GNU tools like 'bash', 'make', 'sed', 'patch', etc, and in particular the GNU C compiler. The CygWin port of OCaml distribution version 3.04 is required. .2 A Unix-like layer: CygWin Download CygWin from 'http://www.cygwin.com/': * click "install cygwin now" and follow the instruction to set up cygwin. install the essential packages such as "gcc", "make", "fileutil", "openssh", etc. set the root directory (e.g. 'd:\cygwin') Setup 'bash': * click on 'bash'. * enter 'export HOME=/home/', make the directory, then 'cd'. * create a '.bashrc' in CygWin's root directory to suit your needs (see Appendix B of file "INSTALL.win32-msvc" for an example). * add 'export OSCOMP=cygwingnuc' to the '.bashrc' file. This variable helps the unison Makefile (project file) to understand that we are compiling under Windows platform using Cygwin GNU C. Remember you can access the whole Windows filesystem with a Unix path through '/cygdrive//' (e.g. '/cygdrive/c/winnt' stands for 'C:\WinNT') 1.3 The OCaml compiler (CygWin port) NB: Unison doesn't use Tcl/Tk support. If you wish to use Tcl/Tk for your other Ocaml applications, download it separately before proceeding. Download the OCaml 3.04 source tarball from 'http://caml.inria.fr/ocaml/distrib.html'. Unpack it into a directory (using, e.g., winzip, or "tar xzvf ocaml-3.04.tar.gz" Enter the ocaml directory, and type: $ ./configure # or "./configure -prefix ". # For other options, see INSTALL $ make world $ make opt $ make install To check your installation, use 'bash' and enter 'ocamlc -v' If something goes wrong : * your path must contain the OCaml 'bin' directory; you may have to enter something like 'export PATH=$PATH:/usr/local/ocaml/bin'. * 'ocamlc -v' must report the OCaml 'lib' directory; you may have to enter something like 'export CAMLLIB=/usr/local/ocaml/lib/ocaml/' Section 2 - Compiling Unison 2.1 Text user interface Unpack the Unison sources. Using 'bash', enter 'make clean', then 'make UISTYLE=text' to compile. If something goes wrong : * if 'make' reports 'missing separator', be sure the makefiles are in Unix text format (see Appendix A). * if .depend is not provided, create one using 'ocamldep *.mli *.ml > .depend'; you will have to convert this file to Unix text format (see Appendix A). * the minor 'etags' error is reported when 'emacs' is missing; you may want to install it. 2.2 Gtk user interface 2.2.1 Install LablGtk 1.2.3 (cygwin port) Download the patched LablGtk 1.2.3 (bundled with the Gtk libraries): get the 'lablgtk-1.2.3-cygwin.tar.gz' tar ball from the 'resources' directory of the Unison web site and unpack it. This will create a 'lablgtk-1.2.3-cygwin' directory. Enter the directory 'lablgtk-1.2.3-cygwin/lablgtk', and type: $ make $ make opt $ make install Finally, add the result of running echo `ocamlc -where`/lablgtk/dlls to the environment variable PATH.* * Under Windows menu: Start -> Settings -> Control Panel -> System -> Advanced -> Environment Variables. OPTIONAL: At this stage, you can test the installation of lablgtk by $ cd lablgtk-1.2.3-cygwin/lablgtk-1.2.3/examples $ lablgtk .ml 2.2.2 Compiling Unison To compile the gtk version of Unison, enter the Unison sources directory, enter "make clean" and then "make UISTYLE=gtk". The resulting executable is dynamically linked against the CygWin runtime and the Gtk DLLs. If you would like to distribute this executable, you should provide the following DLLs (found in /bin under the cygwin root directory and the lablgtk/dlls directory obtained at the end of the lablgtk installation (Section 2.2.1), and ask the users to include them in the PATH. cygwin1.dll, gdk-1.3.dll, glib-1.3.dll, gtk-1.3.dll * The way to find out which DLL are used under windows: objdump -p | grep "DLL Name" unison-2.32.52/INSTALL.win32-msvc0000644000076500000000000004465011176730177015615 0ustar bcpiercewheelInstallation notes to build Unison on Windows systems, with Visual C++ [The following instructions were tested for Unison 2.9.1 on a Windows 2000 machine running OCaml 3.04 -- that was a long time ago, so there may be some discrepancies with current versions of things. If you notice any, please send a correction to unison-users@yahoogroups.com.] Contents 1.Setting up the Windows system 1.1 General requirements 1.2 A Unix-like layer: CygWin 1.3 Visual C++ 1.4 The OCaml compiler 2.Compiling Unison 2.1 Text user interface 2.2 Tk user interface 2.3 Gtk user interface 3.Using new public versions of Tk/Gtk/LablGtk 3.1 Using a new version of Tcl/Tk 3.2 Patching a new version of Gtk 3.3 Patching a new version of LablGtk 3.4 Making patches from the public sources Appendix A.Windows text format B.'.bashrc' C.Windows files and directories names D.Windows icons Section 1 - Setting up the Windows system 1.1 General requirements We will assume your are logged in as a regular user. We will mention cases when you need to be granted administrator permissions. We will work in your home directory. For a complete installation from scratch, you will need about 300 Mb. CygWin, a Unix-like layer, is needed to be able to use GNU tools like 'bash', 'make', 'sed', 'patch', etc. The native Win32 port of OCaml distribution version 3.04 is required. It itself requires Visual C++ 6.0. 1.2 A Unix-like layer: CygWin Download CygWin from 'http://www.cygwin.com/': * click "install cygwin now" and follow the instruction to set up cygwin. install the essential packages such as "make", "fileutil", "openssh", etc. set the root directory (e.g. 'd:\cygwin') Setup 'bash': * click on 'bash'. * enter 'export HOME=/home/', make the directory, then 'cd'. * create a '.bashrc' in CygWin's root directory to suit your needs (see Appendix B for an example). * check the environment variable OSTYPE with 'echo $OSTYPE'. If the result is not 'cygwin' or 'cygwin20', then add 'export OSTYPE=cygwin' to the '.bashrc' file. This variable helps the unison Makefile (project file) to understand that we are compiling under Windows platform. Remember you can access the whole Windows filesystem with a Unix path through '/cygdrive//' (e.g. '/cygdrive/c/winnt' stands for 'C:\WinNT') 1.3 Visual C++ Run the installation program from the CD with Administrator permissions. We only need Visual C++ and MsDN is not required. To check out your installation, use 'bash' to enter 'cl /?'. If something goes wrong : * your path must contain the Visual C++ 'bin' directory; you may have to enter something like 'export PATH=$PATH:/cygdrive/progra~1/micros~1/vc98/bin'. * your path must contain the Visual Studio '.dll' files' directory; you may have to enter something like 'export PATH=$PATH:/cygdrive/progra~1/micros~1/common/msdev98/bin'. * the Visual C++ compiler must be able to access the headers; you may have to enter something like 'export INCLUDE='C:\progra~1\micros~1\vc98\include'' (path between single quotes). * the Visual C++ linker must be able to access the libraries; you may have to enter something like 'export LIB='C:\progra~1\micros~1\vc98\lib'' (path between single quotes). 1.4 The OCaml compiler Download the Native Win32 port of OCaml 3.04 from 'http://caml.inria.fr/ocaml/distrib.html'. It's a self-extracting binary. Run it with Administrator permissions (only use 8 characters-long names in the installation directory). To check out your installation, use 'bash' to enter 'ocamlc -v'. If something goes wrong : * your path must contain the OCaml 'bin' directory; you may have to enter something like 'export PATH=$PATH:/cygdrive/c/ocaml/bin'. * 'ocamlc -v' must report the OCaml 'lib' directory; you may have to enter something like "export CAMLLIB='C:\ocaml\lib'" (path between single quotes). 1.5 Microsoft Macro Assembler (MASM32) Download MASM32 from http://www.masm32.com/masmdl.htm, unzip and install it. Add the MASM32 bin directory (e.g. C:\masm32\bin) to your Path. Test the assembler with ml Your shell should answer with Microsoft (R) Macro Assembler Version 6.14.8444 Copyright (C) Microsoft Corp 1981-1997. All rights reserved. usage: ML [ options ] filelist [ /link linkoptions] Run "ML /help" or "ML /?" for more info Section 2 - Compiling Unison 2.1 Text user interface Unpack the Unison sources. Using 'bash', enter 'make clean', then 'make UISTYLE=text' to compile. If something goes wrong : * if 'make' reports 'missing separator', be sure the makefiles are in Unix text format (see Appendix A). * if .depend is not provided, create one using 'ocamldep *.mli *.ml > .depend'; you will have to convert this file to Unix text format (see Appendix A). * the minor 'etags' error is reported when 'emacs' is missing; you may want to install it. 2.2 Gtk user interface You need the Gtk libraries (already installed if you got the Tcl/Tk libraries). Get the 'guilib.tar.gz' tarball from the 'resources' directory of the Unison web site and unpack it in your Ocaml 'lib' directory. This will create a 'guilib' directory containing the libraries. Now you need the LablGtk extension to OCaml. First, the Gtk development package is required. Get the 'wingtk.patched.tar.gz' tarball from the 'resources' directory of the Unison web site and unpack it. This will create a 'wingtk' directory. Now, get the 'lablgtk-1.2.3-msvc-static.tar.gz' tarball from the 'resources' directory of the Unison web site and unpack it somewhere (a building location, just for the compilation). This will create a 'lablgtk-1.2.3-static' directory. Edit the 'config.make.nt' file to set up the access path to your OCaml 'lib' directory and to the 'wingtk' directory you created in the previous step. In 'lablgtk-1.2.3-static/src', run 'nmake -f Makefile.nt'. If you can use the OCaml native-code compiler, run 'nmake -f Makefile.nt opt' too. If you can't, you probably need the MASM assembler, also available in the 'resources' directory of the Unison web site. If everything goes well, run 'nmake -f Makefile.nt install' to install the software. You may want to remove the compilation directory 'lablgtk-1.2.3-static'. Using 'bash' in the Unison sources directory, enter 'make clean' then 'make UISTYLE=gtk'. Run 'unison.exe' with the Gtk .dll's in your search path (they can be found in the 'guilib' directory), unless you built with the NATIVE=true option. "unison.exe" built with NATIVE=true option is statically linked. This means that the executable doesn't refer to Cygwin and Gtk DLLs, and can therefore be distributed as a standalone application. Section 3 - Using new public versions of Tk/Gtk/LablGtk 3.1 Patching a new version of Gtk Download the 'wingtk.patch.tar.gz' tarball from the 'resources' directory of the Unison web site and unpack it. Follow the instructions in the 'README.patch' file to download the Gtk sources, to patch them and to build the new static and dynamic libraries. Important: if a patch fails for any reason, try to apply the patches on a Unix system. Copy those new libraries to your 'ocaml/lib/guilib' directory, along with the .dll's (dynamic version). Using the new version of 'wingtk', recompile LablGtk (see section 2.3). 3.2 Patching a new version of LablGtk Download lablgtk-1.2.3.tar.gz from the LablGtk homepage . Unpack it. Download the 'lablgtk-1.2.3-msvc-static.patch.gz' from the 'resources' directory of the Unison web site. Apply the patch by typing: 'patch < lablgtk.patch' above the 'lablgtk' directory. Important: if a patch fails for any reason, try to apply the patches on a Unix system. 3.3 Making patches from the public sources The way from public Gtk/LablGtk sources to the provided Gtk/LablGtk dynamic/static extension has been somehow perilous. We strongly recommand using the provided sources and patches as a base for your further enhancements. To be exhaustive, here are the steps followed to create the provided sources (hoping it would help when trying to adapt a new version): WinGtk: * Download the Gtk win32 sources from 'http://www.gimp.org/~tml/gimp/win32//downloads.html'. We need 'glib-src-yyyymmdd' and 'gtk+-src-yyyymmdd' where 'yyyymmdd' is the release date. Version 2000/04/16 of these files was used. * We will make new Windows Makefiles from the old ones. Here is how to convert a Makefile: - change all '/MD' to '/MT' to use the same windows system libraries than ocaml (e.g. 'OPTIMIZE = -Ox -MD' becomes 'OPTIMIZE = -Ox -MT') - turns all '.dll' targets to '.lib' ones using 'MKLIB = lib /nologo /out:' you must remove all references to '.def' files you must remove all references to other '.lib' and '.res' but you will have to provide them when linking an executable later (e.g. glib-$(GLIB_VER).dll : $(glib_OBJECTS) glib.def $(CC) $(CFLAGS) -LD -Feglib-$(GLIB_VER).dll $(glib_OBJECTS) \ user32.lib advapi32.lib wsock32.lib $(LDFLAGS) /def:glib.def becomes: glib-$(GLIB_VER).lib : $(glib_OBJECTS) $(MKLIB)glib-$(GLIB_VER).lib $(glib_OBJECTS) ) - remove all '-GD' compilation flags (e.g. .c.obj : $(CC) $(CFLAGS) -GD -c -DGLIB_COMPILATION \ -DG_LOG_DOMAIN=g_log_domain_glib $< becomes: .c.obj : $(CC) $(CFLAGS) -c -DGLIB_COMPILATION \ -DG_LOG_DOMAIN=g_log_domain_glib $< ) - provides the right libraries when linking executables (e.g. testgtk.exe : gtk-$(GTK_VER).dll testgtk.obj $(CC) $(CFLAGS) testgtk.obj gtk-$(GTK_VER).lib \ ..\gdk\gdk-$(GTK_VER).lib $(GLIB)\glib-$(GLIB_VER).lib \ $(LDFLAGS) becomes: testgtk.exe : gtk-$(GTK_VER).lib testgtk.obj $(CC) $(CFLAGS) testgtk.obj gtk-$(GTK_VER).lib \ ..\gdk\gdk-$(GTK_VER).lib ..\gdk\win32\gdk-win32.lib \ $(GLIB)\glib-$(GLIB_VER).lib $(GLIB)\gmodule-$(GLIB_VER).lib \ user32.lib advapi32.lib wsock32.lib gdi32.lib imm32.lib \ shell32.lib ole32.lib ../gdk/win32/gdk.res $(LDFLAGS) ) * Convert 'glib/makefile.msc' and remove all references to the 'gthread' and 'pthread' directories and libraries from it (but keep 'gthread.obj'). * Erase the 'gthread' directory. * Comment out the '#include ' line in 'glib/gmodule/gmodule-win32.c'. * You should now be able to compile the 'glib' and 'gmodule' libraries by typing 'nmake -f '. You can test it with 'testglib' and the other test programs. Remember to provide those two libraries when linking programs. * In 'gtk+/config.h.win32', undefine the following variables by commenting out their definition lines: HAVE_WINTAB, ENABLE_NLS, HAVE_GETTEXT, HAVE_LIBINTL * Convert 'gtk+/gdk/win32/makefile.msc' and remove all references to 'WTKIT', 'wntab32x', 'INTL' and 'gnu-intl' from it. * In 'gtk+/gdk/win32/rc/gdk.rc', comment out ',BUILDNUMBER'. * In 'gtk+/gdk/win32/gdkcursor-win32.c', replace 'gdk_DLLInstance' by 'gdk_ProgInstance'. * You should now be able to compile 'gdk-win32.lib'. * Convert 'gtk+/gdk/makefile.msc' and remove all references to 'WTKIT', 'wntab32x', 'INTL' and 'gnu-intl' from it. Include 'gdk-win32.lib' as an object for the 'gdk' library. * You should now be able to compile the 'gdk' library. Remember to provide 'win32/gdk.res' as well as the 'gdk' library when linking programs. * Convert 'gtk+/gtk/makefile.msc' and remove all references to 'WTKIT', 'wntab32x', 'INTL', 'gnu-intl' and 'PTHREAD' from it. * Be sure to include all needed libraries in the '.exe' files' compilation command lines. In most case you need the following: gtk-$(GTK_VER).lib ..\gdk\gdk-$(GTK_VER).lib \ $(GLIB)\glib-$(GLIB_VER).lib $(GLIB)\gmodule-$(GLIB_VER).lib \ user32.lib advapi32.lib wsock32.lib gdi32.lib imm32.lib shell32.lib \ ole32.lib \ ../gdk/win32/gdk.res * You should now be able to compile the 'gtk' library. You can test it with 'testglib' and the other test programs. * With some cleaning of the Makefiles, it is also possible to build a dynamic version of the libraries, along with the .dll's, so that we finally obtain static/dynamic sources. * Make a patch with 'diff -Nr -C 5 ' (you have to use the GNU diffutils' 'diff'). You will apply the patch with 'patch -p1 < '. LablGtk: * Download LablGtk from 'http://www.gtk.org' or 'ftp://ftp.inria.fr/lang/caml-light/bazar-ocaml/'. * You can remove all subdirectories. * Edit 'config.make.nt' to include the right Gtk libraries. * Comment out all references to 'gutter' to be found in the sources with 'grep gutter *.h *.c *.mli *.ml'. * Compile with 'nmake -f Makefile.nt'. If you can use the OCaml native-code compiler, run 'nmake -f Makefile.nt opt' too. If you can't, you probably need the MASM assembler. It was downloaded from 'http://www.cs.uu.nl/wais/html/na-dir/assembly-language/x86/microsoft.html'. * Make a patch as for WinGtk. Appendix A - Windows text format Windows and Unix use different text file formats. This section explains how to convert a file from a format to another. A.1 Text format conversion In order to convert a dos text file to a unix text file, we have to remove all extra characters that are : * carriage return or CR or ^M (ctrl-M) or \x0d or \o13 or \r * dos end-of-file or SUB or ^Z (ctrl-Z) or \x1a or \o26 A.2 Conversion tools On a Unix-like top level (e.g any unix system or cygwin), you can use: * dos -> unix - tr -d '\15\32' < dosfile.txt > unixfile.txt - awk '{ sub("\r$", ""); print }' dosfile.txt > unixfile.txt - perl -p -e 's/\r$//' < dosfile.txt > unixfile.txt * unix -> dos - awk 'sub("$", "\r")' unixfile.txt > dosfile.txt - perl -p -e 's/$/\r/' < unixfile.txt > dosfile.txt You may want to use a short script like the following to convert more than one file at a time (doesn't work recursively; use at your own risk): #!/bin/sh echo dos2unix for F in "$@" do echo converting "$F" tr -d '\15\32' < $F > $F.tmp mv -f $F.tmp $F done A.3 Transmission issues If you transfer files using 'ftp' between a Unix system and a Windows system, be sure to run it in binary mode to disable any automatic conversion. To switch to binary mode, enter 'binary' (or simply 'bin'). Appendix B - '.bashrc'. Copy the following '.bashrc' as a base to your own one. Be sure this file is in Unix text format. # .bashrc # gommier@saul.cis.upenn.edu export HOME=/ export PS1="[\u@\h \w]$ " cd # Set up Path # $PATH currently contains the Windows Path converted to Unix path, export PATH=./:/bin:$PATH echo "Current path is :" echo $PATH echo " " # end Appendix C - Windows files and directories names Here are some general rules for applications creating names for directories and files or processing names supplied by the user: * Use any character in the current code page for a name, but do not use a path separator, a character in the range 0 through 31, or any character explicitly disallowed by the file system. A name can contain characters in the extended character set (128-255). * Use the backslash (\), the forward slash (/), or both to separate components in a path. No other character is acceptable as a path separator. Note that UNC names must adhere to the following format: \\server\share. * Use a period (.) as a directory component in a path to represent the current directory. * Use two consecutive periods (..) as a directory component in a path to represent the parent of the current directory. * Use a period (.) to separate the base file name from the extension in a directory name or file name. * Do not use the following characters in directory names or file names, because they are reserved: < > : " / \ | * Do not use device names, such as aux, con, lpt1, and prn, as file names or directory names. * Process a path as a null-terminated string. The maximum length for a path, including a trailing backslash, is given by MAX_PATH. * The Unicode versions of several functions permit paths that exceed the MAX_PATH length if the path has the "\\?\" prefix. The "\\?\" tells the function to turn off path parsing. However, each component in the path cannot be more than MAX_PATH characters long. Use the "\\?\" prefix with paths for local storage devices and the "\\?\UNC\" prefix with paths having the Universal Naming Convention (UNC) format. The "\\?\" is ignored as part of the path. For example, "\\?\C:\myworld\private" is seen as "C:\myworld\private", and "\\?\UNC\bill_g_1\hotstuff\coolapps" is seen as "\\bill_g_1\hotstuff\coolapps". * Do not assume case sensitivity. Consider names such as OSCAR, Oscar, and oscar to be the same. Appendix D - Windows icons Here are some general informations on how to make your Windows program have a nice icon. * What we mean by icon is a set of bitmaps that are displayed by Windows to represent your program on the desktop, on the top left corner of each window, etc. For your program's binary to include an icon, you will have to draw each bitmap and to store them in .bmp files, then to archive them in a .ico file, then to archive that icon file in a .res file along with other resources, and finally to link your program with that very .res file. * Current graphic formats for icons are 16 x 16, 32 x 32 and 48 x 48 pixels with 16 or 256 colors. One format must always exist for compatibility with all Windows versions: the 32 x 32 x 16 format. Furthermore, the colors refer to the standard palette (sometimes called www palette), which means you mustn't use optimized palette when turning RGB colors to indexed colors. If you need subtle nuances, remember you can interleave pixels of two different colors to create the impression of a third, average one. * Once your bitmaps are ready, you can use the Visual C++ IDE to create your .ico file. Use the resource tool bar to create a 'new icon'. Open your .bmp files and simply cut and paste them into the icon window. You have to select the proper device (or format) for each bitmap before achieving the copy. When your icon (i.e. set of bitmaps) is ready, right-click on the icon name in the resource list window to export it. Note: you should never trust that IDE when dealing with colors, since it seems to get quickly lost between 16 or 256 colors. * To include your icon into a resource file, add a line for it into the .rc script file and compile with rc to create the .res file. * Just add the .res file to the link command line to have your binary include the icon. unison-2.32.52/linkgtk.ml0000644000076500000000000000142511176730177014643 0ustar bcpiercewheel(* Unison file synchronizer: src/linkgtk.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) module TopLevel = Main.Body(Uigtk.Body) unison-2.32.52/linkgtk2.ml0000644000076500000000000000142711176730177014727 0ustar bcpiercewheel(* Unison file synchronizer: src/linkgtk2.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) module TopLevel = Main.Body(Uigtk2.Body) unison-2.32.52/linktext.ml0000644000076500000000000000142711176730177015044 0ustar bcpiercewheel(* Unison file synchronizer: src/linktext.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) module TopLevel = Main.Body(Uitext.Body) unison-2.32.52/linktk.ml0000644000076500000000000000142311176730177014472 0ustar bcpiercewheel(* Unison file synchronizer: src/linktk.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) module TopLevel = Main.Body(Uitk.Body) unison-2.32.52/lock.ml0000644000076500000000000000342311176730177014130 0ustar bcpiercewheel(* Unison file synchronizer: src/lock.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) let rename oldFile newFile = begin try Unix.link oldFile newFile with Unix.Unix_error _ -> () end; let res = try (Unix.LargeFile.stat oldFile).Unix.LargeFile.st_nlink = 2 with Unix.Unix_error _ -> false in Unix.unlink oldFile; res let flags = [Unix.O_WRONLY; Unix.O_CREAT; Unix.O_EXCL] let create name mode = try Unix.close (Unix.openfile name flags mode); true with Unix.Unix_error (Unix.EEXIST, _, _) -> false let rec unique name i mode = let nm = name ^ string_of_int i in if create nm mode then nm else (* highly unlikely *) unique name (i + 1) mode let acquire name = Util.convertUnixErrorsToTransient "Lock.acquire" (fun () -> match Util.osType with `Unix -> (* O_EXCL is broken under NFS... *) rename (unique name (Unix.getpid ()) 0o600) name | _ -> create name 0o600) let release name = try Unix.unlink name with Unix.Unix_error _ -> () let is_locked name = Util.convertUnixErrorsToTransient "Lock.test" (fun () -> Sys.file_exists name) unison-2.32.52/lock.mli0000644000076500000000000000050011176730177014272 0ustar bcpiercewheel(* 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 unison-2.32.52/lwt/0000755000076500000000000000000011222164527013442 5ustar bcpiercewheelunison-2.32.52/lwt/depend0000644000076500000000000000045011176730177014633 0ustar bcpiercewheellwt.cmo: lwt.cmi lwt.cmx: lwt.cmi lwt_unix.cmo: pqueue.cmi lwt.cmi lwt_unix.cmi lwt_unix.cmx: pqueue.cmx lwt.cmx lwt_unix.cmi lwt_util.cmo: lwt.cmi lwt_util.cmi lwt_util.cmx: lwt.cmx lwt_util.cmi pqueue.cmo: pqueue.cmi pqueue.cmx: pqueue.cmi lwt_unix.cmi: lwt.cmi lwt_util.cmi: lwt.cmi unison-2.32.52/lwt/example/0000755000076500000000000000000011222164527015075 5ustar bcpiercewheelunison-2.32.52/lwt/example/editor.ml0000644000076500000000000000016411176730177016726 0ustar bcpiercewheellet _ = let editor = try Sys.getenv "EDITOR" with Not_found -> "emacs" in Lwt_unix.run (Lwt_unix.system editor) unison-2.32.52/lwt/example/Makefile0000644000076500000000000000042111176730177016542 0ustar bcpiercewheelall: relay start_editor OCAMLC = ocamlfind ocamlc relay: relay.ml $(OCAMLC) -o relay -linkpkg -package lwt relay.ml -cclib -s start_editor : editor.ml $(OCAMLC) -o start_editor -linkpkg -package lwt editor.ml -cclib -s clean: rm -f *.cmi *.cmo *~ relay start_editor unison-2.32.52/lwt/example/relay.ml0000644000076500000000000000370511176730177016560 0ustar bcpiercewheel (* Usage: relay *) (* This program waits for a connection on . It then connect to and relay everything it receives in either side to the other side. It exists when either side closes the connection. *) let listening_port = int_of_string Sys.argv.(1) let dest_port = int_of_string Sys.argv.(2) open Lwt let rec really_write out_ch buffer pos len = Lwt_unix.write out_ch buffer pos len >>= (fun len' -> if len = len' then return () else really_write out_ch buffer (pos + len') (len - len')) let relay in_ch out_ch = let rec relay_rec previous_write = let buffer = String.create 8192 in (* Read some data from the input socket *) Lwt_unix.read in_ch buffer 0 8192 >>= (fun len -> (* If we read nothing, this means that the connection has been closed. In this case, we stop relaying. *) if len = 0 then return () else begin (* Otherwise, we write the data to the ouput socket *) let write = (* First wait for the previous write to terminate *) previous_write >>= (fun () -> (* Then write the contents of the buffer *) really_write out_ch buffer 0 len) in relay_rec write end) in relay_rec (return ()) let new_socket () = Lwt_unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 let local_addr num = Unix.ADDR_INET (Unix.inet_addr_any, num) let _ = Lwt_unix.run ((* Initialize the listening address *) new_socket () >>= (fun listening_socket -> Unix.setsockopt listening_socket Unix.SO_REUSEADDR true; Unix.bind listening_socket (local_addr listening_port); Unix.listen listening_socket 1; (* Wait for a connection *) Lwt_unix.accept listening_socket >>= (fun (inp, _) -> (* Connect to the destination port *) new_socket () >>= (fun out -> Lwt_unix.connect out (local_addr dest_port) >>= (fun () -> (* Start relaying *) Lwt.choose [relay inp out; relay out inp]))))) unison-2.32.52/lwt/lwt.ml0000644000076500000000000000753211176730177014621 0ustar bcpiercewheel (* Either a thread ['a t] has terminated, eithera successfully [Return of 'a] or * unsuccessfully [Fail of exn], or it is sleeping *) type 'a state = Return of 'a | Fail of exn | Sleep (* A suspended thread is described by ['a t] * It could have several [waiters], which are thunk functions *) type 'a t = { mutable state : 'a state; mutable waiters : (unit -> unit) list } (* [make st] returns a thread of state [st] and no waiters *) let make st = { state = st; waiters = [] } (* add a thunk [f] to the waiting list of thread [t] *) let add_waiter t f = t.waiters <- f :: t.waiters (* restart a sleeping thread [t], run all its waiters * and running all the waiters, and make the terminating state [st] * [caller] is a string that describes the caller *) let restart t st caller = assert (st <> Sleep); if t.state <> Sleep then invalid_arg caller; t.state <- st; List.iter (fun f -> f ()) t.waiters; t.waiters <- [] (* * pre-condition: [t.state] is Sleep (i.e., not terminated) * [connect t t'] connects the two processes when t' finishes up * connecting means: running all the waiters for [t'] * and assigning the state of [t'] to [t] *) let rec connect t t' = if t.state <> Sleep then invalid_arg "connect"; if t'.state = Sleep then add_waiter t' (fun () -> connect t t') else begin t.state <- t'.state; begin match t.waiters with [f] -> t.waiters <- []; f () | _ -> List.iter (fun f -> f ()) t.waiters; t.waiters <- [] end end (* similar to [connect t t']; does nothing instead of raising exception when * [t] is not asleep *) let rec try_connect t t' = if t.state <> Sleep then () else if t'.state = Sleep then add_waiter t' (fun () -> try_connect t t') else begin t.state <- t'.state; List.iter (fun f -> f ()) t.waiters; t.waiters <- [] end (* apply function, reifying explicit exceptions into the thread type * apply: ('a -(exn)-> 'b t) -> ('a -(n)-> 'b t) * semantically a natural transformation TE -> T, where T is the thread * monad, which is layered over exception monad E. *) let apply f x = try f x with e -> make (Fail e) (****) let return v = make (Return v) let fail e = make (Fail e) let wait () = make Sleep let wakeup t v = restart t (Return v) "wakeup" let wakeup_exn t e = restart t (Fail e) "wakeup_exn" let rec bind x f = match x.state with Return v -> f v | Fail e -> fail e | Sleep -> let res = wait () in add_waiter x (fun () -> connect res (bind x (apply f))); res let (>>=) = bind let rec catch_rec x f = match x.state with Return v -> x | Fail e -> f e | Sleep -> let res = wait () in add_waiter x (fun () -> connect res (catch_rec x (apply f))); res let catch x f = catch_rec (apply x ()) f let rec try_bind_rec x f g = match x.state with Return v -> f v | Fail e -> apply g e | Sleep -> let res = wait () in add_waiter x (fun () -> connect res (try_bind_rec x (apply f) g)); res let try_bind x f = try_bind_rec (apply x ()) f let poll x = match x.state with Fail e -> raise e | Return v -> Some v | Sleep -> None let rec ignore_result x = match x.state with Return v -> () | Fail e -> raise e | Sleep -> add_waiter x (fun () -> ignore_result x) let rec nth_ready l n = match l with [] -> assert false | x :: rem -> if x.state = Sleep then nth_ready rem n else if n > 0 then nth_ready rem (n - 1) else x let choose l = let ready = ref 0 in List.iter (fun x -> if x.state <> Sleep then incr ready) l; if !ready > 0 then nth_ready l (Random.int !ready) else let res = wait () in (* XXX We may leak memory here, if we repeatedly select the same event *) List.iter (fun x -> try_connect res x) l; res unison-2.32.52/lwt/lwt.mli0000644000076500000000000001023011176730177014757 0ustar bcpiercewheel(* Module [Lwt]: cooperative light-weight threads. *) type 'a t (* The type of threads returning a result of type ['a]. *) val return : 'a -> 'a t (* [return e] is a thread whose return value is the value of the expression [e]. *) val fail : exn -> 'a t (* [fail e] is a thread that fails with the exception [e]. *) val bind : 'a t -> ('a -> 'b t) -> 'b t (* [bind t f] is a thread which first waits for the thread [t] to terminate and then, if the thread succeeds, behaves as the application of function [f] to the return value of [t]. If the thread [t] fails, [bind t f] also fails, with the same exception. The expression [bind t (fun x -> t')] can intuitively be read as [let x = t in t']. Note that [bind] is also often used just for synchronization purpose: [t'] will not execute before [t] is terminated. The result of a thread can be bound several time. *) val (>>=) : 'a t -> ('a -> 'b t) -> 'b t (* [t >>= f] is an alternative notation for [bind t f]. *) val catch : (unit -> 'a t) -> (exn -> 'a t) -> 'a t (* [catch t f] is a thread that behaves as the thread [t ()] if this thread succeeds. If the thread [t ()] fails with some exception, [catch t f] behaves as the application of [f] to this exception. *) val try_bind : (unit -> 'a t) -> ('a -> 'b t) -> (exn -> 'b t) -> 'b t (* [try_bind t f g] behaves as [bind (t ()) f] if [t] does not fail. Otherwise, it behaves as the application of [g] to the exception associated to [t ()]. *) val choose : 'a t list -> 'a t (* [choose l] behaves as the first thread in [l] to terminate. If several threads are already terminated, one is choosen at random. *) val ignore_result : 'a t -> unit (* [ignore_result t] start the thread [t] and ignores its result value if the thread terminates sucessfully. However, if the thread [t] fails, the exception is raised instead of being ignored. You should use this function if you want to start a thread and don't care what its return value is, nor when it terminates (for instance, because it is looping). Note that if the thread [t] yields and later fails, the exception will not be raised at this point in the program. *) val wait : unit -> 'a t (* [wait ()] is a thread which sleeps forever (unless it is resumed by one of the functions [wakeup], [wakeup_exn] below). This thread does not block the execution of the remainder of the program (except of course, if another thread tries to wait for its termination). *) (* Execution order A thread executes as much as possible. Switching to another thread is always explicit. Exception handling - You must use "fail e" instead of "raise e" if you want the exception to be wrapped into the thread. - The construction [try t with ...] will not caught the exception associated to the thread [t] if this thread fails. You should use [catch] instead. *) (****) (* The functions below are probably not useful for the casual user. They provide the basic primitives on which can be built multi- threaded libraries such as Lwt_unix. *) val poll : 'a t -> 'a option (* [poll e] returns [Some v] if the thread [e] is terminated and returned the value [v]. If the thread failed with some exception, this exception is raised. If the thread is still running, [poll e] returns [None] without blocking. *) val wakeup : 'a t -> 'a -> unit (* [wakeup t e] makes the sleeping thread [t] terminate and return the value of the expression [e]. *) val wakeup_exn : 'a t -> exn -> unit (* [wakeup_exn t e] makes the sleeping thread [t] fail with the exception [e]. *) val apply : ('a -> 'b t) -> 'a -> 'b t (* [apply f e] apply the function [f] to the expression [e]. If an exception is raised during this application, it is caught and the resulting thread fails with this exception. *) (* Q: Could be called 'glue' or 'trap' or something? *) unison-2.32.52/lwt/lwt_unix.ml0000644000076500000000000003445711213501736015657 0ustar bcpiercewheel(* Non-blocking I/O and select does not (fully) work under Windows. The libray therefore does not use them under Windows, and will therefore have the following limitations: - No read will be performed while there are some threads ready to run or waiting to write; - When a read is pending, everything else will be blocked: [sleep] will not terminate and other reads will not be performed before this read terminates; - A write on a socket or a pipe can block the execution of the program if the data are never consumed at the other end of the connection. In particular, if both ends use this library and write at the same time, this could result in a dead-lock. - [connect] is blocking *) let windows_hack = Sys.os_type <> "Unix" let recent_ocaml = Scanf.sscanf Sys.ocaml_version "%d.%d" (fun maj min -> (maj = 3 && min >= 11) || maj > 3) module SleepQueue = Pqueue.Make (struct type t = float * int * unit Lwt.t let compare (t, i, _) (t', i', _) = let c = compare t t' in if c = 0 then i - i' else c end) let sleep_queue = ref SleepQueue.empty let event_counter = ref 0 let sleep d = let res = Lwt.wait () in incr event_counter; let t = if d <= 0. then 0. else Unix.gettimeofday () +. d in sleep_queue := SleepQueue.add (t, !event_counter, res) !sleep_queue; res let yield () = sleep 0. let get_time t = if !t = -1. then t := Unix.gettimeofday (); !t let in_the_past now t = t = 0. || t <= get_time now let rec restart_threads imax now = match try Some (SleepQueue.find_min !sleep_queue) with Not_found -> None with Some (time, i, thr) when in_the_past now time && i - imax <= 0 -> sleep_queue := SleepQueue.remove_min !sleep_queue; Lwt.wakeup thr (); restart_threads imax now | _ -> () let inputs = ref [] let outputs = ref [] let wait_children = ref [] let child_exited = ref false let _ = if not windows_hack then ignore(Sys.signal Sys.sigchld (Sys.Signal_handle (fun _ -> child_exited := true))) let bad_fd fd = try ignore (Unix.LargeFile.fstat fd); false with Unix.Unix_error (_, _, _) -> true let wrap_syscall queue fd cont syscall = let res = try Some (syscall ()) with Exit | Unix.Unix_error ((Unix.EAGAIN | Unix.EWOULDBLOCK | Unix.EINTR), _, _) -> (* EINTR because we are catching SIG_CHLD hence the system call might be interrupted to handle the signal; this lets us restart the system call eventually. *) None | e -> queue := List.remove_assoc fd !queue; Lwt.wakeup_exn cont e; None in match res with Some v -> queue := List.remove_assoc fd !queue; Lwt.wakeup cont v | None -> () let rec run thread = match Lwt.poll thread with Some v -> v | None -> let next_event = try let (time, _, _) = SleepQueue.find_min !sleep_queue in Some time with Not_found -> None in let now = ref (-1.) in let delay = match next_event with None -> -1. | Some 0. -> 0. | Some time -> max 0. (time -. get_time now) in let infds = List.map fst !inputs in let outfds = List.map fst !outputs in let (readers, writers, _) = if windows_hack && not recent_ocaml then let writers = outfds in let readers = if delay = 0. || writers <> [] then [] else infds in (readers, writers, []) else if infds = [] && outfds = [] && delay = 0. then ([], [], []) else try let res = Unix.select infds outfds [] delay in if delay > 0. && !now <> -1. then now := !now +. delay; res with Unix.Unix_error (Unix.EINTR, _, _) -> ([], [], []) | Unix.Unix_error (Unix.EBADF, _, _) -> (List.filter bad_fd infds, List.filter bad_fd outfds, []) | Unix.Unix_error (Unix.EPIPE, _, _) when windows_hack && recent_ocaml -> (* Workaround for a bug in Ocaml 3.11: select fails with an EPIPE error when the file descriptor is remotely closed *) (infds, [], []) in restart_threads !event_counter now; List.iter (fun fd -> try match List.assoc fd !inputs with `Read (buf, pos, len, res) -> wrap_syscall inputs fd res (fun () -> Unix.read fd buf pos len) | `Accept res -> wrap_syscall inputs fd res (fun () -> let (s, _) as v = Unix.accept fd in if not windows_hack then Unix.set_nonblock s; v) | `Wait res -> wrap_syscall inputs fd res (fun () -> ()) with Not_found -> ()) readers; List.iter (fun fd -> try match List.assoc fd !outputs with `Write (buf, pos, len, res) -> wrap_syscall outputs fd res (fun () -> Unix.write fd buf pos len) | `CheckSocket res -> wrap_syscall outputs fd res (fun () -> try ignore (Unix.getpeername fd) with Unix.Unix_error (Unix.ENOTCONN, _, _) -> ignore (Unix.read fd " " 0 1)) | `Wait res -> wrap_syscall inputs fd res (fun () -> ()) with Not_found -> ()) writers; if !child_exited then begin child_exited := false; List.iter (fun (id, (res, flags, pid)) -> wrap_syscall wait_children id res (fun () -> let (pid', _) as v = Unix.waitpid flags pid in if pid' = 0 then raise Exit; v)) !wait_children end; run thread (****) let wait_read ch = let res = Lwt.wait () in inputs := (ch, `Wait res) :: !inputs; res let wait_write ch = let res = Lwt.wait () in outputs := (ch, `Wait res) :: !outputs; res let read ch buf pos len = try if windows_hack then raise (Unix.Unix_error (Unix.EAGAIN, "", "")); Lwt.return (Unix.read ch buf pos len) with Unix.Unix_error ((Unix.EAGAIN | Unix.EWOULDBLOCK), _, _) -> let res = Lwt.wait () in inputs := (ch, `Read (buf, pos, len, res)) :: !inputs; res | e -> Lwt.fail e let write ch buf pos len = try Lwt.return (Unix.write ch buf pos len) with Unix.Unix_error ((Unix.EAGAIN | Unix.EWOULDBLOCK), _, _) -> let res = Lwt.wait () in outputs := (ch, `Write (buf, pos, len, res)) :: !outputs; res | e -> Lwt.fail e let pipe () = let (out_fd, in_fd) as fd_pair = Unix.pipe() in if not windows_hack then begin Unix.set_nonblock in_fd; Unix.set_nonblock out_fd end; Lwt.return fd_pair let socket dom typ proto = let s = Unix.socket dom typ proto in if not windows_hack then Unix.set_nonblock s; Lwt.return s let socketpair dom typ proto = let (s1, s2) as spair = Unix.socketpair dom typ proto in if not windows_hack then begin Unix.set_nonblock s1; Unix.set_nonblock s2 end; Lwt.return spair let accept ch = let res = Lwt.wait () in inputs := (ch, `Accept res) :: !inputs; res let check_socket ch = let res = Lwt.wait () in outputs := (ch, `CheckSocket res) :: !outputs; res let connect s addr = try Unix.connect s addr; Lwt.return () with Unix.Unix_error ((Unix.EINPROGRESS | Unix.EWOULDBLOCK | Unix.EAGAIN), _, _) -> check_socket s | e -> Lwt.fail e let ids = ref 0 let new_id () = incr ids; !ids let _waitpid flags pid = try Lwt.return (Unix.waitpid flags pid) with e -> Lwt.fail e let waitpid flags pid = if List.mem Unix.WNOHANG flags || windows_hack then _waitpid flags pid else let flags = Unix.WNOHANG :: flags in Lwt.bind (_waitpid flags pid) (fun ((pid', _) as res) -> if pid' <> 0 then Lwt.return res else let res = Lwt.wait () in wait_children := (new_id (), (res, flags, pid)) :: !wait_children; res) let wait () = waitpid [] (-1) let system cmd = match Unix.fork () with 0 -> begin try Unix.execv "/bin/sh" [| "/bin/sh"; "-c"; cmd |]; assert false with _ -> exit 127 end | id -> Lwt.bind (waitpid [] id) (fun (pid, status) -> Lwt.return status) (****) type lwt_in_channel = in_channel type lwt_out_channel = out_channel let wait_inchan ic = wait_read (Unix.descr_of_in_channel ic) let wait_outchan oc = wait_write (Unix.descr_of_out_channel oc) let rec input_char ic = try Lwt.return (Pervasives.input_char ic) with Sys_blocked_io -> Lwt.bind (wait_inchan ic) (fun () -> input_char ic) | e -> Lwt.fail e let rec input ic s ofs len = try Lwt.return (Pervasives.input ic s ofs len) with Sys_blocked_io -> Lwt.bind (wait_inchan ic) (fun () -> input ic s ofs len) | e -> Lwt.fail e let rec unsafe_really_input ic s ofs len = if len <= 0 then Lwt.return () else begin Lwt.bind (input ic s ofs len) (fun r -> if r = 0 then Lwt.fail End_of_file else unsafe_really_input ic s (ofs+r) (len-r)) end let really_input ic s ofs len = if ofs < 0 || len < 0 || ofs > String.length s - len then Lwt.fail (Invalid_argument "really_input") else unsafe_really_input ic s ofs len let input_line ic = let buf = ref (String.create 128) in let pos = ref 0 in let rec loop () = if !pos = String.length !buf then begin let newbuf = String.create (2 * !pos) in String.blit !buf 0 newbuf 0 !pos; buf := newbuf end; Lwt.bind (input_char ic) (fun c -> if c = '\n' then Lwt.return () else begin !buf.[!pos] <- c; incr pos; loop () end) in Lwt.bind (Lwt.catch loop (fun e -> match e with End_of_file when !pos <> 0 -> Lwt.return () | _ -> Lwt.fail e)) (fun () -> let res = String.create !pos in String.blit !buf 0 res 0 !pos; Lwt.return res) (****) type popen_process = Process of in_channel * out_channel | Process_in of in_channel | Process_out of out_channel | Process_full of in_channel * out_channel * in_channel let popen_processes = (Hashtbl.create 7 : (popen_process, int) Hashtbl.t) let open_proc cmd proc input output toclose = match Unix.fork () with 0 -> if input <> Unix.stdin then begin Unix.dup2 input Unix.stdin; Unix.close input end; if output <> Unix.stdout then begin Unix.dup2 output Unix.stdout; Unix.close output end; List.iter Unix.close toclose; Unix.execv "/bin/sh" [| "/bin/sh"; "-c"; cmd |]; exit 127 | id -> Hashtbl.add popen_processes proc id let open_process_in cmd = Lwt.bind (pipe ()) (fun (in_read, in_write) -> let inchan = Unix.in_channel_of_descr in_read in open_proc cmd (Process_in inchan) Unix.stdin in_write [in_read]; Unix.close in_write; Lwt.return inchan) let open_process_out cmd = Lwt.bind (pipe ()) (fun (out_read, out_write) -> let outchan = Unix.out_channel_of_descr out_write in open_proc cmd (Process_out outchan) out_read Unix.stdout [out_write]; Unix.close out_read; Lwt.return outchan) let open_process cmd = Lwt.bind (pipe ()) (fun (in_read, in_write) -> Lwt.bind (pipe ()) (fun (out_read, out_write) -> let inchan = Unix.in_channel_of_descr in_read in let outchan = Unix.out_channel_of_descr out_write in open_proc cmd (Process(inchan, outchan)) out_read in_write [in_read; out_write]; Unix.close out_read; Unix.close in_write; Lwt.return (inchan, outchan))) (* FIX: Subprocesses that use /dev/tty to print things on the terminal will NOT have this output captured and returned to the caller of this function. There's an argument that this is correct, but if we are running from a GUI the user may not be looking at any terminal and it will appear that the process is just hanging. This can be fixed, in principle, by writing a little C code that opens /dev/tty and then uses the TIOCNOTTY ioctl control to detach the terminal. *) let open_proc_full cmd env proc output input error toclose = match Unix.fork () with 0 -> Unix.dup2 input Unix.stdin; Unix.close input; Unix.dup2 output Unix.stdout; Unix.close output; Unix.dup2 error Unix.stderr; Unix.close error; List.iter Unix.close toclose; Unix.execve "/bin/sh" [| "/bin/sh"; "-c"; cmd |] env; exit 127 | id -> Hashtbl.add popen_processes proc id let open_process_full cmd env = Lwt.bind (pipe ()) (fun (in_read, in_write) -> Lwt.bind (pipe ()) (fun (out_read, out_write) -> Lwt.bind (pipe ()) (fun (err_read, err_write) -> let inchan = Unix.out_channel_of_descr in_write in let outchan = Unix.in_channel_of_descr out_read in let errchan = Unix.in_channel_of_descr err_read in open_proc_full cmd env (Process_full(outchan, inchan, errchan)) out_write in_read err_write [in_write; out_read; err_read]; Unix.close out_write; Unix.close in_read; Unix.close err_write; Lwt.return (outchan, inchan, errchan)))) let find_proc_id fun_name proc = try let pid = Hashtbl.find popen_processes proc in Hashtbl.remove popen_processes proc; pid with Not_found -> raise (Unix.Unix_error (Unix.EBADF, fun_name, "")) let close_process_in inchan = let pid = find_proc_id "close_process_in" (Process_in inchan) in close_in inchan; Lwt.bind (waitpid [] pid) (fun (_, status) -> Lwt.return status) let close_process_out outchan = let pid = find_proc_id "close_process_out" (Process_out outchan) in close_out outchan; Lwt.bind (waitpid [] pid) (fun (_, status) -> Lwt.return status) let close_process (inchan, outchan) = let pid = find_proc_id "close_process" (Process(inchan, outchan)) in close_in inchan; close_out outchan; Lwt.bind (waitpid [] pid) (fun (_, status) -> Lwt.return status) let close_process_full (outchan, inchan, errchan) = let pid = find_proc_id "close_process_full" (Process_full(outchan, inchan, errchan)) in close_out inchan; close_in outchan; close_in errchan; Lwt.bind (waitpid [] pid) (fun (_, status) -> Lwt.return status) unison-2.32.52/lwt/lwt_unix.mli0000644000076500000000000000542311176730177016032 0ustar bcpiercewheel(* Module [Lwt_unix]: thread-compatible system calls *) val sleep : float -> unit Lwt.t (* [sleep d] is a threads which remain suspended for [d] seconds (letting other threads run) and then terminates. *) val yield : unit -> unit Lwt.t (* [yield ()] is a threads which suspends itself (letting other thread run) and then resumes as soon as possible and terminates. *) val run : 'a Lwt.t -> 'a (* [run t] lets the thread [t] run until it terminates. It evaluates to the return value of [t], or raise the exception associated to [t] if [t] fails. You should avoid using [run] inside threads: - The calling threads will not resume before [run] returns. - Successive invocations of [run] are serialized: an invocation of [run] will not terminate before all subsequent invocations are terminated. *) (****) (* These functions behaves as their [Unix] counterparts, but let other threads run while waiting for the completion of the system call. PITFALL If you want to read or write from stdin, stdout or stderr using this library, you must first turn them into non-blocking mode using [Unix.set_nonblock]. *) val read : Unix.file_descr -> string -> int -> int -> int Lwt.t val write : Unix.file_descr -> string -> int -> int -> int Lwt.t val pipe : unit -> (Unix.file_descr * Unix.file_descr) Lwt.t val socket : Unix.socket_domain -> Unix.socket_type -> int -> Unix.file_descr Lwt.t val socketpair : Unix.socket_domain -> Unix.socket_type -> int -> (Unix.file_descr * Unix.file_descr) Lwt.t val accept : Unix.file_descr -> (Unix.file_descr * Unix.sockaddr) Lwt.t val connect : Unix.file_descr -> Unix.sockaddr -> unit Lwt.t val wait : unit -> (int * Unix.process_status) Lwt.t val waitpid : Unix.wait_flag list -> int -> (int * Unix.process_status) Lwt.t val system : string -> Unix.process_status Lwt.t type lwt_in_channel type lwt_out_channel val input_char : lwt_in_channel -> char Lwt.t val input_line : lwt_in_channel -> string Lwt.t val input : lwt_in_channel -> string -> int -> int -> int Lwt.t val really_input : lwt_in_channel -> string -> int -> int -> unit Lwt.t val open_process_in: string -> lwt_in_channel Lwt.t val open_process_out: string -> lwt_out_channel Lwt.t val open_process: string -> (lwt_in_channel * lwt_out_channel) Lwt.t val open_process_full: string -> string array -> (lwt_in_channel * lwt_out_channel * lwt_in_channel) Lwt.t val close_process_in: lwt_in_channel -> Unix.process_status Lwt.t val close_process_out: lwt_out_channel -> Unix.process_status Lwt.t val close_process: lwt_in_channel * lwt_out_channel -> Unix.process_status Lwt.t val close_process_full: lwt_in_channel * lwt_out_channel * lwt_in_channel -> Unix.process_status Lwt.t unison-2.32.52/lwt/lwt_util.ml0000644000076500000000000000360311176730177015651 0ustar bcpiercewheel open Lwt let rec iter f l = match l with [] -> return () | a :: r -> let t = f a in let rt = iter f r in t >>= (fun () -> rt) let rec map f l = match l with [] -> return [] | v :: r -> let t = f v in let rt = map f r in t >>= (fun v' -> rt >>= (fun l' -> return (v' :: l'))) let map_with_waiting_action f wa l = let rec loop l = match l with [] -> return [] | v :: r -> let t = f v in let rt = loop r in t >>= (fun v' -> (* Perform the specified "waiting action" for the next *) (* item in the list. *) if r <> [] then wa (List.hd r) else (); rt >>= (fun l' -> return (v' :: l'))) in if l <> [] then wa (List.hd l) else (); loop l let rec map_serial f l = match l with [] -> return [] | v :: r -> f v >>= (fun v' -> map f r >>= (fun l' -> return (v' :: l'))) let join l = iter (fun x -> x) l type region = { mutable size : int; mutable count : int; waiters : (unit Lwt.t * int) Queue.t } let make_region count = { size = count; count = 0; waiters = Queue.create () } let resize_region reg sz = reg.size <- sz let leave_region reg sz = try if reg.count > reg.size then raise Queue.Empty; let (w, sz') = Queue.take reg.waiters in reg.count <- reg.count - sz + sz'; Lwt.wakeup w () with Queue.Empty -> reg.count <- reg.count - sz let run_in_region_1 reg sz thr = (catch (fun () -> thr () >>= (fun v -> leave_region reg sz; return v)) (fun e -> leave_region reg sz; fail e)) let run_in_region reg sz thr = if reg.count >= reg.size then begin let res = wait () in Queue.add (res, sz) reg.waiters; res >>= (fun () -> run_in_region_1 reg sz thr) end else begin reg.count <- reg.count + sz; run_in_region_1 reg sz thr end unison-2.32.52/lwt/lwt_util.mli0000644000076500000000000000371511176730177016026 0ustar bcpiercewheel val join : unit Lwt.t list -> unit Lwt.t (* [join l] wait for all threads in [l] to terminate. If fails if one of the threads fail. *) (****) val iter : ('a -> unit Lwt.t) -> 'a list -> unit Lwt.t (* [iter f l] start a thread for each element in [l]. The threads are started according to the list order, but then can run concurrently. It terminates when all the threads are terminated, if all threads are successful. It fails if any of the threads fail. *) val map : ('a -> 'b Lwt.t) -> 'a list -> 'b list Lwt.t (* [map f l] apply [f] to each element in [l] and collect the results of the threads thus created. The threads are started according to the list order, but then can run concurrently. [map f l] fails if any of the threads fail. *) val map_with_waiting_action : ('a -> 'b Lwt.t) -> ('a -> unit) -> 'a list -> 'b list Lwt.t (* [map_with_waiting_action f wa l] apply [f] to each element *) (* in [l] and collect the results of the threads thus created. *) (* The threads are started according to the list order, but *) (* then can run concurrently. The difference with [map f l] is *) (* that function wa will be called on the element that the *) (* function is waiting for its termination. *) val map_serial : ('a -> 'b Lwt.t) -> 'a list -> 'b list Lwt.t (* Similar to [map] but wait for one thread to terminate before starting the next one. *) (****) type region val make_region : int -> region (* [make_region sz] create a region of size [sz]. *) val resize_region : region -> int -> unit (* [resize_region reg sz] resize the region [reg] to size [sz]. *) val run_in_region : region -> int -> (unit -> 'a Lwt.t) -> 'a Lwt.t (* [run_in_region reg size f] execute the thread produced by the function [f] in the region [reg]. The thread is not started before some room is available in the region. *) unison-2.32.52/lwt/Makefile0000644000076500000000000000233411176730177015114 0ustar bcpiercewheel NAME = lwt OCAMLC = ocamlfind ocamlc -g OCAMLOPT = ocamlfind ocamlopt OCAMLDEP = ocamldep OBJECTS = pqueue.cmo lwt.cmo lwt_util.cmo lwt_unix.cmo XOBJECTS = $(OBJECTS:cmo=cmx) ARCHIVE = $(NAME).cma XARCHIVE = $(NAME).cmxa REQUIRES = PREDICATES = all: $(ARCHIVE) opt: $(XARCHIVE) $(ARCHIVE): $(OBJECTS) $(OCAMLC) -a -o $(ARCHIVE) -package "$(REQUIRES)" -linkpkg \ -predicates "$(PREDICATES)" $(OBJECTS) $(XARCHIVE): $(XOBJECTS) $(OCAMLOPT) -a -o $(XARCHIVE) -package "$(REQUIRES)" -linkpkg \ -predicates "$(PREDICATES)" $(XOBJECTS) .SUFFIXES: .cmo .cmi .cmx .ml .mli .ml.cmo: $(OCAMLC) -package "$(REQUIRES)" -predicates "$(PREDICATES)" \ -c $< .mli.cmi: $(OCAMLC) -package "$(REQUIRES)" -predicates "$(PREDICATES)" \ -c $< .ml.cmx: $(OCAMLOPT) -package "$(REQUIRES)" -predicates "$(PREDICATES)" \ -c $< depend: *.ml *.mli $(OCAMLDEP) *.ml *.mli > depend include depend install: all { test ! -f $(XARCHIVE) || extra="$(XARCHIVE) "`basename $(XARCHIVE) .cmxa`.a; }; \ ocamlfind install $(NAME) *.mli *.cmi $(ARCHIVE) META $$extra uninstall: ocamlfind remove $(NAME) clean:: rm -f *.cmi *.cmo *.cmx *.cma *.cmxa *.a *.o *~ *.bak clean:: cd example && $(MAKE) clean unison-2.32.52/lwt/META0000644000076500000000000000013111176730177014116 0ustar bcpiercewheelrequires = "unix" version = "0.1" archive(byte) = "lwt.cma" archive(native) = "lwt.cmxa" unison-2.32.52/lwt/pqueue.ml0000644000076500000000000000516011176730177015312 0ustar bcpiercewheel(* Unison file synchronizer: src/lwt/pqueue.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) module type OrderedType = sig type t val compare: t -> t -> int end module type S = sig type elt type t val empty: t val is_empty: t -> bool val add: elt -> t -> t val union: t -> t -> t val find_min: t -> elt val remove_min: t -> t end module Make(Ord: OrderedType) : (S with type elt = Ord.t) = struct type elt = Ord.t type t = tree list and tree = Node of elt * int * tree list let root (Node (x, _, _)) = x let rank (Node (_, r, _)) = r let link (Node (x1, r1, c1) as t1) (Node (x2, r2, c2) as t2) = let c = Ord.compare x1 x2 in if c <= 0 then Node (x1, r1 + 1, t2::c1) else Node(x2, r2 + 1, t1::c2) let rec ins t = function [] -> [t] | (t'::_) as ts when rank t < rank t' -> t::ts | t'::ts -> ins (link t t') ts let empty = [] let is_empty ts = ts = [] let add x ts = ins (Node (x, 0, [])) ts let rec union ts ts' = match ts, ts' with ([], _) -> ts' | (_, []) -> ts | (t1::ts1, t2::ts2) -> if rank t1 < rank t2 then t1 :: union ts1 (t2::ts2) else if rank t2 < rank t1 then t2 :: union (t1::ts1) ts2 else ins (link t1 t2) (union ts1 ts2) let rec find_min = function [] -> raise Not_found | [t] -> root t | t::ts -> let x = find_min ts in let c = Ord.compare (root t) x in if c < 0 then root t else x let rec get_min = function [] -> assert false | [t] -> (t, []) | t::ts -> let (t', ts') = get_min ts in let c = Ord.compare (root t) (root t') in if c < 0 then (t, ts) else (t', t::ts') let remove_min = function [] -> raise Not_found | ts -> let (Node (x, r, c), ts) = get_min ts in union (List.rev c) ts end unison-2.32.52/lwt/pqueue.mli0000644000076500000000000000072311176730177015463 0ustar bcpiercewheel(* 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 unison-2.32.52/main.ml0000644000076500000000000002064211176730177014126 0ustar bcpiercewheel(* Unison file synchronizer: src/main.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) (* ---------------------------------------------------------------------- *) (* This is the main program -- the thing that gets executed first when unison is run. The Main module is actually a functor that takes the user interface (e.g., Uitext or Uigtk) as a parameter. This allows us to build with just one user interface at a time, which avoids having to always link in all the libraries needed by all the user interfaces. A non-functor interface is provided to allow the Mac GUI to reuse the startup code for non-GUI options. *) (* ---------------------------------------------------------------------- *) (* Some command-line arguments are handled specially during startup, e.g., -doc -help -version -server -socket -ui They are expected to appear on the command-line only, not in a profile. In particular, -version and -doc will print to the standard output, so they only make sense if invoked from the command-line (and not a click-launched gui that has no standard output). Furthermore, the actions associated with these command-line arguments are executed without loading a profile or doing the usual command-line parsing. This is because we want to run the actions without loading a profile; and then we can't do command-line parsing because it is intertwined with profile loading. NB: the Mac GUI handles these options itself and needs to change if any more are added. *) let versionPrefName = "version" let printVersionAndExit = Prefs.createBool versionPrefName false "print version and exit" ("Print the current version number and exit. " ^ "(This option only makes sense on the command line.)") let docsPrefName = "doc" let docs = Prefs.createString docsPrefName "" "show documentation ('-doc topics' lists topics)" ( "The command-line argument \\texttt{-doc \\ARG{secname}} causes unison to " ^ "display section \\ARG{secname} of the manual on the standard output " ^ "and then exit. Use \\verb|-doc all| to display the whole manual, " ^ "which includes exactly the same information as the printed and HTML " ^ "manuals, modulo " ^ "formatting. Use \\verb|-doc topics| to obtain a list of the " ^ "names of the various sections that can be printed.") let prefsdocsPrefName = "prefsdocs" let prefsdocs = Prefs.createBool prefsdocsPrefName false "*show full documentation for all preferences (and then exit)" "" let serverPrefName = "server" let server = Prefs.createBool serverPrefName false "*normal or server mode" "" let socketPrefName = "socket" let socket = Prefs.create socketPrefName None "!act as a server on a socket" "" (fun _ -> fun i -> (try Some(int_of_string i) with Failure "int_of_string" -> raise(Prefs.IllegalValue "-socket must be followed by a number"))) (function None -> [] | Some(i) -> [string_of_int i]) ;; let serverHostName = "host" let serverHost = Prefs.createString serverHostName "" "!bind the socket to this host name in server socket mode" "" (* User preference for which UI to use if there is a choice *) let uiPrefName = "ui" let interface = Prefs.create uiPrefName Uicommon.Graphic "!select UI ('text' or 'graphic'); command-line only" ("This preference selects either the graphical or the textual user " ^ "interface. Legal values are \\verb|graphic| or \\verb|text|. " ^ "\n\nBecause this option is processed specially during Unison's " ^ "start-up sequence, it can {\\em only} be used on the command line. " ^ "In preference files it has no effect." ^ "\n\nIf " ^ "the Unison executable was compiled with only a textual interface, " ^ "this option has " ^ "no effect. (The pre-compiled binaries are all compiled with both " ^ "interfaces available.)") (fun _ -> function "text" -> Uicommon.Text | "graphic" -> Uicommon.Graphic | other -> raise (Prefs.IllegalValue ("option ui :\n\ text -> textual user interface\n\ graphic -> graphic user interface\n" ^other^ " is not a legal value"))) (function Uicommon.Text -> ["text"] | Uicommon.Graphic -> ["graphic"]);; let init() = begin ignore (Gc.set {(Gc.get ()) with Gc.max_overhead = 150}); let argv = Prefs.scanCmdLine Uicommon.usageMsg in let catch_all f = (try f () with e -> Util.msg "%s\n" (Uicommon.exn2string e); exit 1) in (* Print version if requested *) if Util.StringMap.mem versionPrefName argv then begin Printf.printf "%s version %s\n" Uutil.myName Uutil.myVersion; exit 0 end; (* Print docs for all preferences if requested (this is used when building the manual) *) if Util.StringMap.mem prefsdocsPrefName argv then begin Prefs.printFullDocs(); exit 0 end; (* Display documentation if requested *) begin try begin match Util.StringMap.find docsPrefName argv with [] -> assert false | "topics"::_ -> Printf.printf "Documentation topics:\n"; Safelist.iter (fun (sn,(n,doc)) -> if sn<>"" then Printf.printf " %12s %s\n" sn n) Strings.docs; Printf.printf "\nType \"%s -doc \" for detailed information about \n" Uutil.myName; Printf.printf "or \"%s -doc all\" for the whole manual\n\n" Uutil.myName | "all"::_ -> Printf.printf "\n"; Safelist.iter (fun (sn,(n,doc)) -> if n<>"Junk" then Printf.printf "%s\n" doc) Strings.docs | topic::_ -> (try let (_,d) = Safelist.assoc topic Strings.docs in Printf.printf "\n%s\n" d with Not_found -> Printf.printf "Documentation topic %s not recognized:" topic; Printf.printf "\nType \"%s -doc topics\" for a list\n" Uutil.myName) end; exit 0 with Not_found -> () end; (* Install an appropriate function for finding preference files. (We put this in Util just because the Prefs module lives below the Os module in the dependency hierarchy, so Prefs can't call Os directly.) *) Util.supplyFileInUnisonDirFn (fun n -> Fspath.toString (Os.fileInUnisonDir(n))); (* Start a server if requested *) if Util.StringMap.mem serverPrefName argv then begin catch_all (fun () -> Os.createUnisonDir(); Remote.beAServer(); exit 0) end; (* Start a socket server if requested *) begin try let i = List.hd (Util.StringMap.find socketPrefName argv) in catch_all (fun () -> Os.createUnisonDir(); Remote.waitOnPort (begin try match Util.StringMap.find serverHostName argv with [] -> None | s :: _ -> Some s with Not_found -> None end) i); exit 0 with Not_found -> () end; argv end (* non-GUI startup for Mac GUI version *) let nonGuiStartup() = begin let argv = init() in (* might not return *) (* if it returns start a UI *) (try (match Util.StringMap.find uiPrefName argv with "text"::_ -> (Uitext.Body.start Uicommon.Text; exit 0) | "graphic"::_ -> () (* fallthru *) | _ -> Prefs.printUsage Uicommon.usageMsg; exit 1) with Not_found -> ()); () end module Body = functor(Ui : Uicommon.UI) -> struct let argv = init() in (* might not return *) (* if it returns start a UI *) Ui.start (try (match Util.StringMap.find uiPrefName argv with "text"::_ -> Uicommon.Text | "graphic"::_ -> Uicommon.Graphic | _ -> Prefs.printUsage Uicommon.usageMsg; exit 1) with Not_found -> Ui.defaultUi) end unison-2.32.52/Makefile0000644000076500000000000002416411176730177014313 0ustar bcpiercewheel####################################################################### # $I1: Unison file synchronizer: src/Makefile $ # $I2: Last modified by bcpierce on Sun, 22 Aug 2004 22:29:04 -0400 $ # $I3: Copyright 1999-2004 (see COPYING for details) $ ####################################################################### ## User Settings # Set NATIVE=false if you are not using the native code compiler (ocamlopt) # This is not advised, though: Unison runs much slower when byte-compiled. # # If you set NATIVE=false, then make sure that the THREADS option below is # also set to false unless your OCaml installation has true posix-compliant # threads (i.e., -with-pthreads was given as an option to the config script). NATIVE=true # Use THREADS=false if your OCaml installation is not configured with the # -with-pthreads option. (Unison will crash when compiled with THREADS=true # if the -with-pthreads configuration option was not used.) THREADS=false # User interface style. For legal values, see Makefile.OCaml. # You probably don't need to set this yourself -- it will be set to # an appropriate value automatically, depending on whether the lablgtk # library is available. # # UISTYLE=text ######################################################################## ######################################################################## # (There should be no need to change anything from here on) ## ######################################################################## ###################################################################### # Building installation instructions all:: strings.ml buildexecutable all:: INSTALL INSTALL: $(NAME)$(EXEC_EXT) # file isn't made for OS X, so check that it's there first (if [ -f $(NAME) ]; then ./$(NAME) -doc install > INSTALLATION; fi) ######################################################################## ## Miscellaneous developer-only switches DEBUGGING=true PROFILING=false STATIC=false # NAME, VERSION, and MAJORVERSION, automatically generated -include Makefile.ProjectInfo Makefile.ProjectInfo: mkProjectInfo ./mkProjectInfo > $@ mkProjectInfo: mkProjectInfo.ml ocamlc -o $@ $^ clean:: $(RM) mkProjectInfo $(RM) Makefile.ProjectInfo ######################################################################## ### Compilation rules include Makefile.OCaml ###################################################################### # Installation INSTALLDIR = $(HOME)/bin/ # This has two names because on OSX the file INSTALL shadows the target 'install'! install: doinstall installtext: $(MAKE) -C .. installtext text: $(MAKE) -C .. text doinstall: $(NAME)$(EXEC_EXT) -mv $(INSTALLDIR)/$(NAME)$(EXEC_EXT) /tmp/$(NAME)-$(shell echo $$$$) cp $(NAME)$(EXEC_EXT) $(INSTALLDIR) cp $(NAME)$(EXEC_EXT) $(INSTALLDIR)$(NAME)-$(MAJORVERSION)$(EXEC_EXT) ###################################################################### # Demo setupdemo-old: all -mkdir alice.tmp bob.tmp -touch alice.tmp/letter alice.tmp/curriculum -mkdir bob.tmp/curriculum -touch bob.tmp/curriculum/french -touch bob.tmp/curriculum/german -mkdir bob.tmp/good_friends -mkdir bob.tmp/good_friends/addresses -mkdir alice.tmp/good_friends -touch alice.tmp/good_friends/addresses -touch bob.tmp/good_friends/addresses/alice -mkdir alice.tmp/book -mkdir bob.tmp/book echo "first name:alice \n 2234 Chesnut Street \n Philadelphia" \ > bob.tmp/good_friends/addresses/alice echo "ADDRESS 1 : BOB \n firstName : bob \n 2233 Walnut Street" \ > alice.tmp/good_friends/addresses echo "Born in Paris in 1976 ..." > alice.tmp/curriculum echo "Ne a Paris en 1976 ..." > bob.tmp/curriculum/french echo "Geboren in Paris im jahre 1976 ..." > bob.tmp/curriculum/german echo "Dear friend, I received your letter ..." > alice.tmp/letter echo "And then the big bad wolf" > bob.tmp/book/page3 echo "Title : three little pigs" > alice.tmp/book/page1 echo "there was upon a time ..." > alice.tmp/book/page2 setupdemo: rm -rf a.tmp b.tmp mkdir a.tmp touch a.tmp/a a.tmp/b a.tmp/c mkdir a.tmp/d touch a.tmp/d/f touch a.tmp/d/g cp -r a.tmp b.tmp modifydemo: -rm a.tmp/a echo "Hello" > a.tmp/b echo "Hello" > b.tmp/b date > b.tmp/c echo "Hi there" > a.tmp/d/h echo "Hello there" > b.tmp/d/h demo: all setupdemo @$(MAKE) run @$(MAKE) modifydemo @$(MAKE) run run: all -mkdir a.tmp b.tmp -date > a.tmp/x -date > b.tmp/y ./$(NAME) default a.tmp b.tmp runbatch: all -mkdir a.tmp b.tmp -date > a.tmp/x -date > b.tmp/y ./$(NAME) default a.tmp b.tmp -batch runt: all -mkdir a.tmp b.tmp -date > a.tmp/x -date > b.tmp/y ./$(NAME) default a.tmp b.tmp -timers rundebug: all -date > a.tmp/x -date > b.tmp/y ./$(NAME) a.tmp b.tmp -debug all -ui text runp: all -echo cat > a.tmp/cat -echo cat > b.tmp/cat -chmod 765 a.tmp/cat -chmod 700 b.tmp/cat ./$(NAME) a.tmp b.tmp runtext: all -mkdir a.tmp b.tmp -date > a.tmp/x -date > b.tmp/y ./$(NAME) -ui text a.tmp b.tmp runsort: all -mkdir a.tmp b.tmp -date > a.tmp/b -date > b.tmp/m -date > b.tmp/z -date > b.tmp/f -date >> b.tmp/f -date > b.tmp/c.$(shell echo $$$$) -date > b.tmp/y.$(shell echo $$$$) ./$(NAME) default a.tmp b.tmp -debug sort runprefer: all -mkdir a.tmp b.tmp -date > a.tmp/b -date > b.tmp/m -date > b.tmp/z -echo Hello > a.tmp/z -date > b.tmp/f -date >> b.tmp/f -date > b.tmp/c.$(shell echo $$$$) -date > b.tmp/y.$(shell echo $$$$) ./$(NAME) default a.tmp b.tmp -force b.tmp prefsdocs: all ./$(NAME) -prefsdocs 2> prefsdocsjunk.tmp mv -f prefsdocsjunk.tmp prefsdocs.tmp # For developers runtest: $(MAKE) all NATIVE=false DEBUG=true ./unison test repeattest: $(MAKE) all NATIVE=false DEBUG=true UISTYLE=text ./unison noprofile a.tmp b.tmp -repeat foo.tmp -debug ui selftest: $(MAKE) all NATIVE=false DEBUG=true UISTYLE=text ./unison -selftest -ui text -batch selftestdebug: $(MAKE) all NATIVE=false DEBUG=true UISTYLE=text ./unison -selftest -ui text -batch -debug all selftestremote: $(MAKE) all NATIVE=false DEBUG=true UISTYLE=text ./unison -selftest -ui text -batch test.tmp ssh://eniac.seas.upenn.edu/test.tmp testmerge: $(MAKE) all NATIVE=false UISTYLE=text -rm -rf a.tmp b.tmp -rm -rf $(HOME)/.unison/backup/file.txt* mkdir a.tmp b.tmp @echo @echo ----------------------------------------------------------- @echo ./unison testmerge -ui text -batch echo 1OO >> a.tmp/file.txt echo 2oo >> a.tmp/file.txt echo 3oo >> a.tmp/file.txt echo 4oo >> a.tmp/file.txt echo 5oo >> a.tmp/file.txt echo 6oo >> a.tmp/file.txt echo 7oo >> a.tmp/file.txt echo 8oo >> a.tmp/file.txt echo 9oo >> a.tmp/file.txt echo 0oo >> a.tmp/file.txt echo 1oo >> a.tmp/file.txt echo 2oo >> a.tmp/file.txt echo 3oo >> a.tmp/file.txt echo 4oo >> a.tmp/file.txt echo 5oo >> a.tmp/file.txt echo 6oo >> a.tmp/file.txt echo 5oo >> a.tmp/file.txt echo 6oo >> a.tmp/file.txt echo 7oo >> a.tmp/file.txt echo 8oo >> a.tmp/file.txt echo 9oo >> a.tmp/file.txt echo 0oo >> a.tmp/file.txt echo 1oo >> a.tmp/file.txt echo 2oo >> a.tmp/file.txt echo 3OO >> a.tmp/file.txt echo 4oo >> a.tmp/file.txt ./unison testmerge -ui text -batch rm a.tmp/file.txt b.tmp/file.txt echo 1OO >> a.tmp/file.txt echo second >> a.tmp/file.txt echo 3oo >> a.tmp/file.txt echo 4oo >> a.tmp/file.txt echo 5oo >> a.tmp/file.txt echo 6oo >> a.tmp/file.txt echo 7oo >> a.tmp/file.txt echo 8oo >> a.tmp/file.txt echo 9oo >> a.tmp/file.txt echo 0oo >> a.tmp/file.txt echo 1oo >> a.tmp/file.txt echo 2oo >> a.tmp/file.txt echo 3oo >> a.tmp/file.txt echo 4oo >> a.tmp/file.txt echo 5oo >> a.tmp/file.txt echo 6oo >> a.tmp/file.txt echo 5oo >> a.tmp/file.txt echo 6oo >> a.tmp/file.txt echo 7oo >> a.tmp/file.txt echo 8oo >> a.tmp/file.txt echo 9oo >> a.tmp/file.txt echo 0oo >> a.tmp/file.txt echo 1oo >> a.tmp/file.txt echo 2oo >> a.tmp/file.txt echo 3OO >> a.tmp/file.txt echo 4oo >> a.tmp/file.txt echo --- echo 1OO >> b.tmp/file.txt echo 2oo >> b.tmp/file.txt echo 3oo >> b.tmp/file.txt echo 4oo >> b.tmp/file.txt echo 5oo >> b.tmp/file.txt echo 6oo >> b.tmp/file.txt echo 7oo >> b.tmp/file.txt echo 8oo >> b.tmp/file.txt echo 9oo >> b.tmp/file.txt echo 0oo >> b.tmp/file.txt echo 1oo >> b.tmp/file.txt echo 2oo >> b.tmp/file.txt echo 3oo >> b.tmp/file.txt echo 4oo >> b.tmp/file.txt echo 5oo >> b.tmp/file.txt echo 6oo >> b.tmp/file.txt echo 5oo >> b.tmp/file.txt echo 6oo >> b.tmp/file.txt echo 7oo >> b.tmp/file.txt echo 8oo >> b.tmp/file.txt echo 9oo >> b.tmp/file.txt echo 0oo >> b.tmp/file.txt echo 1oo >> b.tmp/file.txt echo 2oo >> b.tmp/file.txt echo 3OO >> b.tmp/file.txt echo end >> b.tmp/file.txt @echo @echo ----------------------------------------------------------- @echo ./unison testmerge -ui text -batch -debug files -debug update -debug backup @echo @echo ----------------------------------------------------------- @echo ./unison testmerge -ui text -batch @echo @echo ----------------------------------------------------------- @echo cat a.tmp/file.txt cat b.tmp/file.txt cat $(HOME)/.unison/backup/file.txt ###################################################################### # Tags # In Windows, tags and TAGS are the same, so make tags stops working # after the first invocation. The .PHONY declaration makes it work # again. .PHONY: tags tags: -$(ETAGS) *.mli */*.mli *.ml */*.ml */*.m *.c */*.c *.txt all:: TAGS TAGS: $(MAKE) tags ###################################################################### # Misc clean:: -$(RM) *.log *.aux *.log *.dvi *.out *.bak -$(RM) -r obsolete -$(RM) $(NAME) $(NAME).exe -$(RM) $(NAME)-blob.o clean:: $(MAKE) -C ubase clean $(MAKE) -C lwt clean ifeq (${OSARCH},osx) clean:: -(cd $(UIMACDIR); xcodebuild clean) -(cd $(UIMACDIR); $(RM) -r build ExternalSettings.xcconfig) endif checkin: $(MAKE) -C .. checkin installremote: $(MAKE) UISTYLE=text -unison eniac -path current/unison/trunk/src -batch ssh eniac.seas.upenn.edu make -C current/unison/trunk/src installtext #################################################################### # Documentation strings # Cons up a fake strings.ml if necessary (the real one is generated when # we build the documentation, but we need to be able to compile the # executable here to do that!) strings.ml: echo "(* Dummy strings.ml *)" > strings.ml echo "let docs = []" >> strings.ml unison-2.32.52/Makefile.OCaml0000644000076500000000000002512311216404404015263 0ustar bcpiercewheel#################################################################### # 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.4 # 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 \ \ bytearray.cmo case.cmo pred.cmo uutil.cmo \ fileutil.cmo name.cmo path.cmo fspath.cmo fingerprint.cmo \ abort.cmo osx.cmo external.cmo \ props.cmo fileinfo.cmo os.cmo lock.cmo clroot.cmo common.cmo \ 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 bigarray.cma COBJS+=osxsupport$(OBJ_EXT) pty$(OBJ_EXT) bytearray_stubs$(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) unison-2.32.52/mkProjectInfo.ml0000644000076500000000000000410311222164453015734 0ustar bcpiercewheel(* 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: 365 $";; 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;; unison-2.32.52/name.ml0000644000076500000000000000300611176730177014115 0ustar bcpiercewheel(* Unison file synchronizer: src/name.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) (* NOTE: IF YOU CHANGE TYPE "NAME", THE ARCHIVE FORMAT CHANGES; INCREMENT "UPDATE.ARCHIVEFORMAT" *) type t = string let compare n1 n2 = if Case.insensitive () then Util.nocase_cmp (Case.normalize n1) (Case.normalize n2) else compare n1 n2 let eq a b = (0 = (compare a b)) let toString n = n let fromString s = if String.length s = 0 then raise(Invalid_argument "Name.fromString(empty string)"); (* Make sure there are no slashes in the s *) begin try ignore(String.index s '/'); raise (Util.Transient (Printf.sprintf "Filename '%s' contains a '/'" s)) with Not_found -> () end; (* We ought to consider further checks, e.g., in Windows, no colons *) s let hash n = Hashtbl.hash (if Case.insensitive () then String.lowercase (Case.normalize n) else n) unison-2.32.52/name.mli0000644000076500000000000000037711176730177014276 0ustar bcpiercewheel(* 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 unison-2.32.52/NEWS0000644000076500000000000025143611222164527013346 0ustar bcpiercewheel Changes in Version 2.32.52 Changes since 2.32.44: * Improvement to the code for resuming directory transfers: (1) make sure file information (permissions, ...) has been properly set when using a previously transferred temp file (2) make sure previously transferred directories are writable (other changes made in the developer version of Unison require a protocol change) * Got rid of the 16MiB marshalling limit by marshalling to a bigarray * Ignore one hour differences for deciding whether a file may have been updated. This avoids slow update detection after daylight saving time changes under Windows. This makes it slightly more likely to miss an update, but that should be safe enough. * Improved Unison icon under Windows * Case sensitivity information put in the archive (in a backward compatible way) and checked when the archive is loaded * Uses improved emulation of "select" call provided by Ocaml 3.11 under Windows (the GUI does not freeze as much during synchronization) * Upgraded to GPL version 3 and added copyright notice to documentation files. * 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. * Text UI + During update detection, display status by updating a single line rather than generating a new line of output every so often. That should be less confusing. + In repeat mode, don't save the archives when there is no update. Indeed, in this mode, we should minimize the amount of work performed and it is unlikely that the archives have changed much. * Bugfixes + Fixed quotation of paths and names when writing to a preference file + Fixed bug resulting in slow performances when transferring a file using our rsync implementation from a 64-bit architecture to a 32-bit architecture. + Fixed bug in Lwt_unix.run which could make it fail with a Not_found exception (see [Not_found raised in tryCopyMovedFile] errors) + Properly deals with non-conformant AppleDouble files produced by Mac OS X. + Fixed bug that results in Unison missing ressource fork changes + Applied a patch from Karl M to make the GTK2 version build with OCaml 3.11 on Windows. + Added some extra debugging code to remote.ml to give more informative error messages when people encounter the longstanding "assert failed during file transfer" bug. + Applied patch from Antoine Reilles for NetBSD compilation + Resizing the update window vertically no longer moves the status label. Fix contributed by Pedro Melo. Changes since 2.31: * Minor fixes and improvements: + Ignore one hour differences when deciding whether a file may have been updated. This avoids slow update detection after daylight saving time changes under Windows. This makes Unison slightly more likely to miss an update, but it should be safe enough. + Fix a small bug that was affecting mainly windows users. We need to commit the archives at the end of the sync even if there are no updates to propagate because some files (in fact, if we've just switched to DST on windows, a LOT of files) might have new modtimes in the archive. (Changed the text UI only. It's less clear where to change the GUI.) + Don't delete the temp file when a transfer fails due to a fingerprint mismatch (so that we can have a look and see why!) We've also added more debugging code togive more informative error messages when we encounter the dreaded and longstanding "assert failed during file transfer" bug Changes since 2.27: * If Unison is interrupted during a directory transfer, it will now leave the partially transferred directory intact in a temporary location. (This maintains the invariant that new files/directories are transferred either completely or not at all.) The next time Unison is run, it will continue filling in this temporary directory, skipping transferring files that it finds are already there. * We've added experimental support for invoking an external file transfer tool for whole-file copies instead of Unison's built-in transfer protocol. Three new preferences have been added: + copyprog is a string giving the name (and command-line switches, if needed) of an external program that can be used to copy large files efficiently. By default, rsync is invoked, but other tools such as scp can be used instead by changing the value of this preference. (Although this is not its primary purpose, rsync is actually a pretty fast way of copying files that don't already exist on the receiving host.) For files that do already exist on (but that have been changed in one replica), Unison will always use its built-in implementation of the rsync algorithm. + Added a "copyprogrest" preference, so that we can give different command lines for invoking the external copy utility depending on whether a partially transferred file already exists or not. (Rsync doesn't seem to care about this, but other utilities may.) + copythreshold is an integer (-1 by default), indicating above what filesize (in megabytes) Unison should use the external copying utility specified by copyprog. Specifying 0 will cause ALL copies to use the external program; a negative number will prevent any files from using it. (Default is -1.) Thanks to Alan Schmitt for a huge amount of hacking and to an anonymous sponsor for suggesting and underwriting this extension. * Small improvements: + Added a new preference, dontchmod. By default, Unison uses the chmod system call to set the permission bits of files after it has copied them. But in some circumstances (and under some operating systems), the chmod call always fails. Setting this preference completely prevents Unison from ever calling chmod. + Don't ignore files that look like backup files if the backuplocation preference is set to central + Shortened the names of several preferences. The old names are also still supported, for backwards compatibility, but they do not appear in the documentation. + Lots of little documentation tidying. (In particular, preferences are separated into Basic and Advanced! This should hopefully make Unison a little more approachable for new users. + Unison can sometimes fail to transfer a file, giving the unhelpful message "Destination updated during synchronization" even though the file has not been changed. This can be caused by programs that change either the file's contents or the file's extended attributes without changing its modification time. It's not clear what is the best fix for this - it is not Unison's fault, but it makes Unison's behavior puzzling - but at least Unison can be more helpful about suggesting a workaround (running once with fastcheck set to false). The failure message has been changed to give this advice. + Further improvements to the OS X GUI (thanks to Alan Schmitt and Craig Federighi). * Very preliminary support for triggering Unison from an external filesystem-watching utility. The current implementation is very simple, not efficient, and almost completely untested--not ready for real users. But if someone wants to help improve it (e.g., by writing a filesystem watcher for your favorite OS), please make yourself known! On the Unison side, the new behavior is very simple: + use the text UI + start Unison with the command-line flag "-repeat FOO", where FOO is name of a file where Unison should look for notifications of changes + when it starts up, Unison will read the whole contents of this file (on both hosts), which should be a newline-separated list of paths (relative to the root of the synchronization) and synchronize just these paths, as if it had been started with the "-path=xxx" option for each one of them + when it finishes, it will sleep for a few seconds and then examine the watchfile again; if anything has been added, it will read the new paths, synchronize them, and go back to sleep + that's it! To use this to drive Unison "incrementally," just start it in this mode and start up a tool (on each host) to watch for new changes to the filesystem and append the appropriate paths to the watchfile. Hopefully such tools should not be too hard to write. * Bug fixes: + Fixed a bug that was causing new files to be created with permissions 0x600 instead of using a reasonable default (like 0x644), if the 'perms' flag was set to 0. (Bug reported by Ben Crowell.) + Follow maxthreads preference when transferring directories. Changes since 2.17: * Major rewrite and cleanup of the whole Mac OS X graphical user interface by Craig Federighi. Thanks, Craig!!! * Small fix to ctime (non-)handling in update detection under windows with fastcheck. * Several small fixes to the GTK2 UI to make it work better under Windows [thanks to Karl M for these]. * The backup functionality has been completely rewritten. The external interface has not changed, but numerous bugs, irregular behaviors, and cross-platform inconsistencies have been corrected. * 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 Unison home page (http://www.cis.upenn.edu/ bcpierce/unison/lists.html). * Some important safety improvements: + Added a new 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. + The confirmation of "big deletes" is now controlled by a boolean preference confirmbigdeletes. Default is true, which gives the same behavior as previously. (This functionality is at least partly superceded by the mountpoint preference, but it has been left in place in case it is useful to some people.) + 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!). * Smaller changes: + Added forcepartial and preferpartial preferences, which behave like force and prefer but can be specified on a per-path basis. [Thanks to Alan Schmitt for this.] + 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). + 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. + Removed mergebatch preference. (It never seemed very useful, and its semantics were confusing.) + Rewrote some of the merging functionality, for better cooperation with external Harmony instances. + Changed the temp file prefix from .# to .unison. + Compressed the output from the text user interface (particularly when run with the -terse flag) to make it easier to interpret the results when Unison is run several times in succession from a script. + Diff and merge functions now work under Windows. + Changed the order of arguments to the default diff command (so that the + and - annotations in diff's output are reversed). + Added .mpp files to the "never fastcheck" list (like .xls files). * Many small bugfixes, including: + 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.) + Fixed a bug that would occasionally cause the archives to be left in non-identical states on the two hosts after synchronization. + Fixed a bug that prevented Unison from communicating correctly between 32- and 64-bit architectures. + 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!) + Set read-only file to R/W on OSX before attempting to change other attributes. + Fixed bug resulting in spurious "Aborted" errors during transport (thanks to Jerome Vouillon) + Enable diff if file contents have changed in one replica, but only properties in the other. + Removed misleading documentation for 'repeat' preference. + Fixed a bug in merging code where Unison could sometimes deadlock with the external merge program, if the latter produced large amounts of output. + Workaround for a bug compiling gtk2 user interface against current versions of gtk2+ libraries. + Added a better error message for "ambiguous paths". + Squashed a longstanding bug that would cause file transfer to fail with the message "Failed: Error in readWrite: Is a directory." + 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. + 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 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. Changes since 2.13.0: * 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 backupXXX preferences) for details. * 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.) * OSX interface: + Incorporated Ben Willmore's cool new icon for the Mac UI. * Small fixes: + Fixed off by one error in month numbers (in printed dates) reported by Bob Burger Changes since 2.12.0: * New convention for release numbering: Releases will continue to be given numbers of the form X.Y.Z, but, from now on, just the major version number (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. * Warning (failure in batch mode) when one path is completely emptied. This prevents Unison from deleting everything on one replica when the other disappear. * Fix diff bug (where no difference is shown the first time the diff command is given). * User interface changes: + Improved workaround for button focus problem (GTK2 UI) + Put leading zeroes in date fields + More robust handling of character encodings in GTK2 UI + Changed format of modification time displays, from modified at hh:mm:ss on dd MMM, yyyy to modified on yyyy-mm-dd hh:mm:ss + 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!) + Use the diff "-u" option by default when showing differences between files (the output is more readable) + In text mode, pipe the diff output to a pager if the environment variable PAGER is set + 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!) + Include profile name in the GTK2 window name + Added bindings ',' (same as '<') and '.' (same as '>') in the GTK2 UI * Mac GUI: + actions like < and > scroll to the next item as necessary. + Restart has a menu item and keyboard shortcut (command-R). + Added a command-line tool for Mac OS X. It can be installed from the Unison menu. + New icon. + Handle the "help" command-line argument properly. + Handle profiles given on the command line properly. + 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. + Size of left and right columns is now large enough so that "PropsChanged" is not cut off. * Minor changes: + Disable multi-threading when both roots are local + Improved error handling code. In particular, make sure all files are closed in case of a transient failure + Under Windows, use $UNISON for home directory as a last resort (it was wrongly moved before $HOME and $USERPROFILE in Unison 2.12.0) + Reopen the logfile if its name changes (profile change) + 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. + 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. + Attempt to resolve issues with synchronizing modification times of read-only files under Windows + Ignore chmod failures when deleting files + Ignore trailing dots in filenames in case insensitive mode + Proper quoting of paths, files and extensions ignored using the UI + The strings CURRENT1 and CURRENT2 are now correctly substitued when they occur in the diff preference + Improvements to syncing resource forks between Macs via a non-Mac system. Changes since 2.10.2: * INCOMPATIBLE CHANGE: Archive format has changed. * Source code availability: The Unison sources are now managed using Subversion. One nice side-effect is that anonymous checkout is now possible, like this: svn co https://cvs.cis.upenn.edu:3690/svnroot/unison/ 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 unison-hackers list (http://www.cis.upenn.edu/ bcpierce/unison/lists.html). * Text user interface: + Substantial reworking of the internal logic of the text UI to make it a bit easier to modify. + The dumbtty flag in the text UI is automatically set to true if the client is running on a Unix system and the EMACS environment variable is set to anything other than the empty string. * Native OS X gui: + Added a synchronize menu item with keyboard shortcut + Added a merge menu item, still needs to be debugged + Fixes to compile for Panther + Miscellaneous improvements and bugfixes * Small changes: + Changed the filename checking code to apply to Windows only, instead of OS X as well. + Finder flags now synchronized + Fallback in copy.ml for filesystem that do not support O_EXCL + Changed buffer size for local file copy (was highly inefficient with synchronous writes) + Ignore chmod failure when deleting a directory + Fixed assertion failure when resolving a conflict content change / permission changes in favor of the content change. + Workaround for transferring large files using rsync. + Use buffered I/O for files (this is the only way to open files in binary mode under Cygwin). + 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 HOME and USERPROFILE in that order. On Unix and Cygwin systems, HOME is used. + Generalized 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 CURRENT1 and CURRENT2, which will be replaced by the names of the files to be diff'ed before the command is called. + Recognize password prompts in some newer versions of ssh. Changes since 2.9.20: * INCOMPATIBLE CHANGE: Archive format has changed. * Major functionality changes: + 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 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. + Files larger than 2Gb are now supported. + Added preliminary (and still somewhat experimental) support for the Apple OS X operating system. o 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. o On OSX systems, the name of the directory for storing Unison's archives, preference files, etc., is now determined as follows: # if ~/.unison exists, use it # otherwise, use ~/Library/Application Support/Unison, creating it if necessary. o 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 UISTYLE=mac to build this interface. * Minor functionality changes: + Added an 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.) + Added a new preference 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 assumeContentsAreImmutableNot, which overrides the first, similarly to ignorenot. (Later amendment: these preferences are now called immutable and immutablenot.) + 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. If you have been setting ignorecase on the command line using -ignorecase=true or -ignorecase=false, you will need to change to -ignorecase true or -ignorecase false. + 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. + Excel files are now handled specially, so that the fastcheck optimization is skipped even if the fastcheck flag is set. (Excel does some naughty things with modtimes, making this optimization unreliable and leading to failures during change propagation.) + 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. + 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. + 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. * Documentation + The web pages have been completely redesigned and reorganized. (Thanks to Alan Schmitt for help with this.) * User interface improvements + Added a GTK2 user interface, capable (among other things) of displaying filenames in any locale encoding. Kudos to Stephen Tse for contributing this code! + The text UI now prints a list of failed and skipped transfers at the end of synchronization. + 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). + Several small improvements to the text user interface, including a progress display. * Bug fixes (too numerous to count, actually, but here are some): + The maxthreads preference works now. + 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.) + Fixed a problem on OS X that caused some valid file names (e.g., those including colons) to be considered invalid. + Patched Path.followLink to follow links under cygwin in addition to Unix (suggested by Matt Swift). + 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. + Incorporated a fix by Dmitry Bely for setting utimes of read-only files on Win32 systems. * Installation / portability: + Unison now compiles with OCaml version 3.07 and later out of the box. + Makefile.OCaml fixed to compile out of the box under OpenBSD. + a few additional ports (e.g. OpenBSD, Zaurus/IPAQ) are now mentioned in the documentation + Unison can now be installed easily on OSX systems using the Fink package manager Changes since 2.9.1: * Added a preference maxthreads that can be used to limit the number of simultaneous file transfers. * Added a backupdir preference, which controls where backup files are stored. * 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.) * 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. * Several small user interface improvements * Documentation + FAQ and bug reporting instructions have been split out as separate HTML pages, accessible directly from the unison web page. + Additions to FAQ, in particular suggestions about performance tuning. * Makefile + Makefile.OCaml now sets UISTYLE=text or UISTYLE=gtk automatically, depending on whether it finds lablgtk installed + Unison should now compile "out of the box" under OSX Changes since 2.8.1: * Changing profile works again under Windows * 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". * Network statistics window (transfer rate, amount of data transferred). [NB: not available in Windows-Cygwin version.] * symlinks work under the cygwin version (which is dynamically linked). * Fixed potential deadlock when synchronizing between Windows and Unix * Small improvements: + If neither the USERPROFILE nor the HOME environment variables are set, then Unison will put its temporary commit log (called DANGER.README) into the directory named by the UNISON environment variable, if any; otherwise it will use C:. + alternative set of values for fastcheck: yes = true; no = false; default = auto. + -silent implies -contactquietly * Source code: + 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.) + several Makefile and docs changes (for release); + further comments in "update.ml"; + connection information is not stored in global variables anymore. Changes since 2.7.78: * 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). Changes since 2.7.39: * Improvements to the main web page (stable and beta version docs are now both accessible). * User manual revised. * Added some new preferences: + "sshcmd" and "rshcmd" for specifying paths to ssh and rsh programs. + "contactquietly" for suppressing the "contacting server" message during Unison startup (under the graphical UI). * Bug fixes: + Fixed small bug in UI that neglected to change the displayed column headers if loading a new profile caused the roots to change. + Fixed a bug that would put the text UI into an infinite loop if it encountered a conflict when run in batch mode. + 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.) + `-prefer/-force newer' works properly now. (The bug was reported by Sebastian Urbaniak and Sean Fulton.) * User interface and Unison behavior: + Renamed `Proceed' to `Go' in the graphical UI. + Added exit status for the textual user interface. + Paths that are not synchronized because of conflicts or errors during update detection are now noted in the log file. + [END] messages in log now use a briefer format + Changed the text UI startup sequence so that ./unison -ui text will use the default profile instead of failing. + Made some improvements to the error messages. + Added some debugging messages to remote.ml. Changes since 2.7.7: * 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: + Two log entries for each transferring task, one for the beginning, one for the end. + 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 .#..unison.tmp. [N.b. This was later changed to .unison...unison.tmp.] * Added a new command to the GTK user interface: pressing 'f' causes Unison to start a new update detection phase, using as paths 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. * Made the 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.) * Small improvements and bug fixes: + 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. + Error reporting for preference files now provides file name and line number. + 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." + Files with prefix '.#' excluded when scanning for preference files. + Rsync instructions are send directly instead of first marshaled. + Won't try forever to get the fingerprint of a continuously changing file: unison will give up after certain number of retries. + Other bug fixes, including the one reported by Peter Selinger (force=older preference not working). * Compilation: + Upgraded to the new OCaml 3.04 compiler, with the LablGtk 1.2.3 library (patched version used for compiling under Windows). + Added the option to compile unison on the Windows platform with Cygwin GNU C compiler. This option only supports building dynamically linked unison executables. Changes since 2.7.4: * Fixed a silly (but debilitating) bug in the client startup sequence. Changes since 2.7.1: * Added addprefsto preference, which (when set) controls which preference file new preferences (e.g. new ignore patterns) are added to. * 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.) Changes since 2.6.59: * Changed fastcheck from a boolean to a string preference. Its legal values are yes (for a fast check), no (for a safe check), or 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 default. * 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. * The temp files created by the 'diff' and 'merge' commands are now named by prepending 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. * 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. * Bug fixes: + When updating small files, Unison now closes the destination file. + File permissions are properly updated when the file is behind a followed link. + Several other small fixes. Changes since 2.6.38: * Major Windows performance improvement! We've added a preference 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 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 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 fastcheck preference, pay careful attention to what Unison is doing. * New functionality: centralized backups and merging + This version incorporates two pieces of major new functionality, implemented by Sylvain Roy during a summer internship at Penn: a centralized backup facility that keeps a full backup of (selected files in) each replica, and a merging feature that allows Unison to invoke an external file-merging tool to resolve conflicting changes to individual files. + Centralized backups: o 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. o 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 UNISONBACKUPDIR.) o The predicate backup controls which files are actually backed up: giving the preference 'backup = Path *' causes backing up of all files. o Files are added to the backup directory whenever unison updates its archive. This means that # 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. # Otherwise, each file will be backed up the first time unison propagates an update for it. o The preference backupversions controls how many previous versions of each file are kept. The default is 2 (i.e., the last synchronized version plus one backup). o For backward compatibility, the backups preference is also still supported, but backup is now preferred. o 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. + Merging: o Both user interfaces offer a new 'merge' command, invoked by pressing 'm' (with a changed file selected). o The actual merging is performed by an external program. The preferences merge and merge2 control how this program is invoked. If a backup exists for this file (see the backup preference), then the merge preference is used for this purpose; otherwise 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 CURRENT1, CURRENT2, NEW, and OLD may appear at any point. Unison will substitute these as follows before invoking the command: # CURRENT1 is replaced by the name of the local copy of the file; # 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; # 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 # 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 merge, not merge2). For example, on Unix systems setting the merge preference to merge = diff3 -m CURRENT1 OLD CURRENT2 > NEW will tell Unison to use the external diff3 program for merging. A large number of external merging programs are available. For example, emacs users may find the following convenient: 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")' (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.) o If the external program exits without leaving any file at the path NEW, Unison considers the merge to have failed. If the merge program writes a file called 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 editor preference controls what editor is invoked by Unison. The default is emacs. o Please send us suggestions for other useful values of the merge2 and merge preferences - we'd like to give several examples in the manual. * Smaller changes: + When one preference file includes another, unison no longer adds the suffix '.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 .prf, as it did before. (This change means that included preference files can be named blah.include instead of blah.prf, so that unison will not offer them in its 'choose a preference file' dialog.) + 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. + Fixed the force and prefer preferences, which were getting the propagation direction exactly backwards. + Fixed a bug in the startup code that would cause unison to crash when the default profile (~/.unison/default.prf) does not exist. + 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. * For developers: + We've added a module dependency diagram to the source distribution, in src/DEPENDENCIES.ps, to help new prospective developers with navigating the code. Changes since 2.6.11: * INCOMPATIBLE CHANGE: Archive format has changed. * INCOMPATIBLE CHANGE: The startup sequence has been completely rewritten and greatly simplified. The main user-visible change is that the defaultpath preference has been removed. Its effect can be approximated by using multiple profiles, with include directives to incorporate common settings. All uses of defaultpath in existing profiles should be changed to path. Another change in startup behavior that will affect some users is that it is no longer possible to specify roots both in the profile and on the command line. You can achieve a similar effect, though, by breaking your profile into two: default.prf = root = blah root = foo include common common.prf = Now do unison common root1 root2 when you want to specify roots explicitly. * The -prefer and -force options have been extended to allow users to specify that files with more recent modtimes should be propagated, writing either -prefer newer or -force newer. (For symmetry, Unison will also accept -prefer older or -force older.) The -force older/newer options can only be used when -times is also set. The graphical user interface provides access to these facilities on a one-off basis via the Actions menu. * 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.) * Graphical user-interface: + A new command is provided in the Synchronization menu for switching to a new profile without restarting Unison from scratch. + The GUI also supports one-key shortcuts for commonly used profiles. If a profile contains a preference of the form 'key = n', where 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.) + Each profile may include a preference 'label = ' giving a descriptive string that described the options selected in this profile. The string is listed along with the profile name in the profile selection dialog, and displayed in the top-right corner of the main Unison window. * Minor: + 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.) + On Unix systems, the graphical version of Unison will check the DISPLAY variable and, if it is not set, automatically fall back to the textual user interface. + Synchronization paths (path preferences) are now matched against the ignore preferences. So if a path is both specified in a path preference and ignored, it will be skipped. + Numerous other bugfixes and small improvements. Changes since 2.6.1: * The synchronization of modification times has been disabled for directories. * Preference files may now include lines of the form include , which will cause name.prf to be read at that point. * The synchronization of permission between Windows and Unix now works properly. * A binding CYGWIN=binmode in now added to the environment so that the Cygwin port of OpenSSH works properly in a non-Cygwin context. * The servercmd and addversionno preferences can now be used together: -addversionno appends an appropriate -NNN to the server command, which is found by using the value of the -servercmd preference if there is one, or else just unison. * Both '-pref=val' and '-pref val' are now allowed for boolean values. (The former can be used to set a preference to false.) * Lot of small bugs fixed. Changes since 2.5.31: * The log preference is now set to true by default, since the log file seems useful for most users. * Several miscellaneous bugfixes (most involving symlinks). Changes since 2.5.25: * INCOMPATIBLE CHANGE: Archive format has changed (again). * Several significant bugs introduced in 2.5.25 have been fixed. Changes since 2.5.1: * INCOMPATIBLE CHANGE: Archive format has changed. Make sure you synchronize your replicas before upgrading, to avoid spurious conflicts. The first sync after upgrading will be slow. * New functionality: + 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 false by default. o When the times preference is set to 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.) o When the owner preference is set to true, file ownership information is synchronized. o When the group preference is set to true, group information is synchronized. o When the numericIds preference is set to 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.) + Added an integer-valued preference 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. + Added a log preference (default 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 unison.log in the user's home directory (the value of the HOME environment variable). If you want it someplace else, set the logfile preference to the full pathname you want Unison to use. + Added an ignorenot preference that maintains a set of patterns for paths that should definitely not be ignored, whether or not they match an ignore pattern. (That is, a path will now be ignored iff it matches an ignore pattern and does not match any ignorenot patterns.) * User-interface improvements: + 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. + When the 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. + Added a new preference for controlling how many status messages are printed during update detection: 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. + Removed the trace and silent preferences. They did not seem very useful, and there were too many preferences for controlling output in various ways. + The text UI now displays just the default command (the one that will be used if the user just types ) instead of all available commands. Typing ? will print the full list of possibilities. + 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 gethostname operating system call. However, if the environment variable 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). + File owner and group are now displayed in the "detail window" at the bottom of the screen, when unison is configured to synchronize them. * For hackers: + Updated to Jacques Garrigue's new version of 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.) + 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. + The Tk user interface has been removed (it was not being maintained and no longer compiles). + The debug preference now prints quite a bit of additional information that should be useful for identifying sources of problems. + 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.) + 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. * Bug fixes: + Pattern matching (e.g. for ignore) is now case-insensitive when Unison is in case-insensitive mode (i.e., when one of the replicas is on a windows machine). + 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. + Numerous smaller fixes. Changes since 2.4.1: * 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: + Setting the sortnewfirst preference to true causes newly created files to be displayed before changed files. + Setting sortbysize causes files to be displayed in increasing order of size. + Giving the preference sortfirst= (where is a path descriptor in the same format as 'ignore' and 'follow' patterns, causes paths matching this pattern to be displayed first. + Similarly, giving the preference sortlast= causes paths matching this pattern to be displayed last. The sorting preferences are described in more detail in the user manual. The sortnewfirst and sortbysize flags can also be accessed from the 'Sort' menu in the grpahical user interface. * 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. + Giving the preference prefer with argument (by adding -prefer to the command line or prefer=) to your profile) means that, if there is a conflict, the contents of should be propagated to the other replica (with no questions asked). Non-conflicting changes are treated as usual. + Giving the preference force with argument will make unison resolve all differences in favor of the given root, even if it was the other replica that was changed. These options should be used with care! (More information is available in the manual.) * Small changes: + Changed default answer to 'Yes' in all two-button dialogs in the graphical interface (this seems more intuitive). + The rsync preference has been removed (it was used to activate rsync compression for file transfers, but rsync compression is now enabled by default). + 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 (====> instead of ---->). This matches the behavior of the graphical interface, which displays such arrows in a different color. + Carriage returns (Control-M's) are ignored at the ends of lines in profiles, for Windows compatibility. + All preferences are now fully documented in the user manual. Changes since 2.3.12: * INCOMPATIBLE CHANGE: Archive format has changed. Make sure you synchronize your replicas before upgrading, to avoid spurious conflicts. The first sync after upgrading will be slow. * New/improved functionality: + 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.) + A new preference -sortnewfirst causes newly created files to be listed before other updates in the user interface. + We now allow the ssh protocol to specify a port. + 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 ssh://saul/foo.) + 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. + In all user interfaces, files with conflicts are always listed first + 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.) + 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) * Improvements for the Windows version: + 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. + It should be possible to synchronize with Windows shares, e.g., //host/drive/path. + 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. * Improvements to the GTK user interface (the Tk interface is no longer being maintained): + The UI now displays actions differently (in blue) when they have been explicitly changed by the user from Unison's default recommendation. + More colorful appearance. + The initial profile selection window works better. + 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). + Added a global progress meter, displaying the percentage of total bytes that have been transferred so far. * Improvements to the text user interface: + The file details will be displayed automatically when a conflict is been detected. + 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. + The UI now displays a short list of possible inputs each time it waits for user interaction. + 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. + Pressing 'g' in the text user interface will proceed immediately with propagating updates, without asking any more questions. * Documentation and installation changes: + The manual now includes a FAQ, plus sections on common problems and on tricks contributed by users. + Both the download page and the download directory explicitly say what are the current stable and beta-test version numbers. + 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. + Added a subsection to the manual describing cross-platform issues (case conflicts, illegal filenames) * Many small bug fixes and random improvements. Changes since 2.3.1: * 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. Changes since 2.2: * The multi-threaded transport system is now disabled by default. (It is not stable enough yet.) * Various bug fixes. * A new experimental feature: The final component of a -path argument may now be the wildcard specifier *. 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 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.) Changes since 2.1: * The transport subsystem now includes an implementation by Sylvain Gommier and Norman Ramsey of Tridgell and Mackerras's 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 -rsync option (or put rsync=true in your preferences file) to turn it on. * "Progress bars" are now diplayed during remote file transfers, showing what percentage of each file has been transferred so far. * 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." * Miscellaneous improvements to the GTK-based user interface. * The manual is now available in PDF format. * 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 -with-pthreads configuration option. (You can verify this by checking whether the file threads/threads.cma in the OCaml standard library directory contains the string -lpthread near the end.) Changes since 1.292: * 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). * Fixed a bug that would cause the socket server under NT to fail after the client exits. * Added a SHIFT modifier to the Ignore menu shortcut keys in GTK interface (to avoid hitting them accidentally). Changes since 1.231: * Tunneling over ssh is now supported in the Windows version. See the installation section of the manual for detailed instructions. * The transport subsystem now includes an implementation of the 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 -rsync switch to turn it on. (Nb. We still have a lot of tuning to do: you may not notice much speedup yet.) * 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 make THREADS=true.) Native thread support from the compiler is required. Use the option -threads N to select the maximal number of concurrent threads (default is 5). Multi-threaded and single-threaded clients/servers can interoperate. * 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. * OCaml 3.00 is now required for compiling Unison from sources. The modules uitk and 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 c:\Tcl rather than the suggested c:\Program Files\Tcl, and be sure to install the headers and libraries (which are not installed by default). * Added a new -addversionno switch, which causes unison to use unison- instead of just 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. Changes since 1.219: * INCOMPATIBLE CHANGE: Archive format has changed. Make sure you synchronize your replicas before upgrading, to avoid spurious conflicts. The first sync after upgrading will be slow. * This version fixes several annoying bugs, including: + Some cases where propagation of file permissions was not working. + umask is now ignored when creating directories + directories are create writable, so that a read-only directory and its contents can be propagated. + Handling of warnings generated by the server. + Synchronizing a path whose parent is not a directory on both sides is now flagged as erroneous. + Fixed some bugs related to symnbolic links and nonexistant roots. o 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) o 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. * A human-readable timestamp has been added to Unison's archive files. * The semantics of Path and Name regular expressions now correspond better. * Some minor improvements to the text UI (e.g. a command for going back to previous items) * The organization of the export directory has changed -- should be easier to find / download things now. Changes since 1.200: * INCOMPATIBLE CHANGE: Archive format has changed. Make sure you synchronize your replicas before upgrading, to avoid spurious conflicts. The first sync after upgrading will be slow. * This version has not been tested extensively on Windows. * Major internal changes designed to make unison safer to run at the same time as the replicas are being changed by the user. * Internal performance improvements. Changes since 1.190: * INCOMPATIBLE CHANGE: Archive format has changed. Make sure you synchronize your replicas before upgrading, to avoid spurious conflicts. The first sync after upgrading will be slow. * 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. * Reimplementation of low-level remote procedure call stuff, in preparation for adding rsync-like smart file transfer in a later release. * Miscellaneous bug fixes. Changes since 1.180: * INCOMPATIBLE CHANGE: Archive format has changed. Make sure you synchronize your replicas before upgrading, to avoid spurious conflicts. The first sync after upgrading will be slow. * Fixed some small bugs in the interpretation of ignore patterns. * Fixed some problems that were preventing the Windows version from working correctly when click-started. * Fixes to treatment of file permissions under Windows, which were causing spurious reports of different permissions when synchronizing between windows and unix systems. * Fixed one more non-tail-recursive list processing function, which was causing stack overflows when synchronizing very large replicas. Changes since 1.169: * The text user interface now provides commands for ignoring files. * We found and fixed some more non-tail-recursive list processing functions. Some power users have reported success with very large replicas. * INCOMPATIBLE CHANGE: Files ending in .tmp are no longer ignored automatically. If you want to ignore such files, put an appropriate ignore pattern in your profile. * INCOMPATIBLE CHANGE: The syntax of ignore and follow patterns has changed. Instead of putting a line of the form ignore = in your profile (.unison/default.prf), you should put: ignore = Regexp Moreover, two other styles of pattern are also recognized: ignore = Name matches any path in which one component matches , while ignore = Path matches exactly the path . Standard "globbing" conventions can be used in and : + a ? matches any single character except / + a * matches any sequence of characters not including / + [xyz] matches any character from the set {x, y, z } + {a,bb,ccc} matches any one of a, bb, or ccc. See the user manual for some examples. Changes since 1.146: * 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. * Major additions to the documentation. Changes since 1.142: * Major internal tidying and many small bugfixes. * Major additions to the user manual. * 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. * Fixed a small bug where the text UI on NT was raising a 'no such signal' exception. Changes since 1.139: * 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. * Added a -debug command line flag, which controls debugging of various modules. Say -debug XXX to enable debug tracing for module XXX, or -debug all to turn on absolutely everything. * Fixed a small bug where the text UI on NT was raising a 'no such signal' exception. Changes since 1.111: * INCOMPATIBLE CHANGE: The names and formats of the preference files in the .unison directory have changed. In particular: + the file "prefs" should be renamed to default.prf + the contents of the file "ignore" should be merged into default.prf. Each line of the form REGEXP in ignore should become a line of the form ignore = REGEXP in default.prf. * Unison now handles permission bits and symbolic links. See the manual for details. * You can now have different preference files in your .unison directory. If you start unison like this unison profilename (i.e. with just one "anonymous" command-line argument), then the file ~/.unison/profilename.prf will be loaded instead of default.prf. * Some improvements to terminal handling in the text user interface * 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.) * 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.) * 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. * Added a file CONTRIB with some suggestions for how to help us make Unison better. unison-2.32.52/os.ml0000644000076500000000000003361211216376164013621 0ustar bcpiercewheel(* Unison file synchronizer: src/os.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) (* This file attempts to isolate operating system specific details from the *) (* rest of the program. *) let debug = Util.debug "os" let myCanonicalHostName = try Unix.getenv "UNISONLOCALHOSTNAME" with Not_found -> Unix.gethostname() let tempFilePrefix = ".unison." let tempFileSuffixFixed = ".unison.tmp" let tempFileSuffix = ref tempFileSuffixFixed let includeInTempNames s = (* BCP: Added this in Jan 08. If (as I believe) it never fails, then this tricky stuff can be deleted. *) assert (s<>""); tempFileSuffix := if s = "" then tempFileSuffixFixed else "." ^ s ^ tempFileSuffixFixed let xferDelete = ref (fun (fp,p) -> ()) let xferRename = ref (fun (fp,p) (ftp,tp) -> ()) let initializeXferFunctions del ren = xferDelete := del; xferRename := ren (*****************************************************************************) (* ESCAPING SHELL PARAMETERS *) (*****************************************************************************) (* Using single quotes is simpler under Unix but they are not accepted by the Windows shell. Double quotes without further quoting is sufficient with Windows as filenames are not allowed to contain double quotes. *) let quotes s = if Util.osType = `Win32 && not Util.isCygwin then "\"" ^ s ^ "\"" else "'" ^ Util.replacesubstring s "'" "'\\''" ^ "'" (*****************************************************************************) (* QUERYING THE FILESYSTEM *) (*****************************************************************************) let exists fspath path = (Fileinfo.get false fspath path).Fileinfo.typ <> `ABSENT let readLink fspath path = Util.convertUnixErrorsToTransient "reading symbolic link" (fun () -> let abspath = Fspath.concatToString fspath path in Unix.readlink abspath) let rec isAppleDoubleFile file = Prefs.read Osx.rsrc && String.length file > 2 && file.[0] = '.' && file.[1] = '_' (* Assumes that (fspath, path) is a directory, and returns the list of *) (* children, except for '.' and '..'. *) let allChildrenOf fspath path = Util.convertUnixErrorsToTransient "scanning directory" (fun () -> let rec loop children directory = let newFile = try Unix.readdir directory with End_of_file -> "" in if newFile = "" then children else let newChildren = if newFile = "." || newFile = ".." then children else Name.fromString newFile :: children in loop newChildren directory in let absolutePath = Fspath.concat fspath path in let directory = try Some (Fspath.opendir absolutePath) with Unix.Unix_error (Unix.ENOENT, _, _) -> (* FIX (in Ocaml): under Windows, when a directory is empty (not even "." and ".."), FindFirstFile fails with ERROR_FILE_NOT_FOUND while ocaml expects the error ERROR_NO_MORE_FILES *) None in match directory with Some directory -> begin try let result = loop [] directory in Unix.closedir directory; result with Unix.Unix_error _ as e -> begin try Unix.closedir directory with Unix.Unix_error _ -> () end; raise e end | None -> []) (* Assumes that (fspath, path) is a directory, and returns the list of *) (* children, except for temporary files and AppleDouble files. *) let rec childrenOf fspath path = List.filter (fun filename -> let file = Name.toString filename in if isAppleDoubleFile file then false (* does it belong to here ? *) (* else if Util.endswith file backupFileSuffix then begin *) (* let newPath = Path.child path filename in *) (* removeBackupIfUnwanted fspath newPath; *) (* false *) (* end *) else if Util.endswith file tempFileSuffixFixed && Util.startswith file tempFilePrefix then begin if Util.endswith file !tempFileSuffix then begin let p = Path.child path filename in let i = Fileinfo.get false fspath p in let secondsinthirtydays = 2592000.0 in if Props.time i.Fileinfo.desc +. secondsinthirtydays < Util.time() then begin debug (fun()-> Util.msg "deleting old temp file %s\n" (Fspath.concatToString fspath p)); delete fspath p end else debug (fun()-> Util.msg "keeping temp file %s since it is less than 30 days old\n" (Fspath.concatToString fspath p)); end; false end else true) (allChildrenOf fspath path) (*****************************************************************************) (* ACTIONS ON FILESYSTEM *) (*****************************************************************************) (* Deletes a file or a directory, but checks before if there is something *) and delete fspath path = Util.convertUnixErrorsToTransient "deleting" (fun () -> let absolutePath = Fspath.concatToString fspath path in match (Fileinfo.get false fspath path).Fileinfo.typ with `DIRECTORY -> begin try Unix.chmod absolutePath 0o700 with Unix.Unix_error _ -> () end; Safelist.iter (fun child -> delete fspath (Path.child path child)) (allChildrenOf fspath path); (!xferDelete) (fspath, path); Unix.rmdir absolutePath | `FILE -> if Util.osType <> `Unix then begin try Unix.chmod absolutePath 0o600; with Unix.Unix_error _ -> () end; (!xferDelete) (fspath, path); Unix.unlink absolutePath; if Prefs.read Osx.rsrc then begin let pathDouble = Osx.appleDoubleFile fspath path in if Sys.file_exists pathDouble then Unix.unlink pathDouble end | `SYMLINK -> (* Note that chmod would not do the right thing on links *) Unix.unlink absolutePath | `ABSENT -> ()) let rename fname sourcefspath sourcepath targetfspath targetpath = let source = Fspath.concat sourcefspath sourcepath in let source' = Fspath.toString source in let target = Fspath.concat targetfspath targetpath in let target' = Fspath.toString target in if source' = target' then raise (Util.Transient ("Rename ("^fname^"): identical source and target " ^ source')); Util.convertUnixErrorsToTransient ("renaming " ^ source' ^ " to " ^ target') (fun () -> debug (fun() -> Util.msg "rename %s to %s\n" source' target'); (!xferRename) (sourcefspath, sourcepath) (targetfspath, targetpath); Unix.rename source' target'; if Prefs.read Osx.rsrc then begin let sourceDouble = Osx.appleDoubleFile sourcefspath sourcepath in let targetDouble = Osx.appleDoubleFile targetfspath targetpath in if Sys.file_exists sourceDouble then Unix.rename sourceDouble targetDouble else if Sys.file_exists targetDouble then Unix.unlink targetDouble end) let symlink = if Util.isCygwin || (Util.osType != `Win32) then fun fspath path l -> Util.convertUnixErrorsToTransient "writing symbolic link" (fun () -> let abspath = Fspath.concatToString fspath path in Unix.symlink l abspath) else fun fspath path l -> raise (Util.Transient (Format.sprintf "Cannot create symlink \"%s\": \ symlinks are not supported under Windows" (Fspath.concatToString fspath path))) (* Create a new directory, using the permissions from the given props *) let createDir fspath path props = 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) None 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() unison-2.32.52/os.mli0000644000076500000000000000453111176730177013773 0ustar bcpiercewheel(* 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 unison-2.32.52/osx.ml0000644000076500000000000004350411216376164014012 0ustar bcpiercewheel(* 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 . *) let debug = Trace.debug "osx" (****) 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 ressource_fork_empty_tag = "This resource fork intentionally left blank " let finfoLength = 32L let emptyFinderInfo () = String.make 32 '\000' let empty_ressource_fork = "\000\000\001\000" ^ "\000\000\001\000" ^ "\000\000\000\000" ^ "\000\000\000\030" ^ ressource_fork_empty_tag ^ String.make (66+128) '\000' ^ "\000\000\001\000" ^ "\000\000\001\000" ^ "\000\000\000\000" ^ "\000\000\000\030" ^ "\000\000\000\000" ^ "\000\000\000\000" ^ "\000\028\000\030" ^ "\255\255" let empty_attribute_chunk () = "\000\000" ^ (* pad *) "ATTR" ^ (* magic *) "\000\000\000\000" ^ (* debug tag *) "\000\000\014\226" ^ (* total size *) "\000\000\000\156" ^ (* data_start *) "\000\000\000\000" ^ (* data_length *) "\000\000\000\000" ^ (* reserved *) "\000\000\000\000" ^ "\000\000\000\000" ^ "\000\000" ^ (* flags *) "\000\000" ^ (* num_attrs *) String.make 3690 '\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"; 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 let (offset, len) = Safelist.assoc `RSRC entries in (* We need to check that the ressource fork is not a dummy one included for compatibility reasons *) if len = 286L && protect (fun () -> LargeFile.seek_in inch (Int64.add offset 16L); let len = String.length ressource_fork_empty_tag in let buf = String.create len in really_input inch buf 0 len; buf = ressource_fork_empty_tag) (fun () -> close_in_noerr inch) then (0L, 0L) else (offset, len) with Not_found -> (0L, 0L) in debug (fun () -> Util.msg "AppleDouble for file %s / %s: ressource fork length: %d\n" (Fspath.toString fspath) (Path.toString path) (Int64.to_int rsrcLength)); let finfo = protect (fun () -> try let (ofs, len) = Safelist.assoc `FINFO entries in if len < finfoLength then fail doublePath "bad finder info"; readDoubleFromOffset doublePath inch ofs 32 with Not_found -> "") (fun () -> close_in_noerr inch) in close_in inch; let stats = Util.convertUnixErrorsToTransient "stating AppleDouble file" (fun () -> 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 (* Apparently, for compatibility with various old versions of Mac OS X that did not follow the AppleDouble specification, we have to include a dummy ressource fork... We also put an empty extended attribute section at the end of the finder info section, mimicking the Mac OS X kernel behavior. *) 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\014\176"; (* length *) output_string outch "\000\000\000\002"; (* Ressource fork *) output_string outch "\000\000\014\226"; (* offset *) output_string outch "\000\000\001\030"; (* length *) output_string outch (insertInfo (emptyFinderInfo ()) finfo); output_string outch (empty_attribute_chunk ()); (* extended attributes *) output_string outch empty_ressource_fork; 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)) -> debug (fun () -> Util.msg "ressource fork fingerprint: path %s, offset %d, len %d" path (Int64.to_int offset) (Uutil.Filesize.toInt len)); 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\014\176"; (* length *) output_string outch "\000\000\000\002"; (* Resource fork *) output_string outch "\000\000\014\226"; (* offset *) output_string outch (setInt4 (Uutil.Filesize.toInt64 length)); (* length *) output_string outch (emptyFinderInfo ()); output_string outch (empty_attribute_chunk ()); (* extended attributes *) flush outch) (fun () -> close_out_noerr outch); outch) unison-2.32.52/osx.mli0000644000076500000000000000165311176730177014165 0ustar bcpiercewheel(* 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 unison-2.32.52/osxsupport.c0000644000076500000000000000722411176730177015263 0ustar bcpiercewheel/* Unison file synchronizer: src/osxsupport.c */ /* Copyright 1999-2008 (see COPYING for details) */ #include #include #include #ifdef __APPLE__ #include #include #include #include #include #include #include #endif #include extern void unix_error (int errcode, char * cmdname, value arg) Noreturn; extern void uerror (char * cmdname, value arg) Noreturn; CAMLprim value isMacOSX (value nothing) { #ifdef __APPLE__ return Val_true; #else return Val_false; #endif } CAMLprim value getFileInfos (value path, value need_size) { #ifdef __APPLE__ CAMLparam1(path); CAMLlocal3(res, fInfo, length); int retcode; struct attrlist attrList; unsigned long options = 0; struct { unsigned long length; char finderInfo [32]; off_t rsrcLength; } attrBuf; attrList.bitmapcount = ATTR_BIT_MAP_COUNT; attrList.reserved = 0; attrList.commonattr = ATTR_CMN_FNDRINFO; attrList.volattr = 0; /* volume attribute group */ attrList.dirattr = 0; /* directory attribute group */ if (Bool_val (need_size)) attrList.fileattr = ATTR_FILE_RSRCLENGTH; /* file attribute group */ else attrList.fileattr = 0; attrList.forkattr = 0; /* fork attribute group */ retcode = getattrlist(String_val (path), &attrList, &attrBuf, sizeof attrBuf, options); if (retcode == -1) uerror("getattrlist", path); if (Bool_val (need_size)) { if (attrBuf.length != sizeof attrBuf) unix_error (EOPNOTSUPP, "getattrlist", path); } else { if (attrBuf.length < sizeof (unsigned long) + 32) unix_error (EOPNOTSUPP, "getattrlist", path); } fInfo = alloc_string (32); memcpy (String_val (fInfo), attrBuf.finderInfo, 32); if (Bool_val (need_size)) length = copy_int64 (attrBuf.rsrcLength); else length = copy_int64 (0); res = alloc_small (2, 0); Field (res, 0) = fInfo; Field (res, 1) = length; CAMLreturn (res); #else unix_error (ENOSYS, "getattrlist", path); #endif } CAMLprim value setFileInfos (value path, value fInfo) { #ifdef __APPLE__ CAMLparam2(path, fInfo); int retcode; struct attrlist attrList; unsigned long options = 0; struct { unsigned long length; char finderInfo [32]; } attrBuf; attrList.bitmapcount = ATTR_BIT_MAP_COUNT; attrList.reserved = 0; attrList.commonattr = ATTR_CMN_FNDRINFO; attrList.volattr = 0; /* volume attribute group */ attrList.dirattr = 0; /* directory attribute group */ attrList.fileattr = 0; /* file attribute group */ attrList.forkattr = 0; /* fork attribute group */ memcpy (attrBuf.finderInfo, String_val (fInfo), 32); retcode = setattrlist(String_val (path), &attrList, attrBuf.finderInfo, sizeof attrBuf.finderInfo, options); if (retcode == -1 && errno == EACCES) { /* Unlike with normal Unix attributes, we cannot set OS X attributes if file is read-only. Try making it writable temporarily. */ struct stat st; int r = stat(String_val(path), &st); if (r == -1) uerror("setattrlist", path); r = chmod(String_val(path), st.st_mode | S_IWUSR); if (r == -1) uerror("setattrlist", path); /* Try again */ retcode = setattrlist(String_val (path), &attrList, attrBuf.finderInfo, sizeof attrBuf.finderInfo, options); /* Whether or not that worked, we should try to set the mode back. */ chmod(String_val(path), st.st_mode); } if (retcode == -1) uerror("setattrlist", path); CAMLreturn (Val_unit); #else unix_error (ENOSYS, "setattrlist", path); #endif } unison-2.32.52/path.ml0000644000076500000000000001514111176730177014134 0ustar bcpiercewheel(* Unison file synchronizer: src/path.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) (* Defines an abstract type of relative pathnames *) type 'a path = string type t = string type local = string let pathSeparatorChar = '/' let pathSeparatorString = "/" let concat p p' = let l = String.length p in if l = 0 then p' else let l' = String.length p' in if l' = 0 then p else let p'' = String.create (l + l' + 1) in String.blit p 0 p'' 0 l; p''.[l] <- pathSeparatorChar; String.blit p' 0 p'' (l + 1) l'; p'' let empty = "" let isEmpty p = String.length p = 0 let length p = let l = ref 0 in for i = 0 to String.length p - 1 do if p.[i] = pathSeparatorChar then incr l done; !l (* Add a name to the end of a path *) let rcons n path = concat (Name.toString n) path let toStringList p = Str.split (Str.regexp pathSeparatorString) p (* Give a left-to-right list of names in the path *) let toNames p = Safelist.map Name.fromString (toStringList p) let child path name = concat path (Name.toString name) let parent path = try let i = String.rindex path pathSeparatorChar in String.sub path 0 i with Not_found -> empty let finalName path = try let i = String.rindex path pathSeparatorChar + 1 in Some (Name.fromString (String.sub path i (String.length path - i))) with Not_found -> if isEmpty path then None else Some (Name.fromString path) (* pathDeconstruct : path -> (name * path) option *) let deconstruct path = try let i = String.index path pathSeparatorChar in Some (Name.fromString (String.sub path 0 i), String.sub path (i + 1) (String.length path - i - 1)) with Not_found -> if isEmpty path then None else Some (Name.fromString path, empty) let deconstructRev path = try let i = String.rindex path pathSeparatorChar in Some (Name.fromString (String.sub path (i + 1) (String.length path - i - 1)), String.sub path 0 i) with Not_found -> if path = "" then None else Some (Name.fromString path, empty) let winAbspathRx = Rx.rx "([a-zA-Z]:)?(/|\\\\).*" let unixAbspathRx = Rx.rx "/.*" let is_absolute s = if Util.osType=`Win32 then Rx.match_string winAbspathRx s else Rx.match_string unixAbspathRx s (* Function string2path: string -> path THIS IS THE CRITICAL FUNCTION. Problem: What to do on argument "" ? What we do: we raise Invalid_argument. Problem: double slash within the argument, e.g., "foo//bar". What we do: we raise Invalid_argument. Problem: What if string2path is applied to an absolute path? We want to disallow this, but, relative is relative. E.g., on Unix it makes sense to have a directory with subdirectory "c:". Then, it makes sense to synchronize on the path "c:". But this will go badly if the Unix system synchronizes with a Windows system. What we do: we check whether a path is relative using local conventions, and raise Invalid_argument if not. If we synchronize with a system with other conventions, then problems must be caught elsewhere. E.g., the system should refuse to create a directory "c:" on a Windows machine. Problem: spaces in the argument, e.g., " ". Still not sure what to do here. Is it possible to create a file with this name in Unix or Windows? Problem: trailing slashes, e.g., "foo/bar/". Shells with command-line completion may produce these routinely. What we do: we remove them. Moreover, we remove as many as necessary, e.g., "foo/bar///" becomes "foo/bar". This may be counter to conventions of some shells/os's, where "foo/bar///" might mean "/". Examples: loop "hello/there" -> ["hello"; "there"] loop "/hello/there" -> [""; "hello"; "there"] loop "" -> [""] loop "/" -> [""; ""] loop "//" -> [""; ""; ""] loop "c:/" ->["c:"; ""] loop "c:/foo" -> ["c:"; "foo"] *) let fromString str = let str = if Util.osType = `Win32 then Fileutil.backslashes2forwardslashes str else str in if is_absolute str then raise (Util.Transient (Printf.sprintf "The path '%s' is not a relative path" str)); let str = Fileutil.removeTrailingSlashes str in if str = "" then empty else let rec loop p str = try let pos = String.index str pathSeparatorChar in let name1 = String.sub str 0 pos in let str_res = String.sub str (pos + 1) (String.length str - pos - 1) in if pos = 0 then begin loop p str_res end else loop (child p (Name.fromString name1)) str_res with Not_found -> child p (Name.fromString str) | Invalid_argument _ -> raise(Invalid_argument "Path.fromString") in loop empty str let toString path = path let compare p1 p2 = if Case.insensitive () then Util.nocase_cmp p1 p2 else compare p1 p2 let toDebugString path = String.concat " / " (toStringList path) let addSuffixToFinalName path suffix = path ^ suffix let addPrefixToFinalName path prefix = try let i = String.rindex path pathSeparatorChar + 1 in let l = String.length path in let l' = String.length prefix in let p = String.create (l + l') in String.blit path 0 p 0 i; String.blit prefix 0 p i l'; String.blit path i p (i + l') (l - i); p with Not_found -> assert (not (isEmpty path)); prefix ^ path let hash p = Hashtbl.hash p (* Pref controlling whether symlinks are followed. *) let follow = Pred.create "follow" ("Including the preference \\texttt{-follow \\ARG{pathspec}} causes Unison to \ treat symbolic links matching \\ARG{pathspec} as `invisible' and \ behave as if the object pointed to by the link had appeared literally \ at this position in the replica. See \ \\sectionref{symlinks}{Symbolic Links} for more details. \ The syntax of \\ARG{pathspec>} is \ described in \\sectionref{pathspec}{Path Specification}.") let followLink path = (Util.osType = `Unix || Util.isCygwin) && Pred.test follow (toString path) let magic p = p let magic' p = p unison-2.32.52/path.mli0000644000076500000000000000203111176730177014277 0ustar bcpiercewheel(* 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 unison-2.32.52/pixmaps.ml0000644000076500000000000010666211176730177014672 0ustar bcpiercewheel(* Unison file synchronizer: src/pixmaps.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) let copyAB color = [| (* width height num_colors chars_per_pixel *) " 28 14 2 1"; (* colors *) ". c None"; "# c #" ^ color; (* pixels *) "............................"; "............................"; "............................"; "......................#....."; ".....................###...."; "......................####.."; "..##########################"; "..##########################"; "......................####.."; ".....................###...."; "......................#....."; "............................"; "............................"; "............................" |] let copyBA color = [| (* width height num_colors chars_per_pixel *) " 28 14 2 1"; (* colors *) ". c None"; "# c #" ^ color; (* pixels *) "............................"; "............................"; "............................"; ".....#......................"; "....###....................."; "..####......................"; "##########################.."; "##########################.."; "..####......................"; "....###....................."; ".....#......................"; "............................"; "............................"; "............................" |] let mergeLogo color = [| (* width height num_colors chars_per_pixel *) " 28 14 2 1"; (* colors *) ". c None"; "# c #" ^ color; (* pixels *) "............................"; "............................"; ".........##......##........."; ".........###....###........."; ".........####..####........."; ".........##.####.##........."; ".........##..##..##........."; ".........##......##........."; ".........##......##........."; ".........##......##........."; ".........##......##........."; ".........##......##........."; "............................"; "............................" |] let ignore color = [| (* width height num_colors chars_per_pixel *) " 20 14 2 1"; (* colors *) " c None"; "* c #" ^ color; (* pixels *) " "; " ***** "; " ** ** "; " ** ** "; " ** "; " ** "; " ** "; " ** "; " ** "; " "; " "; " ** "; " ** "; " " |] let success = [| (* width height num_colors chars_per_pixel *) " 20 14 2 1"; (* colors *) " c None"; "* c #00dd00"; (* pixels *) " "; " "; " *** "; " ****** "; " ***** * "; " **** "; " *** *** "; " *** ** "; " ****** "; " *** "; " ** "; " ** "; " * "; " " |] let failure = [| (* width height num_colors chars_per_pixel *) " 20 14 2 1"; (* colors *) " c None"; "* c #ff0000"; (* pixels *) " * * "; " *** ** "; " *** *** "; " ** ** "; " ** ** "; " ***** "; " **** "; " *** "; " ***** "; " ** ** "; " ** ** "; " ** *** "; " *** ** "; " *** " |] (***********************************************************************) (* Some alternative arrow shapes (not currently used)... *) (***********************************************************************) let copyAB_asym = [| (* width height num_colors chars_per_pixel *) " 28 14 2 1"; (* colors *) ". c None"; "# c #3cf834"; (* pixels *) "............................"; "............................"; "............................"; ".......................#...."; "......................###..."; ".......................####."; "..##########################"; "..##########################"; ".........................##."; ".......................####."; "......................###..."; "............................"; "............................"; "............................" |] let copyABblack_asym = [| (* width height num_colors chars_per_pixel *) " 28 14 2 1"; (* colors *) ". c None"; "# c #000000"; (* pixels *) "............................"; "............................"; "............................"; ".......................#...."; "......................###..."; ".......................####."; "..##########################"; "..##########################"; ".........................##."; ".......................####."; "......................###..."; "............................"; "............................"; "............................" |] let copyBA_asym = [| (* width height num_colors chars_per_pixel *) " 28 14 2 1"; (* colors *) ". c None"; "# c #3cf834"; (* pixels *) "............................"; "............................"; "............................"; ".....#......................"; "....###....................."; "..####......................"; "##########################.."; "##########################.."; "..##........................"; "..####......................"; "....###....................."; "............................"; "............................"; "............................" |] let copyBAblack_asym = [| (* width height num_colors chars_per_pixel *) " 28 14 2 1"; (* colors *) ". c None"; "# c #000000"; (* pixels *) "............................"; "............................"; "............................"; ".....#......................"; "....###....................."; "..####......................"; "##########################.."; "##########################.."; "..##........................"; "..####......................"; "....###....................."; "............................"; "............................"; "............................" |] (***********************************************************************) (* Unison icon *) (***********************************************************************) let icon_data = "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\001\019\020\006\134\ \000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\ \019\020\006\134\000\000\000\001\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\00022\016\152\1594\ 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\ \159412\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\015w9R\ :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|;\ R8//\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\1470RR\ 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\1511R\ RR\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%RRR\ RRsu&\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'RR\ RRRop$\ \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\ RRRR\ RRRYZ\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 \ \\]\030RRR\ RRRQ\ 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\023P\ RRRR\ RRRP\ 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\ PRRR\ RRRR\ NEF\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;<\019LR\ RRRR\ RRRR\ 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<=\019L\ QQQP\ PPPP\ PI99\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\017GRR\ RRRR\ RRRR\ RG45\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\017FP\ POOO\ OOON\ NNB42\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\ RRQQ\ QQQ<\ ~~(}}(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'\ ?NMM\ MMMM\ 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}}(\ PPOO\ OOOdb \ \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}(LKK\ KKKK\ ^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'\ NNMM\ MMMdb\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{'JII\ IIII\ _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'\ MMLL\ LLLd_\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&IHH\ HHHH\ _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&\ KKJJ\ JJJd]\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%GFF\ FFFF\ _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%\ IIHH\ HHHd\\\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$EDD\ DDDD\ _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$\ GGFF\ FFFdZ\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#CBB\ BBBB\ ^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#\ FFEE\ EEEdX\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#BAA\ AAAA\ ^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\"\ DDCC\ CCCcV\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!\ BBAA\ AAAcU\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\ 9999\ ^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\ ==<<\ <<\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\ 2211\ 111bD\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\ 00//\ ///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} | { \ {\031z\031y\031x\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\023s\028s\028r\028\ q\027p\027o\027n\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\021j\024j\024i\024\ h\023g\023f\023e\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\030v\030u\029t\029\ s\029r\028q\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\026m\026l\025k\025\ j\025i\024h\024a\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\017W\017W\017V\017\ U\016T\016S\016P\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\ ]\021c\022b\021a\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\014N\013M\013L\013\ L\012K\012J\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\015Z\019Y\018X\018\ W\018V\017U\017U\017\ N\0159\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\011D\nD\nC\n\ B\tA\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\ _!\006Q\015P\014O\014\ N\014M\013L\013L\013\ K\012F\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\0025\006=\007\ <\007;\006;\006:\006\ 9\0058\0057\005O\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\002D\nF\011E\n\ E\nD\tC\tB\t\ A\008@\008?\0080\005\ 5\014\0026\014\002.\012\001\157(\n\001w\ \030\007\001^-\011\001\142.\011\001N\019\002\ \139!\0025\0045\0044\003\ 3\0032\0021\0020\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:\0069\0059\005\ 8\0057\0046\0045\004\ 4\0033\0032\003+\002\ '\002-\002/\001.\001\ -\001,\000+\000+\000\ +\000+\000+\000+\000\ +\000+\000T\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#\0023\003\ 2\0031\0020\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\0006\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+\000x\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\000k\020\000(\000\ +\000+\000+\000+\000\ +\000+\000+\000+\000\ +\000+\000+\000+\000\ +\000+\000+\000+\000\ )\000w\022\0007\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!\000o\021\000O\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\000B\012\000\ H\014\000@\012\0009\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" unison-2.32.52/pred.ml0000644000076500000000000001275611176730177014143 0ustar bcpiercewheel(* Unison file synchronizer: src/pred.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) let debug = Util.debug "pred" (********************************************************************) (* TYPES *) (********************************************************************) type t = { pref: string list Prefs.t; name: string; (* XXX better to get it from Prefs! *) mutable default: string list; mutable last_pref : string list; mutable last_def : string list; mutable last_mode : bool; mutable compiled: Rx.t; mutable associated_strings : (Rx.t * string) list; } let error_msg s = Printf.sprintf "bad pattern: %s\n\ A pattern must be introduced by one of the following keywords:\n\ \032 Name, Path, or Regex." s (* [select str [(p1, f1), ..., (pN, fN)] fO]: (roughly) *) (* match str with *) (* p1 p' -> f1 p' *) (* ... *) (* pN p' -> fN p' *) (* otherwise -> fO str *) let rec select str l f = match l with [] -> f str | (pref, g)::r -> if Util.startswith str pref then let l = String.length pref in g (Util.trimWhitespace (String.sub str l (String.length str - l))) else select str r f let mapSeparator = "->" (* Compile a pattern (in string form) to a regular expression *) let compile_pattern clause = let (p,v) = match Util.splitIntoWordsByString clause mapSeparator with [p] -> (p,None) | [p;v] -> (p, Some (Util.trimWhitespace v)) | [] -> raise (Prefs.IllegalValue "Empty pattern") | _ -> raise (Prefs.IllegalValue ("Malformed pattern: " ^ "\"" ^ clause ^ "\"\n" ^ "Only one instance of " ^ mapSeparator ^ " allowed.")) in let compiled = begin try select p [("Name ", fun str -> Rx.seq [Rx.rx "(.*/)?"; Rx.globx str]); ("Path ", fun str -> if str<>"" && str.[0] = '/' then raise (Prefs.IllegalValue ("Malformed pattern: " ^ "\"" ^ p ^ "\"\n" ^ "'Path' patterns may not begin with a slash; " ^ "only relative paths are allowed.")); Rx.globx str); ("Regex ", Rx.rx)] (fun str -> raise (Prefs.IllegalValue (error_msg p))) with Rx.Parse_error | Rx.Not_supported -> raise (Prefs.IllegalValue ("Malformed pattern \"" ^ p ^ "\".")) end in (compiled, v) let create name ?(advanced=false) fulldoc = let pref = Prefs.create name [] ((if advanced then "!" else "") ^ "add a pattern to the " ^ name ^ " list") fulldoc (fun oldList string -> ignore (compile_pattern string); (* Check well-formedness *) string :: oldList) (fun l -> l) in {pref = pref; name = name; last_pref = []; default = []; last_def = []; last_mode = false; compiled = Rx.empty; associated_strings = []} let addDefaultPatterns p pats = p.default <- Safelist.append pats p.default let alias p n = Prefs.alias p.pref n let recompile mode p = let pref = Prefs.read p.pref in let compiledList = Safelist.map compile_pattern (Safelist.append p.default pref) in let compiled = Rx.alt (Safelist.map fst compiledList) in let strings = Safelist.filterMap (fun (rx,vo) -> match vo with None -> None | Some v -> Some (rx,v)) compiledList in p.compiled <- if mode then Rx.case_insensitive compiled else compiled; p.associated_strings <- strings; p.last_pref <- pref; p.last_def <- p.default; p.last_mode <- mode let recompile_if_needed p = let mode = Case.insensitive () in if p.last_mode <> mode || p.last_pref != Prefs.read p.pref || p.last_def != p.default then recompile mode p (********************************************************************) (* IMPORT / EXPORT *) (********************************************************************) let intern p regexpStringList = Prefs.set p.pref regexpStringList let extern p = Prefs.read p.pref let extern_associated_strings p = recompile_if_needed p; Safelist.map snd p.associated_strings (********************************************************************) (* TESTING *) (********************************************************************) let test p s = recompile_if_needed p; let res = Rx.match_string p.compiled (Case.normalize s) in debug (fun() -> Util.msg "%s '%s' = %b\n" p.name s res); res let assoc p s = recompile_if_needed p; snd (Safelist.find (fun (rx,v) -> Rx.match_string rx s) p.associated_strings) unison-2.32.52/pred.mli0000644000076500000000000000474311176730177014311 0ustar bcpiercewheel(* Unison file synchronizer: src/pred.mli *) (* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) (* Predicates over paths. General description: A predicate is determined by a list of default patterns and a list of current patterns. These patterns can be modified by [addDefaultPatterns] and [intern]. Function [test p s] tests whether string [s] satisfies predicate [p], i.e., it matches a pattern of [p]. For efficiency, the list of patterns are compiled into a regular expression. Function [test] compares the current value of default patterns and current patterns against the save ones (recorded in last_pref/last_def) to determine whether recompilation is necessary. Each pattern has the form [ -> ] The associated string is ignored by [test] but can be looked up by [assoc]. Three forms of / are recognized: "Name ": ..../ (using globx) "Path ": , not starting with "/" (using globx) "Regex ": (using rx) *) type t (* Create a new predicate and register it with the preference module. The first arg is the name of the predicate; the second is full (latex) documentation. *) val create : string -> ?advanced:bool -> string -> t (* Check whether a given path matches one of the default or current patterns *) val test : t -> string -> bool (* Return the associated string for the first matching pattern. Raise Not_found if no pattern with an associated string matches. *) val assoc : t -> string -> string (* Add list of default patterns to the existing list. (These patterns are remembered even when the associated preference is cleared). *) val addDefaultPatterns : t -> string list -> unit (* Install a new list of patterns, overriding the current list *) val intern : t -> string list -> unit (* Return the current list of patterns *) val extern : t -> string list (* Return the current list of associated strings *) val extern_associated_strings : t -> string list (* Create an alternate name for a predicate (the new name will not appear in usage messages or generated documentation) *) val alias : t (* existing predicate *) -> string (* new name *) -> unit unison-2.32.52/props.ml0000644000076500000000000005725311176730177014355 0ustar bcpiercewheel(* Unison file synchronizer: src/props.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) let debug = Util.debug "props" module type S = sig type t val dummy : t val hash : t -> int -> int val similar : t -> t -> bool val override : t -> t -> t val strip : t -> t val diff : t -> t -> t val toString : t -> string val syncedPartsToString : t -> string val set : Fspath.t -> Path.local -> [`Set | `Update] -> t -> unit val get : Unix.LargeFile.stats -> Osx.info -> t val init : bool -> unit end (* Nb: the syncedPartsToString call is only used for archive dumping, for *) (* debugging purposes. It could be deleted without losing functionality. *) (**** Permissions ****) module Perm : sig include S val fileDefault : t val fileSafe : t val dirDefault : t val extract : t -> int val check : Fspath.t -> Path.local -> Unix.LargeFile.stats -> t -> unit end = struct (* We introduce a type, Perm.t, that holds a file's permissions along with *) (* the operating system where the file resides. Different operating systems *) (* have different permission systems, so we have to take the OS into account *) (* when comparing and setting permissions. We also need an "impossible" *) (* permission that to take care of a tricky special case in update *) (* detection. It can be that the archive contains a directory that has *) (* never been synchronized, although some of its children have been. In *) (* this case, the directory's permissions have never been synchronized and *) (* might be different on the two replicas. We use NullPerm for the *) (* permissions of such an archive entry, and ensure (in similarPerms) that *) (* NullPerm is never similar to any real permission. *) (* NOTE: IF YOU CHANGE TYPE "PERM", THE ARCHIVE FORMAT CHANGES; INCREMENT *) (* "UPDATE.ARCHIVEFORMAT" *) type t = int * int (* This allows us to export NullPerm while keeping the type perm abstract *) let dummy = (0, 0) let extract = fst let unix_mask = 0o7777 (* All bits *) let wind_mask = 0o200 (* -w------- : only the write bit can be changed in Windows *) let permMask = Prefs.createInt "perms" (0o777 (* rwxrwxrwx *) + 0o1000 (* Sticky bit *)) "part of the permissions which is synchronized" "The integer value of this preference is a mask indicating which \ permission bits should be synchronized. It is set by default to \ $0o1777$: all bits but the set-uid and set-gid bits are \ synchronised (synchronizing theses latter bits can be a security \ hazard). If you want to synchronize all bits, you can set the \ value of this preference to $-1$." (* Os-specific local conventions on file permissions *) let (fileDefault, dirDefault, fileSafe, dirSafe) = match Util.osType with `Win32 -> debug (fun() -> Util.msg "Using windows defaults for file permissions"); ((0o600, -1), (* rw------- *) (0o700, -1), (* rwx------ *) (0o600, -1), (* rw------- *) (0o700, -1)) (* rwx------ *) | `Unix -> let umask = let u = Unix.umask 0 in ignore (Unix.umask u); debug (fun() -> Util.msg "Umask: %s" (Printf.sprintf "%o" u)); (fun fp -> (lnot u) land fp) in ((umask 0o666, -1), (* rw-rw-rw- *) (umask 0o777, -1), (* rwxrwxrwx *) (umask 0o600, -1), (* rw------- *) (umask 0o700, -1)) (* rwx------ *) let hash (p, m) h = Uutil.hash2 (p land m) (Uutil.hash2 m h) let perm2fileperm (p, m) = p let fileperm2perm p = (p, Prefs.read permMask) (* Are two perms similar (for update detection and recon) *) let similar (p1, m1) (p2, m2) = let m = Prefs.read permMask in m1 land m = m && m2 land m = m && p1 land m = p2 land m (* overrideCommonPermsIn p1 p2 : gives the perm that would result from *) (* propagating p2 to p1. We expect the following invariants: similarPerms *) (* (overrideCommonPermsIn p1 p2) p2 (whenever similarPerms p2 p2) and *) (* hashPerm (overrideCommonPermsIn p1 p2) = hashPerm p2 *) let override (p1, m1) (p2, m2) = let m = Prefs.read permMask land m2 in ((p1 land (lnot m)) lor (p2 land m), m) let strip (p, m) = (p, m land (Prefs.read permMask)) let diff (p, m) (p', m') = (p', (p lxor p') land m land m') let toString = function (_, 0) -> "unknown permissions" | (fp, _) when Prefs.read permMask = wind_mask -> if fp land wind_mask <> 0 then "read-write" else "read-only" | (fp, _) -> let m = Prefs.read permMask in let bit mb unknown off on = if mb land m = 0 then unknown else if fp land mb <> 0 then on else off in bit 0o1000 "" "" "t" ^ bit 0o0400 "?" "-" "r" ^ bit 0o0200 "?" "-" "w" ^ bit 0o0100 "?" "-" "x" ^ bit 0o0040 "?" "-" "r" ^ bit 0o0020 "?" "-" "w" ^ bit 0o0010 "?" "-" "x" ^ bit 0o0004 "?" "-" "r" ^ bit 0o0002 "?" "-" "w" ^ bit 0o0001 "?" "-" "x" let syncedPartsToString = function (_, 0) -> "unknown permissions" | (fp, m) -> let bit mb unknown off on = if mb land m = 0 then unknown else if fp land mb <> 0 then on else off in bit 0o1000 "" "" "t" ^ bit 0o0400 "?" "-" "r" ^ bit 0o0200 "?" "-" "w" ^ bit 0o0100 "?" "-" "x" ^ bit 0o0040 "?" "-" "r" ^ bit 0o0020 "?" "-" "w" ^ bit 0o0010 "?" "-" "x" ^ bit 0o0004 "?" "-" "r" ^ bit 0o0002 "?" "-" "w" ^ bit 0o0001 "?" "-" "x" let dontChmod = Prefs.createBool "dontchmod" false "!When set, never use the chmod system call" ("By default, Unison uses the 'chmod' system call to set the permission bits" ^ " of files after it has copied them. But in some circumstances (and under " ^ " some operating systems), the chmod call always fails. Setting this " ^ " preference completely prevents Unison from ever calling chmod.") let set fspath path kind (fp, mask) = (* BCP: removed "|| kind <> `Update" on 10/2005, but reinserted it on 11/2008. I'd removed it to make Dale Worley happy -- he wanted a way to make sure that Unison would never call chmod, and setting prefs to 0 seemed like a reasonable way to do this. But in fact it caused new files to be created with wrong prefs. *) if (mask <> 0 || kind = `Set) && (not (Prefs.read dontChmod)) then Util.convertUnixErrorsToTransient "setting permissions" (fun () -> let abspath = Fspath.concatToString fspath path in debug (fun() -> Util.msg "Setting permissions for %s to %s (%s)\n" abspath (toString (fileperm2perm fp)) (Printf.sprintf "%o/%o" fp mask)); Unix.chmod abspath fp) let get stats _ = (stats.Unix.LargeFile.st_perm, Prefs.read permMask) let check fspath path stats (fp, mask) = let fp' = stats.Unix.LargeFile.st_perm in if fp land mask <> fp' land mask then raise (Util.Transient (Format.sprintf "Failed to set permissions of file %s to %s: \ the permissions was set to %s instead. \ The filesystem probably does not support all permission bits. \ You should probably set the \"perms\" option to 0o%o \ (or to 0 if you don't need to synchronize permissions)." (Fspath.concatToString fspath path) (syncedPartsToString (fp, mask)) (syncedPartsToString (fp', mask)) (mask land (lnot (fp lxor fp'))))) let init someHostIsRunningWindows = let mask = if someHostIsRunningWindows then wind_mask else unix_mask in let oldMask = Prefs.read permMask in let newMask = oldMask land mask in debug (fun() -> Util.msg "Setting permission mask to %s (%s and %s)\n" (Printf.sprintf "%o" newMask) (Printf.sprintf "%o" oldMask) (Printf.sprintf "%o" mask)); Prefs.set permMask newMask end (* ------------------------------------------------------------------------- *) (* User and group ids *) (* ------------------------------------------------------------------------- *) let numericIds = Prefs.createBool "numericids" false "!don't map uid/gid values by user/group names" "When this flag is set to \\verb|true|, groups and users are \ synchronized numerically, rather than by name. \n\ \n\ The special uid 0 and the special group 0 are never mapped via \ user/group names even if this preference is not set." (* For backward compatibility *) let _ = Prefs.alias numericIds "numericIds" module Id (M : sig val sync : bool Prefs.t val kind : string val to_num : string -> int val toString : int -> string val syncedPartsToString : int -> string val set : string -> int -> unit val get : Unix.LargeFile.stats -> int end) : S = struct type t = IdIgnored | IdNamed of string | IdNumeric of int let dummy = IdIgnored let hash id h = Uutil.hash2 (match id with IdIgnored -> -1 | IdNumeric i -> i | IdNamed nm -> Hashtbl.hash nm) h let similar id id' = not (Prefs.read M.sync) || (id <> IdIgnored && id' <> IdIgnored && id = id') let override id id' = id' let strip id = if Prefs.read M.sync then id else IdIgnored let diff id id' = if similar id id' then IdIgnored else id' let toString id = match id with IdIgnored -> "" | IdNumeric i -> " " ^ M.kind ^ "=" ^ string_of_int i | IdNamed n -> " " ^ M.kind ^ "=" ^ n let syncedPartsToString = toString let tbl = Hashtbl.create 17 let extern id = match id with IdIgnored -> -1 | IdNumeric i -> i | IdNamed nm -> try Hashtbl.find tbl nm with Not_found -> let id = try M.to_num nm with Not_found -> raise (Util.Transient ("No " ^ M.kind ^ " " ^ nm)) in if id = 0 then raise (Util.Transient (Printf.sprintf "Trying to map the non-root %s %s to %s 0" M.kind nm M.kind)); Hashtbl.add tbl nm id; id let set fspath path kind id = match extern id with -1 -> () | id -> Util.convertUnixErrorsToTransient "setting file ownership" (fun () -> let abspath = Fspath.concatToString fspath path in M.set abspath id) let tbl = Hashtbl.create 17 let get stats _ = if not (Prefs.read M.sync) then IdIgnored else let id = M.get stats in if id = 0 || Prefs.read numericIds then IdNumeric id else try Hashtbl.find tbl id with Not_found -> let id' = try IdNamed (M.toString id) with Not_found -> IdNumeric id in Hashtbl.add tbl id id'; id' let init someHostIsRunningWindows = if someHostIsRunningWindows then Prefs.set M.sync false; end module Uid = Id (struct let sync = Prefs.createBool "owner" false "synchronize owner" ("When this flag is set to \\verb|true|, the owner attributes " ^ "of the files are synchronized. " ^ "Whether the owner names or the owner identifiers are synchronized" ^ "depends on the preference \texttt{numerids}.") let kind = "user" let to_num nm = (Unix.getpwnam nm).Unix.pw_uid let toString id = (Unix.getpwuid id).Unix.pw_name let syncedPartsToString = toString let set path id = Unix.chown path id (-1) let get stats = stats.Unix.LargeFile.st_uid end) module Gid = Id (struct let sync = Prefs.createBool "group" false "synchronize group attributes" ("When this flag is set to \\verb|true|, the group attributes " ^ "of the files are synchronized. " ^ "Whether the group names or the group identifiers are synchronized" ^ "depends on the preference \\texttt{numerids}.") let kind = "group" let to_num nm = (Unix.getgrnam nm).Unix.gr_gid let toString id = (Unix.getgrgid id).Unix.gr_name let syncedPartsToString = toString let set path id = Unix.chown path (-1) id let get stats = stats.Unix.LargeFile.st_gid end) (* ------------------------------------------------------------------------- *) (* Modification time *) (* ------------------------------------------------------------------------- *) module Time : sig include S val same : t -> t -> bool val extract : t -> float val sync : bool Prefs.t val replace : t -> float -> t val check : Fspath.t -> Path.local -> Unix.LargeFile.stats -> t -> unit end = struct let sync = Prefs.createBool "times" false "synchronize modification times" "When this flag is set to \\verb|true|, \ file modification times (but not directory modtimes) are propagated." type t = Synced of float | NotSynced of float let dummy = NotSynced 0. let extract t = match t with Synced v -> v | NotSynced v -> v let minus_two = Int64.of_int (-2) let approximate t = Int64.logand (Int64.of_float t) minus_two let oneHour = Int64.of_int 3600 let minusOneHour = Int64.neg oneHour let moduloOneHour t = let v = Int64.rem t oneHour in if v >= Int64.zero then v else Int64.add v oneHour let hash t h = Uutil.hash2 (match t with Synced f -> Hashtbl.hash (moduloOneHour (approximate f)) | NotSynced _ -> 0) h let similar t t' = not (Prefs.read sync) || match t, t' with Synced v, Synced v' -> let delta = Int64.sub (approximate v) (approximate v') in delta = Int64.zero || delta = oneHour || delta = minusOneHour | NotSynced _, NotSynced _ -> true | _ -> false (* Accept one hour differences and one second differences *) let possible_deltas = [ -3601L; 3601L; -3600L; 3600L; -3599L; 3599L; -1L; 1L; 0L ] (* FIX: this is the right similar function (dates are approximated on FAT filesystems upward under Windows, downward under Linux). The hash function needs to be updated as well *) let similar_correct t t' = not (Prefs.read sync) || match t, t' with Synced v, Synced v' -> List.mem (Int64.sub (Int64.of_float v) (Int64.of_float v')) possible_deltas | NotSynced _, NotSynced _ -> true | _ -> false let override t t' = match t, t' with _, Synced _ -> t' | Synced v, _ -> NotSynced v | _ -> t let replace t v = match t with Synced _ -> t | NotSynced _ -> NotSynced v let strip t = match t with Synced v when not (Prefs.read sync) -> NotSynced v | _ -> t let diff t t' = if similar t t' then NotSynced (extract t') else t' let toString t = Util.time2string (extract t) let syncedPartsToString t = match t with Synced _ -> toString t | NotSynced _ -> "" let iCanWrite p = try Unix.access p [Unix.W_OK]; true with Unix.Unix_error _ -> false (* FIX: Probably there should be a check here that prevents us from ever *) (* setting a file's modtime into the future. *) let set fspath path kind t = match t with Synced v -> Util.convertUnixErrorsToTransient "setting modification time" (fun () -> let abspath = Fspath.concatToString fspath path in if Util.osType = `Win32 && not (iCanWrite abspath) then begin (* Nb. This workaround was proposed by Dmitry Bely, to work around the fact that Unix.utimes fails on readonly files under windows. I'm [bcp] a little bit uncomfortable with it for two reasons: (1) if we crash in the middle, the permissions might be left in a bad state, and (2) I don't understand the Win32 permissions model enough to know whether it will always work -- e.g., what if the UID of the unison process is not the same as that of the file itself (under Unix, this case would fail, but we certainly don't want to make it WORLD-writable, even briefly!). *) let oldPerms = (Unix.LargeFile.lstat abspath).Unix.LargeFile.st_perm in Util.finalize (fun()-> Unix.chmod abspath 0o600; Unix.utimes abspath v v) (fun()-> Unix.chmod abspath oldPerms) end else if false then begin (* A special hack for Rasmus, who has a special situation that requires the utimes-setting program to run 'setuid root' (and we do not want all of Unison to run setuid, so we just spin off an external utility to do it). *) let time = Unix.localtime v in let tstr = Printf.sprintf "%4d%02d%02d%02d%02d.%02d" (time.Unix.tm_year + 1900) (time.Unix.tm_mon + 1) time.Unix.tm_mday time.Unix.tm_hour time.Unix.tm_min time.Unix.tm_sec in let cmd = "/usr/local/bin/sudo -u root /usr/bin/touch -m -a -t " ^ tstr ^ " '" ^ abspath ^ "'" in Util.msg "Running external program to set utimes:\n %s\n" cmd; let (r,_) = External.runExternalProgram cmd in if r<>(Unix.WEXITED 0) then raise (Util.Transient "External time-setting command failed") end else Unix.utimes abspath v v) | _ -> () let get stats _ = let v = stats.Unix.LargeFile.st_mtime in if stats.Unix.LargeFile.st_kind = Unix.S_REG && Prefs.read sync then Synced v else NotSynced v let check fspath path stats t = match t with NotSynced _ -> () | Synced v -> let t' = Synced (stats.Unix.LargeFile.st_mtime) in if not (similar_correct t t') then raise (Util.Transient (Format.sprintf "Failed to set modification time of file %s to %s: \ the time was set to %s instead" (Fspath.concatToString fspath path) (syncedPartsToString t) (syncedPartsToString t'))) (* When modification time are synchronized, we cannot update the archive when they are changed due to daylight saving time. Thus, we have to compare then using "similar". *) let same p p' = match p, p' with Synced _, Synced _ -> similar p p' | _ -> let delta = extract p -. extract p' in delta = 0. || delta = 3600. || delta = -3600. let init _ = () end (* ------------------------------------------------------------------------- *) (* Type and creator *) (* ------------------------------------------------------------------------- *) module TypeCreator : S = struct type t = string option let dummy = None let hash t h = Uutil.hash2 (Hashtbl.hash t) h let similar t t' = not (Prefs.read Osx.rsrc) || t = t' let override t t' = t' let strip t = t let diff t t' = if similar t t' then None else t' let zeroes = "\000\000\000\000\000\000\000\000" let toString t = match t with Some s when s.[0] = 'F' && String.sub (s ^ zeroes) 1 8 <> zeroes -> let s = s ^ zeroes in " " ^ String.escaped (String.sub s 1 4) ^ " " ^ String.escaped (String.sub s 5 4) | _ -> "" let syncedPartsToString = toString let set fspath path kind t = match t with None -> () | Some t -> Osx.setFileInfos fspath path t let get stats info = if Prefs.read Osx.rsrc && (stats.Unix.LargeFile.st_kind = Unix.S_REG || stats.Unix.LargeFile.st_kind = Unix.S_DIR) then Some info.Osx.finfo else None let init _ = () end (* ------------------------------------------------------------------------- *) (* Properties *) (* ------------------------------------------------------------------------- *) type t = { perm : Perm.t; uid : Uid.t; gid : Gid.t; time : Time.t; typeCreator : TypeCreator.t; length : Uutil.Filesize.t } let template perm = { perm = perm; uid = Uid.dummy; gid = Gid.dummy; time = Time.dummy; typeCreator = TypeCreator.dummy; length = Uutil.Filesize.dummy } let dummy = template Perm.dummy let hash p h = Perm.hash p.perm (Uid.hash p.uid (Gid.hash p.gid (Time.hash p.time (TypeCreator.hash p.typeCreator h)))) let similar p p' = Perm.similar p.perm p'.perm && Uid.similar p.uid p'.uid && Gid.similar p.gid p'.gid && Time.similar p.time p'.time && TypeCreator.similar p.typeCreator p'.typeCreator let override p p' = { perm = Perm.override p.perm p'.perm; uid = Uid.override p.uid p'.uid; gid = Gid.override p.gid p'.gid; time = Time.override p.time p'.time; typeCreator = TypeCreator.override p.typeCreator p'.typeCreator; length = p'.length } let strip p = { perm = Perm.strip p.perm; uid = Uid.strip p.uid; gid = Gid.strip p.gid; time = Time.strip p.time; typeCreator = TypeCreator.strip p.typeCreator; length = p.length } let toString p = Printf.sprintf "modified on %s size %-9.f %s%s%s%s" (Time.toString p.time) (Uutil.Filesize.toFloat p.length) (Perm.toString p.perm) (Uid.toString p.uid) (Gid.toString p.gid) (TypeCreator.toString p.typeCreator) let syncedPartsToString p = let tm = Time.syncedPartsToString p.time in Printf.sprintf "%s%s size %-9.f %s%s%s%s" (if tm = "" then "" else "modified at ") tm (Uutil.Filesize.toFloat p.length) (Perm.syncedPartsToString p.perm) (Uid.syncedPartsToString p.uid) (Gid.syncedPartsToString p.gid) (TypeCreator.syncedPartsToString p.typeCreator) let diff p p' = { perm = Perm.diff p.perm p'.perm; uid = Uid.diff p.uid p'.uid; gid = Gid.diff p.gid p'.gid; time = Time.diff p.time p'.time; typeCreator = TypeCreator.diff p.typeCreator p'.typeCreator; length = p'.length } let get stats infos = { perm = Perm.get stats infos; uid = Uid.get stats infos; gid = Gid.get stats infos; time = Time.get stats infos; typeCreator = TypeCreator.get stats infos; length = if stats.Unix.LargeFile.st_kind = Unix.S_REG then Uutil.Filesize.fromStats stats else Uutil.Filesize.zero } let set fspath path kind p = Uid.set fspath path kind p.uid; Gid.set fspath path kind p.gid; TypeCreator.set fspath path kind p.typeCreator; Time.set fspath path kind p.time; Perm.set fspath path kind p.perm (* Paranoid checks *) let check fspath path stats p = Time.check fspath path stats p.time; Perm.check fspath path stats p.perm let init someHostIsRunningWindows = Perm.init someHostIsRunningWindows; Uid.init someHostIsRunningWindows; Gid.init someHostIsRunningWindows; Time.init someHostIsRunningWindows; TypeCreator.init someHostIsRunningWindows let fileDefault = template Perm.fileDefault let fileSafe = template Perm.fileSafe let dirDefault = template Perm.dirDefault let same_time p p' = Time.same p.time p'.time let length p = p.length let setLength p l = {p with length=l} let time p = Time.extract p.time let setTime p t = {p with time = Time.replace p.time t} let perms p = Perm.extract p.perm let syncModtimes = Time.sync unison-2.32.52/props.mli0000644000076500000000000000154411176730177014516 0ustar bcpiercewheel(* 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 unison-2.32.52/pty.c0000644000076500000000000000261311176730177013626 0ustar bcpiercewheel/* Stub code for controlling terminals on Mac OS X. */ #include #include // alloc_tuple #include // Store_field #include // failwith #include // ENOSYS extern void unix_error (int errcode, char * cmdname, value arg) Noreturn; extern void uerror (char * cmdname, value arg) Noreturn; // openpty #if defined(__linux) #include #define HAS_OPENPTY 1 #endif #if defined(__APPLE__) || defined(__NetBSD__) #include #define HAS_OPENPTY 1 #endif #ifdef __FreeBSD__ #include #include #define HAS_OPENPTY 1 #endif #ifdef HAS_OPENPTY #include #include CAMLprim value setControllingTerminal(value fdVal) { int fd = Int_val(fdVal); if (ioctl(fd, TIOCSCTTY, (char *) 0) < 0) uerror("ioctl", (value) 0); return Val_unit; } /* c_openpty: unit -> (int * Unix.file_descr) */ CAMLprim value c_openpty() { int master,slave; value pair; if (openpty(&master,&slave,NULL,NULL,NULL) < 0) uerror("openpty", (value) 0); pair = alloc_tuple(2); Store_field(pair,0,Val_int(master)); Store_field(pair,1,Val_int(slave)); return pair; } #else // not HAS_OPENPTY CAMLprim value setControllingTerminal(value fdVal) { unix_error (ENOSYS, "setControllingTerminal", NULL); } CAMLprim value c_openpty() { unix_error (ENOSYS, "openpty", NULL); } #endif unison-2.32.52/README0000644000076500000000000000110211176730177013516 0ustar bcpiercewheel THE UNISON FILE SYNCHRONIZER http://www.cis.upenn.edu/~bcpierce/unison This directory is the source distribution for the unison file synchronizer. Installation instructions are in the file INSTALL. Full documentation can be found on the Unison home page. Contacts: - Bug reports should be sent to unison-help@cis.upenn.edu - General questions and discussion should be sent to unison-users@groups.yahoo.com - You can subscribe to this list using Yahoo's web interface http://groups.yahoo.com/group/unison-users unison-2.32.52/recon.ml0000644000076500000000000005435711176730177014322 0ustar bcpiercewheel(* Unison file synchronizer: src/recon.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) open Common (* ------------------------------------------------------------------------- *) (* Handling of prefer/force *) (* ------------------------------------------------------------------------- *) let debug = Trace.debug "recon" let setDirection ri dir force = match ri.replicas with Different(rc1,rc2,d,default) when force=`Force || default=Conflict -> if dir=`Replica1ToReplica2 then d := Replica1ToReplica2 else if dir=`Replica2ToReplica1 then d := Replica2ToReplica1 else if dir=`Merge then if Globals.shouldMerge ri.path then d := Merge else () else (* dir = `Older or dir = `Newer *) let (_,s1,p1,_) = rc1 in let (_,s2,p2,_) = rc2 in if s1<>`Deleted && s2<>`Deleted then begin let comp = (Props.time p1) -. (Props.time p2) in let comp = if dir=`Newer then -. comp else comp in if comp = 0.0 then () else if comp<0.0 then d := Replica1ToReplica2 else d := Replica2ToReplica1 end else if s1=`Deleted && dir=`Newer then begin d := Replica2ToReplica1 end else if s2=`Deleted && dir=`Newer then begin d := Replica1ToReplica2 end | _ -> () let revertToDefaultDirection ri = match ri.replicas with Different(_,_,d,default) -> d := default | _ -> () (* Find out which direction we need to propagate changes if we want to *) (* consider the given root to be the "truth" *) (* -- *) (* root := "older" | "newer" | *) (* return value := 'Older | 'Newer | 'Replica1ToReplica2 | *) (* 'Replica2ToReplica1 *) (* -- *) let root2direction root = if root="older" then `Older else if root="newer" then `Newer else let roots = Safelist.rev (Globals.rawRoots()) in let r1 = Safelist.nth roots 0 in let r2 = Safelist.nth roots 1 in debug (fun() -> Printf.eprintf "root2direction called to choose %s from %s and %s\n" root r1 r2); if r1 = root then `Replica1ToReplica2 else if r2 = root then `Replica2ToReplica1 else raise (Util.Fatal (Printf.sprintf "%s (given as argument to 'prefer' or 'force' preference)\nis not one of \ the current roots:\n %s\n %s" root r1 r2)) let forceRoot: string Prefs.t = Prefs.createString "force" "" "force changes from this replica to the other" ("Including the preference \\texttt{-force \\ARG{root}} causes Unison to " ^ "resolve all differences (even non-conflicting changes) in favor of " ^ "\\ARG{root}. " ^ "This effectively changes Unison from a synchronizer into a mirroring " ^ "utility. \n\n" ^ "You can also specify \\verb|-force newer| (or \\verb|-force older|) " ^ "to force Unison to choose the file with the later (earlier) " ^ "modtime. In this case, the \\verb|-times| preference must also " ^ "be enabled.\n\n" ^ "This preference is overridden by the \\verb|forcepartial| preference.\n\n" ^ "This preference should be used only if you are {\\em sure} you " ^ "know what you are doing!") let forceRootPartial: Pred.t = Pred.create "forcepartial" ~advanced:true ("Including the preference \\texttt{forcepartial \\ARG{PATHSPEC} -> \\ARG{root}} causes Unison to " ^ "resolve all differences (even non-conflicting changes) in favor of " ^ "\\ARG{root} for the files in \\ARG{PATHSPEC} (see \\sectionref{pathspec}{Path Specification} " ^ "for more information). " ^ "This effectively changes Unison from a synchronizer into a mirroring " ^ "utility. \n\n" ^ "You can also specify \\verb|forcepartial PATHSPEC -> newer| " ^ "(or \\verb|forcepartial PATHSPEC older|) " ^ "to force Unison to choose the file with the later (earlier) " ^ "modtime. In this case, the \\verb|-times| preference must also " ^ "be enabled.\n\n" ^ "This preference should be used only if you are {\\em sure} you " ^ "know what you are doing!") let preferRoot: string Prefs.t = Prefs.createString "prefer" "" "choose this replica's version for conflicting changes" ("Including the preference \\texttt{-prefer \\ARG{root}} causes Unison always to " ^ "resolve conflicts in favor of \\ARG{root}, rather than asking for " ^ "guidance from the user. (The syntax of \\ARG{root} is the same as " ^ "for the \\verb|root| preference, plus the special values " ^ "\\verb|newer| and \\verb|older|.) \n\n" ^ "This preference is overridden by the \\verb|preferpartial| preference.\n\n" ^ "This preference should be used only if you are {\\em sure} you " ^ "know what you are doing!") let preferRootPartial: Pred.t = Pred.create "preferpartial" ~advanced:true ("Including the preference \\texttt{preferpartial \\ARG{PATHSPEC} -> \\ARG{root}} " ^ "causes Unison always to " ^ "resolve conflicts in favor of \\ARG{root}, rather than asking for " ^ "guidance from the user, for the files in \\ARG{PATHSPEC} (see " ^ "\\sectionref{pathspec}{Path Specification} " ^ "for more information). (The syntax of \\ARG{root} is the same as " ^ "for the \\verb|root| preference, plus the special values " ^ "\\verb|newer| and \\verb|older|.) \n\n" ^ "This preference should be used only if you are {\\em sure} you " ^ "know what you are doing!") (* [lookupPreferredRoot (): string * [`Force | `Prefer]] checks validity of *) (* preferences "force"/"preference", returns a pair (root, force) *) let lookupPreferredRoot () = if Prefs.read forceRoot <> "" then (Prefs.read forceRoot, `Force) else if Prefs.read preferRoot <> "" then (Prefs.read preferRoot, `Prefer) else ("",`Prefer) (* [lookupPreferredRootPartial: Path.t -> string * [`Force | `Prefer]] checks validity of *) (* preferences "forcepartial", returns a pair (root, force) *) let lookupPreferredRootPartial p = let s = Path.toString p in if Pred.test forceRootPartial s then (Pred.assoc forceRootPartial s, `Force) else if Pred.test preferRootPartial s then (Pred.assoc preferRootPartial s, `Prefer) else ("",`Prefer) (* Use the current values of the '-prefer ' and '-force ' *) (* preferences to override the reconciler's choices *) let overrideReconcilerChoices ris = let (root,force) = lookupPreferredRoot() in if root<>"" then begin let dir = root2direction root in Safelist.iter (fun ri -> setDirection ri dir force) ris end; Safelist.iter (fun ri -> let (rootp,forcep) = lookupPreferredRootPartial ri.path in if rootp<>"" then begin let dir = root2direction rootp in setDirection ri dir forcep end) ris (* Look up the preferred root and verify that it is OK (this is called at *) (* the beginning of the run, so that we don't have to wait to hear about *) (* errors *) (* This should also check for the partial version, but this needs a way to *) (* extract the associated values from a Pred.t *) let checkThatPreferredRootIsValid () = let test_root predname = function | "" -> () | ("newer" | "older") as r -> if not (Prefs.read Props.syncModtimes) then raise (Util.Transient (Printf.sprintf "The '%s=%s' preference can only be used with 'times=true'" predname r)) | r -> ignore (root2direction r) in let (root,pred) = lookupPreferredRoot() in if root<>"" then test_root (match pred with `Force -> "force" | `Prefer -> "prefer") root; Safelist.iter (test_root "forcepartial") (Pred.extern_associated_strings forceRootPartial); Safelist.iter (test_root "preferpartial") (Pred.extern_associated_strings preferRootPartial) (* ------------------------------------------------------------------------- *) (* Main Reconciliation stuff *) (* ------------------------------------------------------------------------- *) exception UpdateError of string let rec checkForError ui = match ui with NoUpdates -> () | Error err -> raise (UpdateError err) | Updates (uc, _) -> match uc with Dir (_, children, _, _) -> Safelist.iter (fun (_, uiSub) -> checkForError uiSub) children | Absent | File _ | Symlink _ -> () (* lifting errors in individual updates to replica problems *) let propagateErrors (rplc: Common.replicas): Common.replicas = match rplc with Problem _ -> rplc | Different ((_, _, _, ui1), (_, _, _, ui2), _, _) -> try checkForError ui1; try checkForError ui2; rplc with UpdateError err -> Problem ("[root 2]: " ^ err) with UpdateError err -> Problem ("[root 1]: " ^ err) type singleUpdate = Rep1Updated | Rep2Updated let update2replicaContent (conflict: bool) ui ucNew oldType: Common.replicaContent = match ucNew with Absent -> (`ABSENT, `Deleted, Props.dummy, ui) | File (desc, ContentsSame) -> (`FILE, `PropsChanged, desc, ui) | File (desc, _) when oldType <> `FILE -> (`FILE, `Created, desc, ui) | File (desc, ContentsUpdated _) -> (`FILE, `Modified, desc, ui) | Symlink l when oldType <> `SYMLINK -> (`SYMLINK, `Created, Props.dummy, ui) | Symlink l -> (`SYMLINK, `Modified, Props.dummy, ui) | Dir (desc, _, _, _) when oldType <> `DIRECTORY -> (`DIRECTORY, `Created, desc, ui) | Dir (desc, _, PropsUpdated, _) -> (`DIRECTORY, `PropsChanged, desc, ui) | Dir (desc, _, PropsSame, _) when conflict -> (* Special case: the directory contents has been modified and the *) (* directory is in conflict. (We don't want to display a conflict *) (* between an unchanged directory and a file, for instance: this would *) (* be rather puzzling to the user) *) (`DIRECTORY, `Modified, desc, ui) | Dir (desc, _, PropsSame, _) -> (`DIRECTORY, `Unchanged, desc, ui) let oldType (prev: Common.prevState): Fileinfo.typ = match prev with Previous (typ, _, _, _) -> typ | New -> `ABSENT let oldDesc (prev: Common.prevState): Props.t = match prev with Previous (_, desc, _, _) -> desc | New -> Props.dummy (* [describeUpdate ui] returns the replica contents for both the case of *) (* updating and the case of non-updatingd *) let describeUpdate ui : Common.replicaContent * Common.replicaContent = match ui with Updates (ucNewStatus, prev) -> let typ = oldType prev in (update2replicaContent false ui ucNewStatus typ, (typ, `Unchanged, oldDesc prev, NoUpdates)) | _ -> assert false (* Computes the reconItems when only one side has been updated. (We split *) (* this out into a separate function to avoid duplicating all the symmetric *) (* cases.) *) let rec reconcileNoConflict ui whatIsUpdated (result: (Name.t, Common.replicas) Tree.u) : (Name.t, Common.replicas) Tree.u = let different() = let rcUpdated, rcNotUpdated = describeUpdate ui in match whatIsUpdated with Rep2Updated -> Different(rcNotUpdated, rcUpdated, ref Replica2ToReplica1, Replica2ToReplica1) | Rep1Updated -> Different(rcUpdated, rcNotUpdated, ref Replica1ToReplica2, Replica1ToReplica2) in match ui with | NoUpdates -> result | Error err -> Tree.add result (Problem err) | Updates (Dir (desc, children, permchg, _), Previous(`DIRECTORY, _, _, _)) -> let r = if permchg = PropsSame then result else Tree.add result (different ()) in Safelist.fold_left (fun result (theName, uiChild) -> Tree.leave (reconcileNoConflict uiChild whatIsUpdated (Tree.enter result theName))) r children | Updates _ -> Tree.add result (propagateErrors (different ())) (* [combineChildrn children1 children2] combines two name-sorted lists of *) (* type [(Name.t * Common.updateItem) list] to a single list of type *) (* [(Name.t * Common.updateItem * Common.updateItem] *) let combineChildren children1 children2 = (* NOTE: This function assumes children1 and children2 are sorted. *) let rec loop r children1 children2 = match children1,children2 with [],_ -> Safelist.rev_append r (Safelist.map (fun (name,ui) -> (name,NoUpdates,ui)) children2) | _,[] -> Safelist.rev_append r (Safelist.map (fun (name,ui) -> (name,ui,NoUpdates)) children1) | (name1,ui1)::rem1, (name2,ui2)::rem2 -> let dif = Name.compare name1 name2 in if dif = 0 then loop ((name1,ui1,ui2)::r) rem1 rem2 else if dif < 0 then loop ((name1,ui1,NoUpdates)::r) rem1 children2 else loop ((name2,NoUpdates,ui2)::r) children1 rem2 in loop [] children1 children2 (* File are marked equal in groups of 5000 to lower memory consumption *) let add_equal (counter, archiveUpdated) equal v = let eq = Tree.add equal v in incr counter; archiveUpdated := true; if !counter = 5000 then begin counter := 0; let (t, eq) = Tree.slice eq in (* take a snapshot of the tree *) Update.markEqual t; (* work on it *) eq (* and return the leftover spine *) end else eq (* The main reconciliation function: takes a path and two updateItem *) (* structures and returns a list of reconItems containing suggestions for *) (* propagating changes to make the two replicas equal. *) (* -- *) (* It uses two accumulators: *) (* equals: (Name.t, Common.updateContent * Common.updateContent) *) (* Tree.u *) (* unequals: (Name.t, Common.replicas) Tree.u *) (* -- *) let rec reconcile path ui1 ui2 counter equals unequals = let different uc1 uc2 oldType equals unequals = (equals, Tree.add unequals (propagateErrors (Different(update2replicaContent true ui1 uc1 oldType, update2replicaContent true ui2 uc2 oldType, ref Conflict, Conflict)))) in let toBeMerged uc1 uc2 oldType equals unequals = (equals, Tree.add unequals (propagateErrors (Different(update2replicaContent true ui1 uc1 oldType, update2replicaContent true ui2 uc2 oldType, ref Merge, Merge)))) in match (ui1, ui2) with (Error s, _) -> (equals, Tree.add unequals (Problem s)) | (_, Error s) -> (equals, Tree.add unequals (Problem s)) | (NoUpdates, _) -> (equals, reconcileNoConflict ui2 Rep2Updated unequals) | (_, NoUpdates) -> (equals, reconcileNoConflict ui1 Rep1Updated unequals) | (Updates (Absent, _), Updates (Absent, _)) -> (add_equal counter equals (Absent, Absent), unequals) | (Updates (Dir (desc1, children1, propsChanged1, _) as uc1, prevState1), Updates (Dir (desc2, children2, propsChanged2, _) as uc2, prevState2)) -> (* See if the directory itself should have a reconItem *) let dirResult = if propsChanged1 = PropsSame && propsChanged2 = PropsSame then (equals, unequals) else if Props.similar desc1 desc2 then let uc1 = Dir (desc1, [], PropsSame, false) in let uc2 = Dir (desc2, [], PropsSame, false) in (add_equal counter equals (uc1, uc2), unequals) else let action = if propsChanged1 = PropsSame then Replica2ToReplica1 else if propsChanged2 = PropsSame then Replica1ToReplica2 else Conflict in (equals, Tree.add unequals (Different (update2replicaContent false ui1 uc1 `DIRECTORY, update2replicaContent false ui2 uc2 `DIRECTORY, ref action, action))) in (* Apply reconcile on children. *) Safelist.fold_left (fun (equals, unequals) (name,ui1,ui2) -> let (eq, uneq) = reconcile (Path.child path name) ui1 ui2 counter (Tree.enter equals name) (Tree.enter unequals name) in (Tree.leave eq, Tree.leave uneq)) dirResult (combineChildren children1 children2) | (Updates (File (desc1,contentsChanged1) as uc1, prev), Updates (File (desc2,contentsChanged2) as uc2, _)) -> begin match contentsChanged1, contentsChanged2 with ContentsUpdated (dig1, _, ress1), ContentsUpdated (dig2, _, ress2) when dig1 = dig2 -> if Props.similar desc1 desc2 then (add_equal counter equals (uc1, uc2), unequals) else (* Special case: when both sides are modified files but their contents turn *) (* out to be the same, we want to display them as 'perms' rather than 'new' *) (* on both sides, to avoid confusing the user. (The Transfer module also *) (* expect this.) *) let uc1' = File(desc1,ContentsSame) in let uc2' = File(desc2,ContentsSame) in different uc1' uc2' (oldType prev) equals unequals | ContentsSame, ContentsSame when Props.similar desc1 desc2 -> (add_equal counter equals (uc1, uc2), unequals) | ContentsUpdated _, ContentsUpdated _ when Globals.shouldMerge path -> toBeMerged uc1 uc2 (oldType prev) equals unequals | _ -> different uc1 uc2 (oldType prev) equals unequals end | (Updates (Symlink(l1) as uc1, prev), Updates (Symlink(l2) as uc2, _)) -> if l1 = l2 then (add_equal counter equals (uc1, uc2), unequals) else different uc1 uc2 (oldType prev) equals unequals | (Updates (uc1, prev), Updates (uc2, _)) -> different uc1 uc2 (oldType prev) equals unequals (* Sorts the paths so that they will be displayed in order *) let sortPaths pathUpdatesList = Sort.list (fun (p1, _) (p2, _) -> Path.compare p1 p2 <= 0) pathUpdatesList let rec enterPath p t = match Path.deconstruct p with None -> t | Some (nm, p') -> enterPath p' (Tree.enter t nm) let rec leavePath p t = match Path.deconstruct p with None -> t | Some (nm, p') -> leavePath p' (Tree.leave t) (* A path is dangerous if one replica has been emptied but not the other *) let dangerousPath u1 u2 = let emptied u = match u with Updates (Absent, _) -> true | Updates (Dir (_, _, _, empty), _) -> empty | _ -> false in emptied u1 <> emptied u2 (* The second component of the return value is true if there is at least one *) (* file that is updated in the same way on both roots *) let reconcileList (pathUpdatesList: (Path.t * Common.updateItem list) list) : Common.reconItem list * bool * Path.t list = let counter = ref 0 in let archiveUpdated = ref false in let (equals, unequals, dangerous) = Safelist.fold_left (fun (equals, unequals, dangerous) (path,updatesList) -> match updatesList with [ui1; ui2] -> let (equals, unequals) = reconcile path ui1 ui2 (counter, archiveUpdated) (enterPath path equals) (enterPath path unequals) in (leavePath path equals, leavePath path unequals, if dangerousPath ui1 ui2 then path :: dangerous else dangerous) | _ -> assert false) (Tree.start, Tree.start, []) pathUpdatesList in let unequals = Tree.finish unequals in debug (fun() -> Util.msg "reconcile: %d results\n" (Tree.size unequals)); let equals = Tree.finish equals in Update.markEqual equals; (* Commit archive updates done up to now *) if !archiveUpdated then Update.commitUpdates (); let result = Tree.flatten unequals Path.empty Path.child [] in let unsorted = Safelist.map (fun (p, rplc) -> {path = p; replicas = rplc}) result in let sorted = Sortri.sortReconItems unsorted in overrideReconcilerChoices sorted; (sorted, not (Tree.is_empty equals), dangerous) (* This is the main function: it takes a list of updateItem lists and, according to the roots and paths of synchronization, builds the corresponding reconItem list. A second component indicates whether there is any file updated in the same way on both sides. *) let reconcileAll (ONEPERPATH(updatesListList)) = Trace.status "Reconciling changes"; debug (fun() -> Util.msg "reconcileAll\n"); let pathList = Prefs.read Globals.paths in let pathUpdatesList = sortPaths (Safelist.combine pathList updatesListList) in reconcileList pathUpdatesList let reconcileTwo p ui ui' = reconcileList [(p, [ui; ui'])] unison-2.32.52/recon.mli0000644000076500000000000000306311176730177014457 0ustar bcpiercewheel(* Unison file synchronizer: src/recon.mli *) (* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) val reconcileAll : Common.updateItem list Common.oneperpath (* one updateItem per replica, per path *) -> Common.reconItem list (* List of updates that need propagated *) * bool (* Any file updated equally on all roots*) * Path.t list (* Paths which have been emptied on one side*) (* --------------- *) val reconcileTwo : Path.t -> Common.updateItem -> Common.updateItem -> Common.reconItem list * bool * Path.t list (* Use the current values of the '-prefer ' and '-force ' *) (* preferences to override the reconciler's choices *) val overrideReconcilerChoices : Common.reconItem list -> unit (* If the given reconItem's default direction is Conflict (or the third *) (* argument is `Force), then set it as specified by the second argument. *) val setDirection : Common.reconItem -> [`Older | `Newer | `Merge | `Replica1ToReplica2 | `Replica2ToReplica1] -> [`Force | `Prefer] -> unit (* Set the given reconItem's direction back to the default *) val revertToDefaultDirection : Common.reconItem -> unit (* Look up the preferred root and verify that it is OK (this is called at *) (* the beginning of the run, before we do anything time consuming, so that *) (* we don't have to wait to hear about errors *) val checkThatPreferredRootIsValid : unit -> unit unison-2.32.52/remote.ml0000644000076500000000000012604311207765162014474 0ustar bcpiercewheel(* Unison file synchronizer: src/remote.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) (* XXX - Check exception handling - Use Lwt_unix.system for the merge function (Unix.open_process_in for diff) *) let (>>=) = Lwt.bind let debug = Trace.debug "remote" let debugV = Trace.debug "remote+" let debugE = Trace.debug "remote+" let debugT = Trace.debug "remote+" (* BCP: The previous definitions of the last two were like this: let debugE = Trace.debug "remote_emit" let debugT = Trace.debug "thread" But that resulted in huge amounts of output from '-debug all'. *) let windowsHack = Sys.os_type <> "Unix" (****) let encodeInt m = let int_buf = Bytearray.create 4 in int_buf.{0} <- Char.chr ( m land 0xff); int_buf.{1} <- Char.chr ((m lsr 8) land 0xff); int_buf.{2} <- Char.chr ((m lsr 16) land 0xff); int_buf.{3} <- Char.chr ((m lsr 24) land 0xff); int_buf let decodeInt int_buf i = let b0 = Char.code (int_buf.{i + 0}) in let b1 = Char.code (int_buf.{i + 1}) in let b2 = Char.code (int_buf.{i + 2}) in let b3 = Char.code (int_buf.{i + 3}) in ((b3 lsl 24) lor (b2 lsl 16) lor (b1 lsl 8) lor b0) (*************************************************************************) (* 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 : (Bytearray.t * 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 Bytearray.blit_from_string conn.inputBuffer 0 s pos l; conn.inputLength <- conn.inputLength - l; if conn.inputLength > 0 then String.blit conn.inputBuffer l conn.inputBuffer 0 conn.inputLength; 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 (Bytearray.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 Bytearray.blit_to_string s pos conn.outputBuffer conn.outputLength l; conn.outputLength <- conn.outputLength + l; if pos + l < len then fill_buffer_2 conn s (pos + l) len 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 <= Bytearray.length s - len); 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 = Bytearray.t type 'a marshalFunction = 'a -> (Bytearray.t * int * int) list -> (Bytearray.t * int * int) list type 'a unmarshalFunction = Bytearray.t -> 'a type 'a marshalingFunctions = 'a marshalFunction * 'a unmarshalFunction let registeredSet = ref Util.StringSet.empty let rec first_chars len msg = match msg with [] -> "" | (s, p, l) :: rem -> if l < len then Bytearray.sub s p l ^ first_chars (len - l) rem else Bytearray.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 (Bytearray.to_string tag) start; raise (Util.Fatal ((Printf.sprintf "Message payload too large (%d, %s, [%s]). \n" length (Bytearray.to_string tag) start) ^ "This is a bug in Unison; if it happens to you in a repeatable way, \n" ^ "please post a report on the unison-users mailing list.")) end; let l = Bytearray.length tag in debugE (fun() -> let start = first_chars (min length 10) rem' in let start = if length > 10 then start ^ "..." else start in let start = String.escaped start in Util.msg "send [%s] '%s' %d bytes\n" (Bytearray.to_string tag) start length); ((encodeInt (l + length), 0, 4) :: (tag, 0, l) :: rem') let safeUnmarshal unmarshalPayload tag buf = let taglength = Bytearray.length tag in if Bytearray.prefix tag buf 0 then unmarshalPayload buf taglength else let identifier = String.escaped (Bytearray.sub buf 0 (min taglength (Bytearray.length buf))) in raise (Util.Fatal (Printf.sprintf "[safeUnmarshal] expected '%s' but got '%s'" (String.escaped (Bytearray.to_string tag)) identifier)) let registerTag string = if Util.StringSet.mem string !registeredSet then raise (Util.Fatal (Printf.sprintf "tag %s is already registered" string)) else registeredSet := Util.StringSet.add string !registeredSet; Bytearray.of_string string let defaultMarshalingFunctions = (fun data rem -> let s = Bytearray.marshal data [Marshal.No_sharing] in let l = Bytearray.length s in ((s, 0, l) :: rem, l)), (fun buf pos -> Bytearray.unmarshal buf pos) let makeMarshalingFunctions payloadMarshalingFunctions string = let (marshalPayload, unmarshalPayload) = payloadMarshalingFunctions in 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 = Bytearray.create 4 in grab conn int_buf 4 >>= (fun () -> let length = decodeInt int_buf 0 in assert (length >= 0); (* Get packet *) let buf = Bytearray.create length in grab conn buf length >>= (fun () -> (debugE (fun () -> let start = if length > 10 then (Bytearray.sub buf 0 10) ^ "..." else Bytearray.sub buf 0 length in let start = String.escaped start in Util.msg "receive '%s' %d bytes\n" start length); Lwt.return buf))) type servercmd = connection -> Bytearray.t -> ((Bytearray.t * int * int) list -> (Bytearray.t * int * int) list) Lwt.t let serverCmds = ref (Util.StringMap.empty : servercmd Util.StringMap.t) type header = 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 0)); dump conn ((id, 0, 4) :: marshalHeader NormalResult (marshal []))) (function Util.Transient s -> debugE (fun () -> Util.msg "Sending transient exception (id: %d)\n" (decodeInt id 0)); dump conn ((id, 0, 4) :: marshalHeader (TransientExn s) []) | Util.Fatal s -> debugE (fun () -> Util.msg "Sending fatal exception (id: %d)\n" (decodeInt id 0)); 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 = Bytearray.create 4 in grab conn id 4 >>= (fun () -> let num_id = decodeInt id 0 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 buffer pos len = if pos = len then Lwt.return () else begin (grab conn buffer 1 >>= (fun () -> if buffer.{0} <> connectionHeader.[pos] then let prefix = String.sub connectionHeader 0 pos ^ Bytearray.to_string buffer in let rest = peek_without_blocking conn in Lwt.fail (Util.Fatal ("Received unexpected header from the server:\n \ expected \"" ^ String.escaped (* (String.sub connectionHeader 0 (pos + 1)) *) connectionHeader ^ "\" but received \"" ^ String.escaped (prefix ^ rest) ^ "\", \n" ^ "which differs at \"" ^ String.escaped prefix ^ "\".\n" ^ "This can happen because you have different versions of Unison\n" ^ "installed on the client and server machines, or because\n" ^ "your connection is failing and somebody is printing an error\n" ^ "message, or because your remote login shell is printing\n" ^ "something itself before starting Unison.")) else checkHeader conn 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 (Bytearray.create 1) 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@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@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 [(Bytearray.of_string connectionHeader, 0, String.length connectionHeader)] >>= (fun () -> (* Set the local warning printer to make an RPC to the client and show the warning there; ditto for the message printer *) 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 unison-2.32.52/remote.mli0000644000076500000000000001002011207765162014630 0ustar bcpiercewheel(* Unison file synchronizer: src/remote.mli *) (* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) module Thread : sig val unwindProtect : (unit -> 'a Lwt.t) -> (exn -> unit Lwt.t) -> 'a Lwt.t end (* Register a server function. The result is a function that takes a host name as argument and either executes locally or else communicates with a remote server, as appropriate. (Calling registerServerCmd also has the side effect of registering the command under the given name, so that when we are running as a server it can be looked up and executed when requested by a remote client.) *) val registerHostCmd : string (* command name *) -> ('a -> 'b Lwt.t) (* local command *) -> ( string (* -> host *) -> 'a (* arguments *) -> 'b Lwt.t) (* -> (suspended) result *) (* A variant of registerHostCmd, for constructing a remote command to be applied to a particular root (host + fspath). - A naming convention: when a `root command' is built from a corresponding `local command', we name the two functions OnRoot and Local *) val registerRootCmd : string (* command name *) -> ((Fspath.t * 'a) -> 'b Lwt.t) (* local command *) -> ( Common.root (* -> root *) -> 'a (* additional arguments *) -> 'b Lwt.t) (* -> (suspended) result *) (* Enter "server mode", reading and processing commands from a remote client process until killed *) val beAServer : unit -> unit val waitOnPort : string option -> string -> unit (* Whether the server should be killed when the client terminates *) val killServer : bool Prefs.t (* Establish a connection to the remote server (if any) corresponding to the root and return the canonical name of the root *) val canonizeRoot : string -> Clroot.clroot -> (string -> string -> string) option -> Common.root Lwt.t (* Statistics *) val emittedBytes : float ref val receivedBytes : float ref (* Establish a connection to the server. First call openConnectionStart, then loop: call openConnectionPrompt, if you get a prompt, respond with openConnectionReply if desired. After you get None from openConnectionPrompt, call openConnectionEnd. Call openConnectionCancel to abort the connection. *) type preconnection val openConnectionStart : Clroot.clroot -> preconnection option val openConnectionPrompt : preconnection -> string option val openConnectionReply : preconnection -> string -> unit val openConnectionEnd : preconnection -> unit val openConnectionCancel : preconnection -> unit (* return the canonical name of the root. The connection to the root must have already been established by the openConnection sequence. *) val canonize : Clroot.clroot -> Common.root (****) type msgId = int module MsgIdMap : Map.S with type key = msgId val newMsgId : unit -> msgId type connection val connectionToRoot : Common.root -> connection val registerServerCmd : string -> (connection -> 'a -> 'b Lwt.t) -> connection -> 'a -> 'b Lwt.t val registerSpecialServerCmd : string -> ('a -> (Bytearray.t * int * int) list -> (Bytearray.t * int * int) list * int) * (Bytearray.t -> int -> 'a) -> ('b -> (Bytearray.t * int * int) list -> (Bytearray.t * int * int) list * int) * (Bytearray.t -> int -> 'b) -> (connection -> 'a -> 'b Lwt.t) -> connection -> 'a -> 'b Lwt.t val defaultMarshalingFunctions : ('a -> (Bytearray.t * int * int) list -> (Bytearray.t * int * int) list * int) * (Bytearray.t -> int -> 'b) val encodeInt : int -> Bytearray.t val decodeInt : Bytearray.t -> int -> int val registerRootCmdWithConnection : string (* command name *) -> (connection -> 'a -> 'b Lwt.t) (* local command *) -> Common.root (* root on which the command is executed *) -> Common.root (* other root *) -> 'a (* additional arguments *) -> 'b Lwt.t (* result *) unison-2.32.52/ROADMAP.txt0000644000076500000000000000567711176730177014507 0ustar bcpiercewheelFINDING YOUR WAY AROUND THE UNISON SOURCES ------------------------------------------ Although parts of it are somewhat intricate, Unison is not a very large program. If you want to get familiar with the code, the best place to start is probably with the textual user interface module, uitext.ml. The 'start' function at the bottom is a simple driver for all the rest of the major modules in the program. (See below for some more details.) After that, check out main.ml to see how things get set up. Again, the bottom is the most interesting part. Next, look at the interface files in this order: globals.mli common low-level datatype definitions common.mli common high-level datatype definitions update.mli update detection recon.mli reconciliation of updates (i.e. deciding what to do) transport.mli propagation of changes (also files.mi) From here, you probably know your way around enough to decide where to look next. Here's a summary of the most interesting modules: pred implements "predicates" (e.g. ignore) based on regexps prefs command-line and preference file parsing main the top-level program os low-level filesystem operations trace tracing messages uicommon stuff common to the two UIs uitext the textual UI uigtk the graphical UI (Gtk version) The files linktext.ml and linkgtk.ml contain linking commands for assembling unision with either a textual or a graphical user interface. (The Main module, which takes the UI as a paramter, is the only part of the program that is functorized.) The module Remote handles RPC communication between clients and remote servers. It's pretty tricky, but the rest of the system doesn't need to know much about how it works. ________________________________ In a little more detail, here is the flow of control at startup time: - The first code to execute (not counting some small per-module initialization stuff) is the call to Main.init() from Main.Body. This handles a few special preferences like -version, -doc, and -server. If it returns, then Main.Body next calls the start function of whatever UI module has been provided as an argument to the Main module. - The start function in each of the UI modules (Uitext, Uigtk2, etc.) behaves slightly differently, but they all have quite a bit of common structure; this is captured in the function Uicommon.uiInit, which is where all the heavy lifting happens (parsing command line and preference files, connecting to the server, etc.); when this returns, the user interface continues with the actual synchronization. - The core functions that do the real work (of synchronization) are: Update.findUpdates() find out what changed Recon.reconcileAll build the list of "recon items" Transport.transportItem perform the action described by a recon item unison-2.32.52/sortri.ml0000644000076500000000000001157111176730177014525 0ustar bcpiercewheel(* Unison file synchronizer: src/sortri.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) open Common let dbgsort = Util.debug "sort" (* Preferences *) let bysize = Prefs.createBool "sortbysize" false "!list changed files by size, not name" ("When this flag is set, the user interface will list changed files " ^ "by size (smallest first) rather than by name. This is useful, for " ^ "example, for synchronizing over slow links, since it puts very " ^ "large files at the end of the list where they will not prevent " ^ "smaller files from being transferred quickly.\n\n" ^ "This preference (as well as the other sorting flags, but not the " ^ "sorting preferences that require patterns as arguments) can be " ^ "set interactively and temporarily using the 'Sort' menu in the " ^ "graphical user interface.") let newfirst = Prefs.createBool "sortnewfirst" false "!list new before changed files" ("When this flag is set, the user interface will list newly created " ^ "files before all others. This is useful, for example, for checking " ^ "that newly created files are not `junk', i.e., ones that should be " ^ "ignored or deleted rather than synchronized.") let sortfirst = Pred.create "sortfirst" ~advanced:true ("Each argument to \\texttt{sortfirst} is a pattern \\ARG{pathspec}, " ^ "which describes a set of paths. " ^ "Files matching any of these patterns will be listed first in the " ^ "user interface. " ^ "The syntax of \\ARG{pathspec} is " ^ "described in \\sectionref{pathspec}{Path Specification}.") let sortlast = Pred.create "sortlast" ~advanced:true ("Similar to \\verb|sortfirst|, except that files matching one of these " ^ "patterns will be listed at the very end.") type savedPrefs = {nf:bool; bs:bool; sf:string list; sl:string list} let savedPrefs = ref(None) let saveSortingPrefs () = if !savedPrefs = None then savedPrefs := Some { sf = Pred.extern sortfirst; sl = Pred.extern sortlast; bs = Prefs.read bysize; nf = Prefs.read newfirst } let restoreDefaultSettings () = match !savedPrefs with None -> () | Some {nf=nf; bs=bs; sf=sf; sl=sl} -> Prefs.set newfirst nf; Prefs.set bysize bs; Pred.intern sortfirst sf; Pred.intern sortlast sl let zeroSortingPrefs () = Prefs.set newfirst false; Prefs.set bysize false; Pred.intern sortfirst []; Pred.intern sortlast [] (* ------------------- *) let sortByName () = saveSortingPrefs(); zeroSortingPrefs() let sortBySize () = saveSortingPrefs(); zeroSortingPrefs(); Prefs.set bysize true let sortNewFirst () = saveSortingPrefs(); Prefs.set newfirst (not (Prefs.read newfirst)) (* ---------------------------------------------------------------------- *) (* Main sorting functions *) let shouldSortFirst ri = Pred.test sortfirst (Path.toString ri.path) let shouldSortLast ri = Pred.test sortlast (Path.toString ri.path) let newItem ri = let newItem1 ri = match ri.replicas with Different((_, `Created, _, _), _, _, _) -> true | _ -> false in let newItem2 ri = match ri.replicas with Different(_, (_, `Created, _, _), _, _) -> true | _ -> false in newItem1 ri || newItem2 ri (* Should these go somewhere else? *) let rec combineCmp = function [] -> 0 | c::cs -> if c<>0 then c else combineCmp cs let invertCmp c = c * -1 let compareReconItems () = let newfirst = Prefs.read newfirst in fun ri1 ri2 -> let pred p = let b1 = p ri1 in let b2 = p ri2 in if b1 && b2 then 0 else if b1 then -1 else if b2 then 1 else 0 in let cmp = combineCmp [ pred problematic; pred shouldSortFirst; invertCmp (pred shouldSortLast); if newfirst then pred newItem else 0; (if Prefs.read bysize then let l1 = Common.riLength ri1 in let l2 = Common.riLength ri2 in if l1 Util.msg "%s <= %s --> %d\n" (Path.toString ri1.path) (Path.toString ri2.path) cmp); cmp let sortReconItems items = Safelist.stable_sort (compareReconItems()) items unison-2.32.52/sortri.mli0000644000076500000000000000147411176730177014677 0ustar bcpiercewheel(* 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 unison-2.32.52/stasher.ml0000644000076500000000000005326111176730177014656 0ustar bcpiercewheel(* Unison file synchronizer: src/stasher.ml *) (* $I2: Last modified by lescuyer *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) (* --------------------------------------------------------------------------*) (* Preferences for backing up and stashing *) let debug = Util.debug "stasher" let verbose = Util.debug "stasher+" let backuplocation = Prefs.createString "backuploc" "central" "!where backups are stored ('local' or 'central')" ("This preference determines whether backups should be kept locally, near the " ^ "original files, or" ^" in a central directory specified by the \\texttt{backupdir} " ^"preference. If set to \\verb|local|, backups will be kept in " ^"the same directory as the original files, and if set to \\verb|central|," ^" \\texttt{backupdir} will be used instead.") let _ = Prefs.alias backuplocation "backuplocation" let backup = Pred.create "backup" ~advanced:true ("Including the preference \\texttt{-backup \\ARG{pathspec}} " ^ "causes Unison to keep backup files for each path that matches " ^ "\\ARG{pathspec}. These backup files are kept in the " ^ "directory specified by the \\verb|backuplocation| preference. The backups are named " ^ "according to the \\verb|backupprefix| and \\verb|backupsuffix| preferences." ^ " The number of versions that are kept is determined by the " ^ "\\verb|maxbackups| preference." ^ "\n\n The syntax of \\ARG{pathspec} is described in " ^ "\\sectionref{pathspec}{Path Specification}.") let _ = Pred.alias backup "mirror" let backupnot = Pred.create "backupnot" ~advanced:true ("The values of this preference specify paths or individual files or" ^ " regular expressions that should {\\em not} " ^ "be backed up, even if the {\\tt backup} preference selects " ^ "them---i.e., " ^ "it selectively overrides {\\tt backup}. The same caveats apply here " ^ "as with {\\tt ignore} and {\tt ignorenot}.") let _ = Pred.alias backupnot "mirrornot" let shouldBackup p = let s = (Path.toString p) in Pred.test backup s && not (Pred.test backupnot s) let backupprefix = Prefs.createString "backupprefix" ".bak.$VERSION." "!prefix for the names of backup files" ("When a backup for a file \\verb|NAME| is created, it is stored " ^ "in a directory specified by \\texttt{backuplocation}, in a file called " ^ "\\texttt{backupprefix}\\verb|NAME|\\texttt{backupsuffix}." ^ " \\texttt{backupprefix} can include a directory name (causing Unison to " ^ "keep all backup files for a given directory in a subdirectory with this name), and both " ^ " \\texttt{backupprefix} and \\texttt{backupsuffix} can contain the string" ^ "\\ARG{\\$VERSION}, which will be replaced by the \\emph{age} of the backup " ^ "(1 for the most recent, 2 for the second most recent, and so on...)." ^ " This keyword is ignored if it appears in a directory name" ^ " in the prefix; if it does not appear anywhere" ^ " in the prefix or the suffix, it will be automatically" ^ " placed at the beginning of the suffix. " ^ "\n\n" ^ "One thing to be careful of: If the {\\tt backuploc} preference is set " ^ "to {\\tt local}, Unison will automatically ignore {\\em all} files " ^ "whose prefix and suffix match {\\tt backupprefix} and {\\tt backupsuffix}. " ^ "So be careful to choose values for these preferences that are sufficiently " ^ "different from the names of your real files.") let backupsuffix = Prefs.createString "backupsuffix" "" "!a suffix to be added to names of backup files" ("See \\texttt{backupprefix} for full documentation.") let backups = Prefs.createBool "backups" false "!keep backup copies of all files (see also 'backup')" ("Setting this flag to true is equivalent to " ^" setting \\texttt{backuplocation} to \\texttt{local}" ^" and \\texttt{backup} to \\verb|Name *|.") (* The following function is used to express the old backup preference, if set, in the terms of the new preferences *) let translateOldPrefs () = match (Pred.extern backup, Pred.extern backupnot, Prefs.read backups) with ([], [], true) -> debug (fun () -> Util.msg "backups preference set: translated into backup and backuplocation\n"); Pred.intern backup ["Name *"]; Prefs.set backuplocation "local" | (_, _, false) -> () | _ -> raise (Util.Fatal ( "Both old 'backups' preference and " ^ "new 'backup' preference are set!")) let maxbackups = Prefs.createInt "maxbackups" 2 "!number of backed up versions of a file" ("This preference specifies the number of backup versions that will " ^ "be kept by unison, for each path that matches the predicate " ^ "\\verb|backup|. The default is 2.") let _ = Prefs.alias maxbackups "mirrorversions" let _ = Prefs.alias maxbackups "backupversions" let backupdir = Prefs.createString "backupdir" "" "!directory for storing centralized backups" ("If this preference is set, Unison will use it as the name of the " ^ "directory used to store backup files specified by " ^ "the {\\tt backup} preference, when {\\tt backuplocation} is set" ^ " to \\verb|central|. It is checked {\\em after} the " ^ "{\\tt UNISONBACKUPDIR} environment variable.") let backupDirectory () = Util.convertUnixErrorsToTransient "backupDirectory()" (fun () -> try Fspath.canonize (Some (Unix.getenv "UNISONBACKUPDIR")) with Not_found -> try Fspath.canonize (Some (Unix.getenv "UNISONMIRRORDIR")) with Not_found -> if Prefs.read backupdir <> "" then Fspath.canonize (Some (Prefs.read backupdir)) else Os.fileInUnisonDir "backup") let backupcurrent = Pred.create "backupcurr" ~advanced:true ("Including the preference \\texttt{-backupcurr \\ARG{pathspec}} " ^" causes Unison to keep a backup of the {\\em current} version of every file " ^ "matching \\ARG{pathspec}. " ^" This file will be saved as a backup with version number 000. Such" ^" backups can be used as inputs to external merging programs, for instance. See " ^ "the documentatation for the \\verb|merge| preference." ^" For more details, see \\sectionref{merge}{Merging Conflicting Versions}." ^"\n\n The syntax of \\ARG{pathspec} is described in " ^ "\\sectionref{pathspec}{Path Specification}.") let backupcurrentnot = Pred.create "backupcurrnot" ~advanced:true "Exceptions to \\verb|backupcurr|, like the \\verb|ignorenot| preference." let shouldBackupCurrent p = (* BCP: removed next line [Apr 2007]: causes ALL mergeable files to be backed up, which is probably not what users want -- the backupcurrent switch should be used instead. Globals.shouldMerge p || *) (let s = Path.toString p in Pred.test backupcurrent s && not (Pred.test backupcurrentnot s)) let _ = Pred.alias backupcurrent "backupcurrent" let _ = Pred.alias backupcurrentnot "backupcurrentnot" (* ---------------------------------------------------------------------------*) (* NB: We use Str.regexp here because we need group matching to retrieve and increment version numbers from backup file names. We only use it here, though: to check if a path should be backed up or ignored, we use Rx instead. (This is important because the Str regexp functions are terribly slow.) *) (* A tuple of string option * string * string, describing a regular expression that matches the filenames of unison backups according to the current preferences. The first regexp is an option to match the local directory, if any, in which backups are stored; the second one matches the prefix, the third the suffix. Note that we always use forward slashes here (rather than using backslashes when running on windows) because we are constructing rx's that are going to be matched against Path.t's. (Strictly speaking, we ought to ask the Path module what the path separator character is, rather than assuming it is slash, but this is never going to change.) *) let backup_rx () = let version_rx = "\\([0-9]+\\)" in let prefix = Prefs.read backupprefix in let suffix = Str.quote (Prefs.read backupsuffix) in let (udir, uprefix) = ((match Filename.dirname prefix with | "." -> "" | s -> (Fileutil.backslashes2forwardslashes s)^"/"), Filename.basename prefix) in let (dir, prefix) = ((match udir with "" -> None | _ -> Some(Str.quote udir)), Str.quote uprefix) in if Str.string_match (Str.regexp ".*\\\\\\$VERSION.*") (prefix^suffix) 0 then (dir, Str.global_replace (Str.regexp "\\\\\\$VERSION") version_rx prefix, Str.global_replace (Str.regexp "\\\\\\$VERSION") version_rx suffix) else raise (Util.Fatal "Either backupprefix or backupsuffix must contain '$VERSION'") (* We ignore files whose name ends in .unison.bak, since people may still have these lying around from using previous versions of Unison. *) let oldBackupPrefPathspec = "Name *.unison.bak" (* This function creates Rx regexps based on the preferences to ignore backups of old and current versions. *) let addBackupFilesToIgnorePref () = let (dir_rx, prefix_rx, suffix_rx) = backup_rx() in let regexp_to_rx s = Str.global_replace (Str.regexp "\\\\(") "" (Str.global_replace (Str.regexp "\\\\)") "" s) in let (full, dir) = let d = match dir_rx with None -> "/" | Some s -> regexp_to_rx s in let p = regexp_to_rx prefix_rx in let s = regexp_to_rx suffix_rx in debug (fun() -> Util.msg "d = %s\n" d); ("(.*/)?"^p^".*"^s, "(.*/)?"^(String.sub d 0 (String.length d - 1))) in let theRegExp = match dir_rx with None -> "Regex " ^ full | Some _ -> "Regex " ^ dir in Globals.addRegexpToIgnore oldBackupPrefPathspec; if Prefs.read backuplocation = "local" then begin debug (fun () -> Util.msg "New pattern being added to ignore preferences (for backup files):\n %s\n" theRegExp); Globals.addRegexpToIgnore theRegExp end (* We use references for functions that compute the prefixes and suffixes in order to avoid using functions from the Str module each time we need them. *) let make_prefix = ref (fun i -> assert false) let make_suffix = ref (fun i -> assert false) (* This function updates the function used to create prefixes and suffixes for naming backup files, according to the preferences. *) let updateBackupNamingFunctions () = let makeFun s = match Str.full_split (Str.regexp "\\$VERSION") s with [] -> (fun _ -> "") | [Str.Text t] -> (fun _ -> t) | [Str.Delim _; Str.Text t] -> (fun i -> Printf.sprintf "%d%s" i t) | [Str.Text t; Str.Delim _] -> (fun i -> Printf.sprintf "%s%d" t i) | [Str.Text t; Str.Delim _; Str.Text t'] -> (fun i -> Printf.sprintf "%s%d%s" t i t') | _ -> raise (Util.Fatal ( "The tag $VERSION should only appear " ^"once in the backupprefix and backupsuffix preferences.")) in make_prefix := makeFun (Prefs.read backupprefix); make_suffix := makeFun (Prefs.read backupsuffix); debug (fun () -> Util.msg "Prefix and suffix regexps for backup filenames have been updated\n") (*------------------------------------------------------------------------------------*) let makeBackupName path i = (* if backups are kept centrally, the current version has exactly the same name as the original, for convenience. *) if i=0 && Prefs.read backuplocation = "central" then path else Path.addSuffixToFinalName (Path.addPrefixToFinalName path (!make_prefix i)) (!make_suffix i) let stashDirectory fspath = match Prefs.read backuplocation with "central" -> backupDirectory () | "local" -> fspath | _ -> raise (Util.Fatal ("backuplocation preference should be set" ^"to central or local.")) let showContent typ fspath path = match typ with | `FILE -> Fingerprint.toString (Fingerprint.file fspath path) | `SYMLINK -> Os.readLink fspath path | `DIRECTORY -> "DIR" | `ABSENT -> "ABSENT" (* Generates a file name for a backup file. If backup file already exists, the old file will be renamed with the count incremented. The newest backup file is always the one with version number 1, larger numbers mean older files. *) (* BCP: Note that the way we keep bumping up the backup numbers on all existing backup files could make backups very expensive if someone sets maxbackups to a sufficiently large number! *) let backupPath fspath path = let sFspath = stashDirectory fspath in let rec f i = let tempPath = makeBackupName path i in if Os.exists sFspath tempPath then if i < Prefs.read maxbackups then Os.rename "backupPath" sFspath tempPath sFspath (f (i + 1)) else if i >= Prefs.read maxbackups then Os.delete sFspath tempPath; tempPath in let rec mkdirectories backdir = verbose (fun () -> Util.msg "mkdirectories %s %s\n" (Fspath.toString sFspath) (Path.toString backdir)); if not (Os.exists sFspath Path.empty) then Os.createDir sFspath Path.empty Props.dirDefault; match Path.deconstructRev backdir with None -> () | Some (_, parent) -> mkdirectories parent; let props = (Fileinfo.get false sFspath Path.empty).Fileinfo.desc in if not (Os.exists sFspath backdir) then Os.createDir sFspath backdir props in let path0 = makeBackupName path 0 in let sourceTyp = (Fileinfo.get true fspath path).Fileinfo.typ in let path0Typ = (Fileinfo.get true sFspath path0).Fileinfo.typ in if ( sourceTyp = `FILE && path0Typ = `FILE && (Fingerprint.file fspath path) = (Fingerprint.file sFspath path0)) || ( sourceTyp = `SYMLINK && path0Typ = `SYMLINK && (Os.readLink fspath path) = (Os.readLink sFspath path0)) then begin debug (fun()-> Util.msg "[%s / %s] = [%s / %s] = %s: no need to back up\n" (Fspath.toString sFspath) (Path.toString path0) (Fspath.toString fspath) (Path.toString path) (showContent sourceTyp fspath path)); None end else begin debug (fun()-> Util.msg "stashed [%s / %s] = %s is not equal to new [%s / %s] = %s (or one is a dir): stash!\n" (Fspath.toString sFspath) (Path.toString path0) (showContent path0Typ sFspath path0) (Fspath.toString fspath) (Path.toString path) (showContent sourceTyp fspath path)); let sPath = f 0 in (* Make sure the parent directory exists *) begin match Path.deconstructRev sPath with | None -> mkdirectories Path.empty | Some (_, backdir) -> mkdirectories backdir end; Some(sFspath, sPath) end (*------------------------------------------------------------------------------------*) let backup fspath path (finalDisposition : [`AndRemove | `ByCopying]) = debug (fun () -> Util.msg "backup: %s / %s\n" (Fspath.toString fspath) (Path.toString path)); Util.convertUnixErrorsToTransient "backup" (fun () -> let disposeIfNeeded() = if finalDisposition = `AndRemove then Os.delete fspath path in if not (Os.exists fspath path) then debug (fun () -> Util.msg "File %s in %s does not exist, so no need to back up\n" (Path.toString path) (Fspath.toString fspath)) else if shouldBackup path then begin match backupPath fspath path with None -> disposeIfNeeded() | Some (backRoot, backPath) -> debug (fun () -> Util.msg "Backing up %s / %s to %s in %s\n" (Fspath.toString fspath) (Path.toString path) (Path.toString backPath) (Fspath.toString backRoot)); let byCopying() = let rec copy p backp = let info = Fileinfo.get true fspath p in match info.Fileinfo.typ with | `SYMLINK -> debug (fun () -> Util.msg " Copying link %s / %s to %s / %s\n" (Fspath.toString fspath) (Path.toString p) (Fspath.toString backRoot) (Path.toString backp)); Os.symlink backRoot backp (Os.readLink fspath p) | `FILE -> debug (fun () -> Util.msg " Copying file %s / %s to %s / %s\n" (Fspath.toString fspath) (Path.toString p) (Fspath.toString backRoot) (Path.toString backp)); Copy.localFile fspath p backRoot backp backp `Copy info.Fileinfo.desc (Osx.ressLength info.Fileinfo.osX.Osx.ressInfo) None | `DIRECTORY -> debug (fun () -> Util.msg " Copying directory %s / %s to %s / %s\n" (Fspath.toString fspath) (Path.toString p) (Fspath.toString backRoot) (Path.toString backp)); Os.createDir backRoot backp info.Fileinfo.desc; let ch = Os.childrenOf fspath p in Safelist.iter (fun n -> copy (Path.child p n) (Path.child backp n)) ch | `ABSENT -> assert false in copy path backPath; debug (fun () -> Util.msg " Finished copying; deleting %s / %s\n" (Fspath.toString fspath) (Path.toString path)); disposeIfNeeded() in try if finalDisposition = `AndRemove then Os.rename "backup" fspath path backRoot backPath else byCopying() with _ -> debug (fun () -> Util.msg "Rename failed -- copying instead\n"); byCopying() end else begin debug (fun () -> Util.msg "Path %s / %s does not need to be backed up\n" (Fspath.toString fspath) (Path.toString path)); disposeIfNeeded() end) (*------------------------------------------------------------------------------------*) let rec stashCurrentVersion fspath path sourcePathOpt = if shouldBackupCurrent path then Util.convertUnixErrorsToTransient "stashCurrentVersion" (fun () -> let sourcePath = match sourcePathOpt with None -> path | Some p -> p in debug (fun () -> Util.msg "stashCurrentVersion of %s (drawn from %s) in %s\n" (Path.toString path) (Path.toString sourcePath) (Fspath.toString fspath)); let stat = Fileinfo.get true fspath sourcePath in match stat.Fileinfo.typ with `ABSENT -> () | `DIRECTORY -> assert (sourcePathOpt = None); debug (fun () -> Util.msg "Stashing recursively because file is a directory\n"); ignore (Safelist.iter (fun n -> let pathChild = Path.child path n in if not (Globals.shouldIgnore pathChild) then stashCurrentVersion fspath (Path.child path n) None) (Os.childrenOf fspath path)) | `SYMLINK -> begin match backupPath fspath path with | None -> () | Some (stashFspath,stashPath) -> Os.symlink stashFspath stashPath (Os.readLink fspath sourcePath) end | `FILE -> begin match backupPath fspath path with | None -> () | Some (stashFspath, stashPath) -> Copy.localFile fspath sourcePath stashFspath stashPath stashPath `Copy stat.Fileinfo.desc (Osx.ressLength stat.Fileinfo.osX.Osx.ressInfo) None end) (*------------------------------------------------------------------------------------*) (* This function tries to find a backup of a recent version of the file at location (fspath, path) in the current replica, matching the given fingerprint. If no file is found, then the functions returns None *without* searching on the other replica *) let getRecentVersion fspath path fingerprint = debug (fun () -> Util.msg "getRecentVersion of %s in %s\n" (Path.toString path) (Fspath.toString fspath)); Util.convertUnixErrorsToTransient "getRecentVersion" (fun () -> let dir = stashDirectory fspath in let rec aux_find i = let path = makeBackupName path i in if Os.exists dir path && (let dig = Os.fingerprint dir path (Fileinfo.get false dir path) in dig = fingerprint) then begin debug (fun () -> Util.msg "recent version %s found in %s\n" (Path.toString path) (Fspath.toString dir)); Some (Fspath.concat dir path) end else if i = Prefs.read maxbackups then begin debug (fun () -> Util.msg "No recent version was available for %s on this root.\n" (Fspath.toString (Fspath.concat fspath path))); None end else aux_find (i+1) in aux_find 0) (*------------------------------------------------------------------------------------*) (* This function initializes the Stasher module according to the preferences defined in the profile. It should be called whenever a profile is reloaded. *) let initBackupsLocal () = debug (fun () -> Util.msg "initBackupsLocal\n"); translateOldPrefs (); addBackupFilesToIgnorePref (); updateBackupNamingFunctions () let initBackupsRoot: Common.root -> unit -> unit Lwt.t = Remote.registerRootCmd "initBackups" (fun (fspath, ()) -> Lwt.return (initBackupsLocal ())) let initBackups () = Lwt_unix.run ( Globals.allRootsIter (fun r -> initBackupsRoot r ())) unison-2.32.52/stasher.mli0000644000076500000000000000252611176730177015025 0ustar bcpiercewheel(* Unison file synchronizer: src/stasher.mli *) (* $I2: Last modified by lescuyer on *) (* $I3: Copyright 1999-2005 (see COPYING for details) $ *) (* This module maintains backups for general purpose and *) (* as archives for mergeable files. *) (* Make a backup copy of a file, if needed; if the third parameter is `AndRemove, then the file is either backed up by renaming or deleted if no backup is needed. *) val backup: Fspath.t -> Path.local -> [`AndRemove | `ByCopying] -> unit (* Stashes of current versions (so that we have archives when needed for merging) *) val stashCurrentVersion: Fspath.t (* fspath to stash *) -> Path.local (* path to stash *) -> Path.local option (* path to actual bits to be stashed (used to stash an additional archive version in addition to the current version) *) -> unit (* Retrieve a stashed version *) val getRecentVersion: Fspath.t -> Path.local -> Os.fullfingerprint -> Fspath.t option (* Return the location of the backup directory *) val backupDirectory : unit -> Fspath.t (* Check whether current version of a path is being stashed *) val shouldBackupCurrent : Path.t -> bool (* Low-level backupdir preference *) val backupdir : string Prefs.t (* Initialize the module *) val initBackups: unit -> unit unison-2.32.52/strings.ml0000644000076500000000000100565011222164520014657 0ustar bcpiercewheel(* DO NOT MODIFY. This file has been automatically generated, see docs.ml. *) let docs = ("about", ("About Unison", "Unison File Synchronizer\n\ Version 2.32.52\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@yahoogroups.com\n\ \032 (mailto:unison-users@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@yahoogroups.com (mailto:unison-users@yahoogroups.com).\n\ \n\ \032 Patches are even more welcome. They should be sent to\n\ \032 unison-hackers@lists.seas.upenn.edu\n\ \032 (mailto:unison-hackers@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 Note that root aliases are case-sensitive, even on case-insensitive\n\ \032 file systems.\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 manual intervention. This option should be set only if\n\ \032 you are positive that no other instance of Unison might be\n\ \032 concurrently accessing the same archive files (e.g., because\n\ \032 there was only one instance of unison running and it has just\n\ \032 crashed or you have just killed it). It is probably not a good\n\ \032 idea to set this option in a profile: it is intended for\n\ \032 command-line use.\n\ \032 ignorenot xxx\n\ \032 This preference overrides the preference ignore. It gives a\n\ \032 list of patterns (in the same format as ignore) for paths that\n\ \032 should definitely not be ignored, whether or not they happen to\n\ \032 match one of the ignore patterns.\n\ \032 Note that the semantics of ignore and ignorenot is a little\n\ \032 counter-intuitive. When detecting updates, Unison examines\n\ \032 paths in depth-first order, starting from the roots of the\n\ \032 replicas and working downwards. Before examining each path, it\n\ \032 checks whether it matches ignore and does not match ignorenot;\n\ \032 in this case it skips this path and all its descendants. This\n\ \032 means that, if some parent of a given path matches an ignore\n\ \032 pattern, then it will be skipped even if the path itself\n\ \032 matches an ignorenot pattern. In particular, putting ignore =\n\ \032 Path * in your profile and then using t ignorenot to select\n\ \032 particular paths to be synchronized will not work. Instead, you\n\ \032 should use the path preference to choose particular paths to\n\ \032 synchronize.\n\ \032 immutable xxx\n\ \032 This preference specifies paths for directories whose immediate\n\ \032 children are all immutable files -- i.e., once a file has been\n\ \032 created, its contents never changes. When scanning for updates,\n\ \032 Unison does not check whether these files have been modified;\n\ \032 this can speed update detection significantly (in particular,\n\ \032 for mail directories).\n\ \032 immutablenot xxx\n\ \032 This preference overrides immutable.\n\ \032 key xxx\n\ \032 Used in a profile to define a numeric key (0-9) that can be\n\ \032 used in the graphical user interface to switch immediately to\n\ \032 this profile.\n\ \032 killserver \n\ \032 When set to true, this flag causes Unison to kill the remote\n\ \032 server process when the synchronization is finished. This\n\ \032 behavior is the default for ssh connections, so this preference\n\ \032 is not normally needed when running over ssh; it is provided so\n\ \032 that socket-mode servers can be killed off after a single run\n\ \032 of Unison, rather than waiting to accept future connections.\n\ \032 (Some users prefer to start a remote socket server for each run\n\ \032 of Unison, rather than leaving one running all the time.)\n\ \032 label xxx\n\ \032 Used in a profile to provide a descriptive string documenting\n\ \032 its settings. (This is useful for users that switch between\n\ \032 several profiles, especially using the `fast switch' feature of\n\ \032 the graphical user interface.)\n\ \032 log \n\ \032 When this flag is set, Unison will log all changes to the\n\ \032 filesystems on a file.\n\ \032 logfile xxx\n\ \032 By default, logging messages will be appended to the file\n\ \032 unison.log in your HOME directory. Set this preference if you\n\ \032 prefer another file.\n\ \032 maxbackups n\n\ \032 This preference specifies the number of backup versions that\n\ \032 will be kept by unison, for each path that matches the\n\ \032 predicate backup. The default is 2.\n\ \032 maxthreads n\n\ \032 This preference controls how much concurrency is allowed during\n\ \032 the transport phase. Normally, it should be set reasonably high\n\ \032 (default is 20) to maximize performance, but when Unison is\n\ \032 used over a low-bandwidth link it may be helpful to set it\n\ \032 lower (e.g. to 1) so that Unison doesn't soak up all the\n\ \032 available bandwidth.\n\ \032 merge xxx\n\ \032 This preference can be used to run a merge program which will\n\ \032 create a new version for each of the files and the backup, with\n\ \032 the last backup and the both replicas. Setting the merge\n\ \032 preference for a path will also cause this path to be backed\n\ \032 up, just like t backup. The syntax of pathspec>cmd is described\n\ \032 in the section \"Path Specification\" , and further details on\n\ \032 Merging functions are present in the section \"Merging files\" .\n\ \032 mountpoint xxx\n\ \032 Including the preference -mountpoint PATH causes Unison to\n\ \032 double-check, at the end of update detection, that PATH exists\n\ \032 and abort if it does not. This is useful when Unison is used to\n\ \032 synchronize removable media. This preference can be given more\n\ \032 than once. See the section \"Mount Points\" .\n\ \032 numericids \n\ \032 When this flag is set to true, groups and users are\n\ \032 synchronized numerically, rather than by name.\n\ \032 The special uid 0 and the special group 0 are never mapped via\n\ \032 user/group names even if this preference is not set.\n\ \032 owner \n\ \032 When this flag is set to true, the owner attributes of the\n\ \032 files are synchronized. Whether the owner names or the owner\n\ \032 identifiers are synchronizeddepends on the preference\n\ \032 extttnumerids.\n\ \032 path xxx\n\ \032 When no path preference is given, Unison will simply\n\ \032 synchronize the two entire replicas, beginning from the given\n\ \032 pair of roots. If one or more path preferences are given, then\n\ \032 Unison will synchronize only these paths and their children.\n\ \032 (This is useful for doing a fast sync of just one directory,\n\ \032 for example.) Note that path preferences are intepreted\n\ \032 literally--they are not regular expressions.\n\ \032 perms n\n\ \032 The integer value of this preference is a mask indicating which\n\ \032 permission bits should be synchronized. It is set by default to\n\ \032 0o1777: all bits but the set-uid and set-gid bits are\n\ \032 synchronised (synchronizing theses latter bits can be a\n\ \032 security hazard). If you want to synchronize all bits, you can\n\ \032 set the value of this preference to -1.\n\ \032 prefer xxx\n\ \032 Including the preference -prefer root causes Unison always to\n\ \032 resolve conflicts in favor of root, rather than asking for\n\ \032 guidance from the user. (The syntax of root is the same as for\n\ \032 the root preference, plus the special values newer and older.)\n\ \032 This preference is overridden by the preferpartial preference.\n\ \032 This preference should be used only if you are sure you know\n\ \032 what you are doing!\n\ \032 preferpartial xxx\n\ \032 Including the preference preferpartial PATHSPEC -> root causes\n\ \032 Unison always to resolve conflicts in favor of root, rather\n\ \032 than asking for guidance from the user, for the files in\n\ \032 PATHSPEC (see the section \"Path Specification\" for more\n\ \032 information). (The syntax of root is the same as for the root\n\ \032 preference, plus the special values newer and older.)\n\ \032 This preference should be used only if you are sure you know\n\ \032 what you are doing!\n\ \032 pretendwin \n\ \032 When set to true, this preference makes Unison use\n\ \032 Windows-style fast update detection (using file creation times\n\ \032 as \"pseudo-inode-numbers\"), even when running on a Unix system.\n\ \032 This switch should be used with care, as it is less safe than\n\ \032 the standard update detection method, but it can be useful for\n\ \032 synchronizing VFAT filesystems (which do not support inode\n\ \032 numbers) mounted on Unix systems. The fastcheck option should\n\ \032 also be set to true.\n\ \032 repeat xxx\n\ \032 Setting this preference causes the text-mode interface to\n\ \032 synchronize repeatedly, rather than doing it just once and\n\ \032 stopping. If the argument is a number, Unison will pause for\n\ \032 that many seconds before beginning again.\n\ \032 retry n\n\ \032 Setting this preference causes the text-mode interface to try\n\ \032 again to synchronize updated paths where synchronization fails.\n\ \032 Each such path will be tried N times.\n\ \032 root xxx\n\ \032 Each use of this preference names the root of one of the\n\ \032 replicas for Unison to synchronize. Exactly two roots are\n\ \032 needed, so normal modes of usage are either to give two values\n\ \032 for root in the profile, or to give no values in the profile\n\ \032 and provide two on the command line. Details of the syntax of\n\ \032 roots can be found in the section \"Roots\" .\n\ \032 The two roots can be given in either order; Unison will sort\n\ \032 them into a canonical order before doing anything else. It also\n\ \032 tries to `canonize' the machine names and paths that appear in\n\ \032 the roots, so that, if Unison is invoked later with a slightly\n\ \032 different name for the same root, it will be able to locate the\n\ \032 correct archives.\n\ \032 rootalias xxx\n\ \032 When calculating the name of the archive files for a given pair\n\ \032 of roots, Unison replaces any roots matching the left-hand side\n\ \032 of any rootalias rule by the corresponding right-hand side.\n\ \032 rshargs xxx\n\ \032 The string value of this preference will be passed as\n\ \032 additional arguments (besides the host name and the name of the\n\ \032 Unison executable on the remote system) to the rsh command used\n\ \032 to invoke the remote server.\n\ \032 rshcmd xxx\n\ \032 This preference can be used to explicitly set the name of the\n\ \032 rsh executable (e.g., giving a full path name), if necessary.\n\ \032 rsrc xxx\n\ \032 When set to true, this flag causes Unison to synchronize\n\ \032 resource forks and HFS meta-data. On filesystems that do not\n\ \032 natively support resource forks, this data is stored in\n\ \032 Carbon-compatible ._ AppleDouble files. When the flag is set to\n\ \032 false, Unison will not synchronize these data. Ordinarily, the\n\ \032 flag is set to default, and these data are automatically\n\ \032 synchronized if either host is running OSX. In rare\n\ \032 circumstances it is useful to set the flag manually.\n\ \032 rsync \n\ \032 Unison uses the 'rsync algorithm' for 'diffs-only' transfer of\n\ \032 updates to large files. Setting this flag to false makes Unison\n\ \032 use whole-file transfers instead. Under normal circumstances,\n\ \032 there is no reason to do this, but if you are having trouble\n\ \032 with repeated 'rsync failure' errors, setting it to false\n\ \032 should permit you to synchronize the offending files.\n\ \032 selftest \n\ \032 Run internal tests and exit. This option is mostly for\n\ \032 developers and must be used carefully: in particular, it will\n\ \032 delete the contents of both roots, so that it can install its\n\ \032 own files for testing. This flag only makes sense on the\n\ \032 command line. When it is provided, no preference file is read:\n\ \032 all preferences must be specified on thecommand line. Also,\n\ \032 since the self-test procedure involves overwriting the roots\n\ \032 and backup directory, the names of the roots and of the\n\ \032 backupdir preference must include the string \"test\" or else the\n\ \032 tests will be aborted. (If these are not given on the command\n\ \032 line, dummy subdirectories in the current directory will be\n\ \032 created automatically.)\n\ \032 servercmd xxx\n\ \032 This preference can be used to explicitly set the name of the\n\ \032 Unison executable on the remote server (e.g., giving a full\n\ \032 path name), if necessary.\n\ \032 showarchive \n\ \032 When this preference is set, Unison will print out the 'true\n\ \032 names'of the roots, in the same form as is expected by the\n\ \032 rootaliaspreference.\n\ \032 silent \n\ \032 When this preference is set to true, the textual user interface\n\ \032 will print nothing at all, except in the case of errors.\n\ \032 Setting silent to true automatically sets the batch preference\n\ \032 to true.\n\ \032 sortbysize \n\ \032 When this flag is set, the user interface will list changed\n\ \032 files by size (smallest first) rather than by name. This is\n\ \032 useful, for example, for synchronizing over slow links, since\n\ \032 it puts very large files at the end of the list where they will\n\ \032 not prevent smaller files from being transferred quickly.\n\ \032 This preference (as well as the other sorting flags, but not\n\ \032 the sorting preferences that require patterns as arguments) can\n\ \032 be set interactively and temporarily using the 'Sort' menu in\n\ \032 the graphical user interface.\n\ \032 sortfirst xxx\n\ \032 Each argument to sortfirst is a pattern pathspec, which\n\ \032 describes a set of paths. Files matching any of these patterns\n\ \032 will be listed first in the user interface. The syntax of\n\ \032 pathspec is described in the section \"Path Specification\" .\n\ \032 sortlast xxx\n\ \032 Similar to sortfirst, except that files matching one of these\n\ \032 patterns will be listed at the very end.\n\ \032 sortnewfirst \n\ \032 When this flag is set, the user interface will list newly\n\ \032 created files before all others. This is useful, for example,\n\ \032 for checking that newly created files are not `junk', i.e.,\n\ \032 ones that should be ignored or deleted rather than\n\ \032 synchronized.\n\ \032 sshargs xxx\n\ \032 The string value of this preference will be passed as\n\ \032 additional arguments (besides the host name and the name of the\n\ \032 Unison executable on the remote system) to the ssh command used\n\ \032 to invoke the remote server.\n\ \032 sshcmd xxx\n\ \032 This preference can be used to explicitly set the name of the\n\ \032 ssh executable (e.g., giving a full path name), if necessary.\n\ \032 sshversion xxx\n\ \032 This preference can be used to control which version of ssh\n\ \032 should be used to connect to the server. Legal values are 1 and\n\ \032 2, which will cause unison to try to use ssh1 orssh2 instead of\n\ \032 just ssh to invoke ssh. The default value is empty, which will\n\ \032 make unison use whatever version of ssh is installed as the\n\ \032 default `ssh' command.\n\ \032 terse \n\ \032 When this preference is set to true, the user interface will\n\ \032 not print status messages.\n\ \032 testserver \n\ \032 Setting this flag on the command line causes Unison to attempt\n\ \032 to connect to the remote server and, if successful, print a\n\ \032 message and immediately exit. Useful for debugging installation\n\ \032 problems. Should not be set in preference files.\n\ \032 times \n\ \032 When this flag is set to true, file modification times (but not\n\ \032 directory modtimes) are propagated.\n\ \032 ui xxx\n\ \032 This preference selects either the graphical or the textual\n\ \032 user interface. Legal values are graphic or text.\n\ \032 Because this option is processed specially during Unison's\n\ \032 start-up sequence, it can only be used on the command line. In\n\ \032 preference files it has no effect.\n\ \032 If the Unison executable was compiled with only a textual\n\ \032 interface, this option has no effect. (The pre-compiled\n\ \032 binaries are all compiled with both interfaces available.)\n\ \032 version \n\ \032 Print the current version number and exit. (This option only\n\ \032 makes sense on the command line.)\n\ \032 xferbycopying \n\ \032 When this preference is set, Unison will try to avoid\n\ \032 transferring file contents across the network by recognizing\n\ \032 when a file with the required contents already exists in the\n\ \032 target replica. This usually allows file moves to be propagated\n\ \032 very quickly. The default value istrue.\n\ \n\ Profiles\n\ \n\ \032 A profile is a text file that specifies permanent settings for roots,\n\ \032 paths, ignore patterns, and other preferences, so that they do not\n\ \032 need to be typed at the command line every time Unison is run.\n\ \032 Profiles should reside in the .unison directory on the client machine.\n\ \032 If Unison is started with just one argument name on the command line,\n\ \032 it looks for a profile called name.prf in the .unison directory. If it\n\ \032 is started with no arguments, it scans the .unison directory for files\n\ \032 whose names end in .prf and offers a menu (provided that the Unison\n\ \032 executable is compiled with the graphical user interface). If a file\n\ \032 named default.prf is found, its settings will be offered as the\n\ \032 default choices.\n\ \n\ \032 To set the value of a preference p permanently, add to the appropriate\n\ \032 profile a line of the form\n\ \032 p = true\n\ \n\ \032 for a boolean flag or\n\ \032 p = \n\ \n\ \032 for a preference of any other type.\n\ \n\ \032 Whitespaces around p and xxx are ignored. A profile may also include\n\ \032 blank lines and lines beginning with #; both are ignored.\n\ \n\ \032 When Unison starts, it first reads the profile and then the command\n\ \032 line, so command-line options will override settings from the profile.\n\ \n\ \032 Profiles may also include lines of the form include name, which will\n\ \032 cause the file name (or name.prf, if name does not exist in the\n\ \032 .unison directory) to be read at the point, and included as if its\n\ \032 contents, instead of the include line, was part of the profile.\n\ \032 Include lines allows settings common to several profiles to be stored\n\ \032 in one place.\n\ \n\ \032 A profile may include a preference `label = desc' to provide a\n\ \032 description of the options selected in this profile. The string desc\n\ \032 is listed along with the profile name in the profile selection dialog,\n\ \032 and displayed in the top-right corner of the main Unison window in the\n\ \032 graphical user interface.\n\ \n\ \032 The graphical user-interface also supports one-key shortcuts for\n\ \032 commonly used profiles. If a profile contains a preference of the form\n\ \032 `key = n', where n is a single digit, then pressing this digit key\n\ \032 will cause Unison to immediately switch to this profile and begin\n\ \032 synchronization again from scratch. In this case, all actions that\n\ \032 have been selected for a set of changes currently being displayed will\n\ \032 be discarded.\n\ \n\ Sample Profiles\n\ \n\ A Minimal Profile\n\ \n\ \032 Here is a very minimal profile file, such as might be found in\n\ \032 .unison/default.prf:\n\ \032 # Roots of the synchronization\n\ \032 root = /home/bcpierce\n\ \032 root = ssh://saul//home/bcpierce\n\ \n\ \032 # Paths to synchronize\n\ \032 path = current\n\ \032 path = common\n\ \032 path = .netscape/bookmarks.html\n\ \n\ A Basic Profile\n\ \n\ \032 Here is a more sophisticated profile, illustrating some other useful\n\ \032 features.\n\ \032 # Roots of the synchronization\n\ \032 root = /home/bcpierce\n\ \032 root = ssh://saul//home/bcpierce\n\ \n\ \032 # Paths to synchronize\n\ \032 path = current\n\ \032 path = common\n\ \032 path = .netscape/bookmarks.html\n\ \n\ \032 # Some regexps specifying names and paths to ignore\n\ \032 ignore = Name temp.*\n\ \032 ignore = Name *~\n\ \032 ignore = Name .*~\n\ \032 ignore = Path */pilot/backup/Archive_*\n\ \032 ignore = Name *.o\n\ \032 ignore = Name *.tmp\n\ \n\ \032 # Window height\n\ \032 height = 37\n\ \n\ \032 # Keep a backup copy of every file in a central location\n\ \032 backuplocation = central\n\ \032 backupdir = /home/bcpierce/backups\n\ \032 backup = Name *\n\ \032 backupprefix = $VERSION.\n\ \032 backupsuffix =\n\ \n\ \032 # Use this command for displaying diffs\n\ \032 diff = diff -y -W 79 --suppress-common-lines\n\ \n\ \032 # Log actions to the terminal\n\ \032 log = true\n\ \n\ A Power-User Profile\n\ \n\ \032 When Unison is used with large replicas, it is often convenient to be\n\ \032 able to synchronize just a part of the replicas on a given run (this\n\ \032 saves the time of detecting updates in the other parts). This can be\n\ \032 accomplished by splitting up the profile into several parts -- a\n\ \032 common part containing most of the preference settings, plus one\n\ \032 \"top-level\" file for each set of paths that need to be synchronized.\n\ \032 (The include mechanism can also be used to allow the same set of\n\ \032 preference settings to be used with different roots.)\n\ \n\ \032 The collection of profiles implementing this scheme might look as\n\ \032 follows. The file default.prf is empty except for an include\n\ \032 directive:\n\ \032 # Include the contents of the file common\n\ \032 include common\n\ \n\ \032 Note that the name of the common file is common, not common.prf; this\n\ \032 prevents Unison from offering common as one of the list of profiles in\n\ \032 the opening dialog (in the graphical UI).\n\ \n\ \032 The file common contains the real preferences:\n\ \032 # Roots of the synchronization\n\ \032 root = /home/bcpierce\n\ \032 root = ssh://saul//home/bcpierce\n\ \n\ \032 # (... other preferences ...)\n\ \n\ \032 # If any new preferences are added by Unison (e.g. 'ignore'\n\ \032 # preferences added via the graphical UI), then store them in the\n\ \032 # file 'common' rathen than in the top-level preference file\n\ \032 addprefsto = common\n\ \n\ \032 # Names and paths to ignore:\n\ \032 ignore = Name temp.*\n\ \032 ignore = Name *~\n\ \032 ignore = Name .*~\n\ \032 ignore = Path */pilot/backup/Archive_*\n\ \032 ignore = Name *.o\n\ \032 ignore = Name *.tmp\n\ \n\ \032 Note that there are no path preferences in common. This means that,\n\ \032 when we invoke Unison with the default profile (e.g., by typing\n\ \032 'unison default' or just 'unison' on the command line), the whole\n\ \032 replicas will be synchronized. (If we never want to synchronize the\n\ \032 whole replicas, then default.prf would instead include settings for\n\ \032 all the paths that are usually synchronized.)\n\ \n\ \032 To synchronize just part of the replicas, Unison is invoked with an\n\ \032 alternate preference file--e.g., doing 'unison workingset', where the\n\ \032 preference file workingset.prf contains\n\ \032 path = current/papers\n\ \032 path = Mail/inbox\n\ \032 path = Mail/drafts\n\ \032 include common\n\ \n\ \032 causes Unison to synchronize just the listed subdirectories.\n\ \n\ \032 The key preference can be used in combination with the graphical UI to\n\ \032 quickly switch between different sets of paths. For example, if the\n\ \032 file mail.prf contains\n\ \032 path = Mail\n\ \032 batch = true\n\ \032 key = 2\n\ \032 include common\n\ \n\ \032 then pressing 2 will cause Unison to look for updates in the Mail\n\ \032 subdirectory and (because the batch flag is set) immediately propagate\n\ \032 any that it finds.\n\ \n\ Keeping Backups\n\ \n\ \032 When Unison overwrites a file or directory by propagating a new\n\ \032 version from the other replica, it can keep the old version around as\n\ \032 a backup. There are several preferences that control precisely where\n\ \032 these backups are stored and how they are named.\n\ \n\ \032 To enable backups, you must give one or more backup preferences. Each\n\ \032 of these has the form\n\ \032 backup = \n\ \n\ \032 where has the same form as for the ignore preference. For\n\ \032 example,\n\ \032 backup = Name *\n\ \n\ \032 causes Unison to keep backups of all files and directories. The\n\ \032 backupnot preference can be used to give a few exceptions: it\n\ \032 specifies which files and directories should not be backed up, even if\n\ \032 they match the backup pathspec.\n\ \n\ \032 It is important to note that the pathspec is matched against the path\n\ \032 that is being updated by Unison, not its descendants. For example, if\n\ \032 you set backup = Name *.txt and then delete a whole directory named\n\ \032 foo containing some text files, these files will not be backed up\n\ \032 because Unison will just check that foo does not match *.txt.\n\ \032 Similarly, if the directory itself happened to be called foo.txt, then\n\ \032 the whole directory and all the files in it will be backed up,\n\ \032 regardless of their names.\n\ \n\ \032 Backup files can be stored either centrally or locally. This behavior\n\ \032 is controlled by the preference backuplocation, whose value must be\n\ \032 either central or local. (The default is central.)\n\ \n\ \032 When backups are stored locally, they are kept in the same directory\n\ \032 as the original.\n\ \n\ \032 When backups are stored centrally, the directory used to hold them is\n\ \032 controlled by the preference backupdir and the environment variable\n\ \032 UNISONBACKUPDIR. (The environment variable is checked first.) If\n\ \032 neither of these are set, then the directory .unison/backup in the\n\ \032 user's home directory is used.\n\ \n\ \032 The preference maxbackups controls how many previous versions of each\n\ \032 file are kept (including the current version).\n\ \n\ \032 By default, backup files are named .bak.VERSION.FILENAME, where\n\ \032 FILENAME is the original filename and VERSION is the backup number (1\n\ \032 for the most recent, 2 for the next most recent, etc.). This can be\n\ \032 changed by setting the preferences backupprefix and/or backupsuffix.\n\ \032 If desired, backupprefix may include a directory prefix; this can be\n\ \032 used with backuplocation = local to put all backup files for each\n\ \032 directory into a single subdirectory. For example, setting\n\ \032 backuplocation = local\n\ \032 backupprefix = .unison/$VERSION.\n\ \032 backupsuffix =\n\ \n\ \032 will put all backups in a local subdirectory named .unison. Also, note\n\ \032 that the string $VERSION in either backupprefix or backupsuffix (it\n\ \032 must appear in one or the other) is replaced by the version number.\n\ \032 This can be used, for example, to ensure that backup files retain the\n\ \032 same extension as the originals.\n\ \n\ \032 For backward compatibility, the backups preference is also supported.\n\ \032 It simply means backup = Name * and backuplocation = local.\n\ \n\ Merging Conflicting Versions\n\ \n\ \032 Unison can invoke external programs to merge conflicting versions of a\n\ \032 file. The preference merge controls this process.\n\ \n\ \032 The merge preference may be given once or several times in a\n\ \032 preference file (it can also be given on the command line, of course,\n\ \032 but this tends to be awkward because of the spaces and special\n\ \032 characters involved). Each instance of the preference looks like this:\n\ \032 merge = -> \n\ \n\ \032 The here has exactly the same format as for the ignore\n\ \032 preference (see the section \"Path specification\" ). For example, using\n\ \032 \"Name *.txt\" as the tells Unison that this command should\n\ \032 be used whenever a file with extension .txt needs to be merged.\n\ \n\ \032 Many external merging programs require as inputs not just the two\n\ \032 files that need to be merged, but also a file containing the last\n\ \032 synchronized version. You can ask Unison to keep a copy of the last\n\ \032 synchronized version for some files using the backupcurrent\n\ \032 preference. This preference is used in exactly the same way as backup\n\ \032 and its meaning is similar, except that it causes backups to be kept\n\ \032 of the current contents of each file after it has been synchronized by\n\ \032 Unison, rather than the previous contents that Unison overwrote. These\n\ \032 backups are kept on both replicas in the same place as ordinary backup\n\ \032 files--i.e. according to the backuplocation and backupdir preferences.\n\ \032 They are named like the original files if backupslocation is set to\n\ \032 'central' and otherwise, Unison uses the backupprefix and backupsuffix\n\ \032 preferences and assumes a version number 000 for these backups.\n\ \n\ \032 The part of the preference specifies what external command\n\ \032 should be invoked to merge files at paths matching the .\n\ \032 Within this string, several special substrings are recognized; these\n\ \032 will be substituted with appropriate values before invoking a\n\ \032 sub-shell to execute the command.\n\ \032 * CURRENT1 is replaced by the name of (a temporary copy of) the\n\ \032 local variant of the file.\n\ \032 * CURRENT2 is replaced by the name of a temporary file, into which\n\ \032 the contents of the remote variant of the file have been\n\ \032 transferred by Unison prior to performing the merge.\n\ \032 * CURRENTARCH is replaced by the name of the backed up copy of the\n\ \032 original version of the file (i.e., the file saved by Unison if\n\ \032 the current filename matches the path specifications for the\n\ \032 backupcurrent preference, as explained above), if one exists. If\n\ \032 no archive exists and CURRENTARCH appears in the merge command,\n\ \032 then an error is signalled.\n\ \032 * CURRENTARCHOPT is replaced by the name of the backed up copy of\n\ \032 the original version of the file (i.e., its state at the end of\n\ \032 the last successful run of Unison), if one exists, or the empty\n\ \032 string if no archive exists.\n\ \032 * NEW is replaced by the name of a temporary file that Unison\n\ \032 expects to be written by the merge program when it finishes,\n\ \032 giving the desired new contents of the file.\n\ \032 * PATH is replaced by the path (relative to the roots of the\n\ \032 replicas) of the file being merged.\n\ \032 * NEW1 and NEW2 are replaced by the names of temporary files that\n\ \032 Unison expects to be written by the merge program when it is only\n\ \032 able to partially merge the originals; in this case, NEW1 will be\n\ \032 written back to the local replica and NEW2 to the remote replica;\n\ \032 NEWARCH, if present, will be used as the \"last common state\" of\n\ \032 the replicas. (These three options are provided for later\n\ \032 compatibility with the Harmony data synchronizer.)\n\ \n\ \032 To accomodate the wide variety of programs that users might want to\n\ \032 use for merging, Unison checks for several possible situations when\n\ \032 the merge program exits:\n\ \032 * If the merge program exits with a non-zero status, then merge is\n\ \032 considered to have failed and the replicas are not changed.\n\ \032 * If the file NEW has been created, it is written back to both\n\ \032 replicas (and stored in the backup directory). Similarly, if just\n\ \032 the file NEW1 has been created, it is written back to both\n\ \032 replicas.\n\ \032 * If neither NEW nor NEW1 have been created, then Unison examines\n\ \032 the temporary files CURRENT1 and CURRENT2 that were given as\n\ \032 inputs to the merge program. If either has been changed (or both\n\ \032 have been changed in identical ways), then its new contents are\n\ \032 written back to both replicas. If either CURRENT1 or CURRENT2 has\n\ \032 been deleted, then the contents of the other are written back to\n\ \032 both replicas.\n\ \032 * If the files NEW1, NEW2, and NEWARCH have all been created, they\n\ \032 are written back to the local replica, remote replica, and backup\n\ \032 directory, respectively. If the files NEW1, NEW2 have been\n\ \032 created, but NEWARCH has not, then these files are written back to\n\ \032 the local replica and remote replica, respectively. Also, if NEW1\n\ \032 and NEW2 have identical contents, then the same contents are\n\ \032 stored as a backup (if the backupcurrent preference is set for\n\ \032 this path) to reflect the fact that the path is currently in sync.\n\ \032 * If NEW1 and NEW2 (resp. CURRENT1 and CURRENT2) are created (resp.\n\ \032 overwritten) with different contents but the merge command did not\n\ \032 fail (i.e., it exited with status code 0), then we copy NEW1\n\ \032 (resp. CURRENT1) to the other replica and to the archive.\n\ \032 This behavior is a design choice made to handle the case where a\n\ \032 merge command only synchronizes some specific contents between two\n\ \032 files, skipping some irrelevant information (order between\n\ \032 entries, for instance). We assume that, if the merge command exits\n\ \032 normally, then the two resulting files are \"as good as equal.\"\n\ \032 (The reason we copy one on top of the other is to avoid Unison\n\ \032 detecting that the files are unequal the next time it is run and\n\ \032 trying again to merge them when, in fact, the merge program has\n\ \032 already made them as similar as it is able to.)\n\ \n\ \032 If the confirmmerge preference is set and Unison is not run in batch\n\ \032 mode, then Unison will always ask for confirmation before actually\n\ \032 committing the results of the merge to the replicas.\n\ \n\ \032 A large number of external merging programs are available. For\n\ \032 example, on Unix systems setting the merge preference to\n\ \032 merge = Name *.txt -> diff3 -m CURRENT1 CURRENTARCH CURRENT2\n\ \032 > NEW || echo \"differences detected\"\n\ \n\ \032 will tell Unison to use the external diff3 program for merging.\n\ \032 Alternatively, users of emacs may find the following settings\n\ \032 convenient:\n\ \032 merge = Name *.txt -> emacs -q --eval '(ediff-merge-files-with-ancestor\n\ \032 \"CURRENT1\" \"CURRENT2\" \"CURRENTARCH\" nil \"NEW\")'\n\ \n\ \032 (These commands are displayed here on two lines to avoid running off\n\ \032 the edge of the page. In your preference file, each command should be\n\ \032 written on a single line.)\n\ \n\ \032 Users running emacs under windows may find something like this useful:\n\ \032 merge = Name * -> C:\\Progra~1\\Emacs\\emacs\\bin\\emacs.exe -q --eval\n\ \032 \"(ediff-files \"\"\"CURRENT1\"\"\" \"\"\"CURRENT2\"\"\")\"\n\ \n\ \032 Users running Mac OS X (you may need the Developer Tools installed to\n\ \032 get the opendiff utility) may prefer\n\ \032 merge = Name *.txt -> opendiff CURRENT1 CURRENT2 -ancestor CURRENTARCH -mer\n\ ge NEW\n\ \n\ \032 Here is a slightly more involved hack. The opendiff program can\n\ \032 operate either with or without an archive file. A merge command of\n\ \032 this form\n\ \032 merge = Name *.txt ->\n\ \032 if [ CURRENTARCHOPTx = x ];\n\ \032 then opendiff CURRENT1 CURRENT2 -merge NEW;\n\ \032 else opendiff CURRENT1 CURRENT2 -ancestor CURRENTARCHOPT -merge N\n\ EW;\n\ \032 fi\n\ \n\ \032 (still all on one line in the preference file!) will test whether an\n\ \032 archive file exists and use the appropriate variant of the arguments\n\ \032 to opendiff.\n\ \n\ \032 Ordinarily, external merge programs are only invoked when Unison is\n\ \032 not running in batch mode. To specify an external merge program that\n\ \032 should be used no matter the setting of the batch flag, use the\n\ \032 mergebatch preference instead of merge.\n\ \n\ \032 Please post suggestions for other useful values of the merge\n\ \032 preference to the unison-users mailing list--we'd like to give\n\ \032 several examples here. \n\ \n\ The User Interface\n\ \n\ \032 Both the textual and the graphical user interfaces are intended to be\n\ \032 mostly self-explanatory. Here are just a few tricks:\n\ \032 * By default, when running on Unix the textual user interface will\n\ \032 try to put the terminal into the \"raw mode\" so that it reads the\n\ \032 input a character at a time rather than a line at a time. (This\n\ \032 means you can type just the single keystroke \">\" to tell Unison to\n\ \032 propagate a file from left to right, rather than \"> Enter.\")\n\ \032 There are some situations, though, where this will not work -- for\n\ \032 example, when Unison is running in a shell window inside Emacs.\n\ \032 Setting the dumbtty preference will force Unison to leave the\n\ \032 terminal alone and process input a line at a time.\n\ \n\ Exit code\n\ \n\ \032 When running in the textual mode, Unison returns an exit status, which\n\ \032 describes whether, and at which level, the synchronization was\n\ \032 successful. The exit status could be useful when Unison is invoked\n\ \032 from a script. Currently, there are four possible values for the exit\n\ \032 status:\n\ \032 * 0: successful synchronization; everything is up-to-date now.\n\ \032 * 1: some files were skipped, but all file transfers were\n\ \032 successful.\n\ \032 * 2: non-fatal failures occurred during file transfer.\n\ \032 * 3: a fatal error occurred, or the execution was interrupted.\n\ \n\ \032 The graphical interface does not return any useful information through\n\ \032 the exit status.\n\ \n\ Path specification\n\ \n\ \032 Several Unison preferences (e.g., ignore/ignorenot, follow,\n\ \032 sortfirst/sortlast, backup, merge, etc.) specify individual paths or\n\ \032 sets of paths. These preferences share a common syntax based on\n\ \032 regular-expressions. Each preference is associated with a list of path\n\ \032 patterns; the paths specified are those that match any one of the path\n\ \032 pattern.\n\ \032 * Pattern preferences can be given on the command line, or, more\n\ \032 often, stored in profiles, using the same syntax as other\n\ \032 preferences. For example, a profile line of the form\n\ \032 ignore = pattern\n\ \032 adds pattern to the list of patterns to be ignored.\n\ \032 * Each pattern can have one of three forms. The most general form is\n\ \032 a Posix extended regular expression introduced by the keyword\n\ \032 Regex. (The collating sequences and character classes of full\n\ \032 Posix regexps are not currently supported).\n\ \032 Regex regexp\n\ \032 For convenience, two other styles of pattern are also recognized:\n\ \032 Name name\n\ \032 matches any path in which the last component matches name, while\n\ \032 Path path\n\ \032 matches exactly the path path. The name and path arguments of the\n\ \032 latter forms of patterns are not regular expressions. Instead,\n\ \032 standard \"globbing\" conventions can be used in name and path:\n\ \032 + a * matches any sequence of characters not including / (and\n\ \032 not beginning with ., when used at the beginning of a name)\n\ \032 + a ? matches any single character except / (and leading .)\n\ \032 + [xyz] matches any character from the set {x, y, z }\n\ \032 + {a,bb,ccc} matches any one of a, bb, or ccc.\n\ \032 * The path separator in path patterns is always the forward-slash\n\ \032 character \"/\" -- even when the client or server is running under\n\ \032 Windows, where the normal separator character is a backslash. This\n\ \032 makes it possible to use the same set of path patterns for both\n\ \032 Unix and Windows file systems.\n\ \n\ \032 Some examples of path patterns appear in the section \"Ignoring Paths\"\n\ \032 .\n\ \n\ Ignoring Paths\n\ \n\ \032 Most users of Unison will find that their replicas contain lots of\n\ \032 files that they don't ever want to synchronize -- temporary files,\n\ \032 very large files, old stuff, architecture-specific binaries, etc. They\n\ \032 can instruct Unison to ignore these paths using patterns introduced in\n\ \032 the section \"Path Patterns\" .\n\ \n\ \032 For example, the following pattern will make Unison ignore any path\n\ \032 containing the name CVS or a name ending in .cmo:\n\ \032 ignore = Name {CVS,*.cmo}\n\ \n\ \032 The next pattern makes Unison ignore the path a/b:\n\ \032 ignore = Path a/b\n\ \n\ \032 Path patterns do not skip filesnames beginning with . (as Name\n\ \032 patterns do). For example,\n\ \032 ignore = Path */tmp\n\ \n\ \032 will include .foo/tmp in the set of ignore directories, as it is a\n\ \032 path, not a name, that is ignored.\n\ \n\ \032 The following pattern makes Unison ignore any path beginning with a/b\n\ \032 and ending with a name ending by .ml.\n\ \032 ignore = Regex a/b/.*\\.ml\n\ \n\ \032 Note that regular expression patterns are \"anchored\": they must match\n\ \032 the whole path, not just a substring of the path.\n\ \n\ \032 Here are a few extra points regarding the ignore preference.\n\ \032 * If a directory is ignored, all its descendents will be too.\n\ \032 * The user interface provides some convenient commands for adding\n\ \032 new patterns to be ignored. To ignore a particular file, select it\n\ \032 and press \"i\". To ignore all files with the same extension, select\n\ \032 it and press \"E\" (with the shift key). To ignore all files with\n\ \032 the same name, no matter what directory they appear in, select it\n\ \032 and press \"N\". These new patterns become permanent: they are\n\ \032 immediately added to the current profile on disk.\n\ \032 * If you use the include directive to include a common collection of\n\ \032 preferences in several top-level preference files, you will\n\ \032 probably also want to set the addprefsto preference to the name of\n\ \032 this file. This will cause any new ignore patterns that you add\n\ \032 from inside Unison to be appended to this file, instead of\n\ \032 whichever top-level preference file you started Unison with.\n\ \032 * Ignore patterns can also be specified on the command line, if you\n\ \032 like (this is probably not very useful), using an option like\n\ \032 -ignore 'Name temp.txt'.\n\ \032 * Be careful about renaming directories containing ignored files.\n\ \032 Because Unison understands the rename as a delete plus a create,\n\ \032 any ignored files in the directory will be lost (since they are\n\ \032 invisible to Unison and therefore they do not get recreated in the\n\ \032 new version of the directory).\n\ \032 * There is also an ignorenot preference, which specifies a set of\n\ \032 patterns for paths that should not be ignored, even if they match\n\ \032 an ignore pattern. However, the interaction of these two sets of\n\ \032 patterns can be a little tricky. Here is exactly how it works:\n\ \032 + Unison starts detecting updates from the root of the\n\ \032 replicas--i.e., from the empty path. If the empty path\n\ \032 matches an ignore pattern and does not match an ignorenot\n\ \032 pattern, then the whole replica will be ignored. (For this\n\ \032 reason, it is not a good idea to include Name * as an ignore\n\ \032 pattern. If you want to ignore everything except a certain\n\ \032 set of files, use Name ?*.)\n\ \032 + If the root is a directory, Unison continues looking for\n\ \032 updates in all the immediate children of the root. Again, if\n\ \032 the name of some child matches an ignore pattern and does not\n\ \032 match an ignorenot pattern, then this whole path including\n\ \032 everything below it will be ignored.\n\ \032 + If any of the non-ignored children are directories, then the\n\ \032 process continues recursively.\n\ \n\ Symbolic Links\n\ \n\ \032 Ordinarily, Unison treats symbolic links in Unix replicas as \"opaque\":\n\ \032 it considers the contents of the link to be just the string specifying\n\ \032 where the link points, and it will propagate changes in this string to\n\ \032 the other replica.\n\ \n\ \032 It is sometimes useful to treat a symbolic link \"transparently,\"\n\ \032 acting as though whatever it points to were physically in the replica\n\ \032 at the point where the symbolic link appears. To tell Unison to treat\n\ \032 a link in this manner, add a line of the form\n\ \032 follow = pathspec\n\ \n\ \032 to the profile, where pathspec is a path pattern as described in the\n\ \032 section \"Path Patterns\" .\n\ \n\ \032 Windows file systems do not support symbolic links; Unison will refuse\n\ \032 to propagate an opaque symbolic link from Unix to Windows and flag the\n\ \032 path as erroneous. When a Unix replica is to be synchronized with a\n\ \032 Windows system, all symbolic links should match either an ignore\n\ \032 pattern or a follow pattern.\n\ \n\ Permissions\n\ \n\ \032 Synchronizing the permission bits of files is slightly tricky when two\n\ \032 different filesytems are involved (e.g., when synchronizing a Windows\n\ \032 client and a Unix server). In detail, here's how it works:\n\ \032 * When the permission bits of an existing file or directory are\n\ \032 changed, the values of those bits that make sense on both\n\ \032 operating systems will be propagated to the other replica. The\n\ \032 other bits will not be changed.\n\ \032 * When a newly created file is propagated to a remote replica, the\n\ \032 permission bits that make sense in both operating systems are also\n\ \032 propagated. The values of the other bits are set to default values\n\ \032 (they are taken from the current umask, if the receiving host is a\n\ \032 Unix system).\n\ \032 * For security reasons, the Unix setuid and setgid bits are not\n\ \032 propagated.\n\ \032 * The Unix owner and group ids are not propagated. (What would this\n\ \032 mean, in general?) All files are created with the owner and group\n\ \032 of the server process.\n\ \n\ Cross-Platform Synchronization\n\ \n\ \032 If you use Unison to synchronize files between Windows and Unix\n\ \032 systems, there are a few special issues to be aware of.\n\ \n\ \032 Case conflicts. In Unix, filenames are case sensitive: foo and FOO can\n\ \032 refer to different files. In Windows, on the other hand, filenames are\n\ \032 not case sensitive: foo and FOO can only refer to the same file. This\n\ \032 means that a Unix foo and FOO cannot be synchronized onto a Windows\n\ \032 system -- Windows won't allow two different files to have the \"same\"\n\ \032 name. Unison detects this situation for you, and reports that it\n\ \032 cannot synchronize the files.\n\ \n\ \032 You can deal with a case conflict in a couple of ways. If you need to\n\ \032 have both files on the Windows system, your only choice is to rename\n\ \032 one of the Unix files to avoid the case conflict, and re-synchronize.\n\ \032 If you don't need the files on the Windows system, you can simply\n\ \032 disregard Unison's warning message, and go ahead with the\n\ \032 synchronization; Unison won't touch those files. If you don't want to\n\ \032 see the warning on each synchronization, you can tell Unison to ignore\n\ \032 the files (see the section \"Ignore\" ).\n\ \n\ \032 Illegal filenames. Unix allows some filenames that are illegal in\n\ \032 Windows. For example, colons (`:') are not allowed in Windows\n\ \032 filenames, but they are legal in Unix filenames. This means that a\n\ \032 Unix file foo:bar can't be synchronized to a Windows system. As with\n\ \032 case conflicts, Unison detects this situation for you, and you have\n\ \032 the same options: you can either rename the Unix file and\n\ \032 re-synchronize, or you can ignore it.\n\ \n\ Slow Links\n\ \n\ \032 Unison is built to run well even over relatively slow links such as\n\ \032 modems and DSL connections.\n\ \n\ \032 Unison uses the \"rsync protocol\" designed by Andrew Tridgell and Paul\n\ \032 Mackerras to greatly speed up transfers of large files in which only\n\ \032 small changes have been made. More information about the rsync\n\ \032 protocol can be found at the rsync web site\n\ \032 (http://samba.anu.edu.au/rsync/).\n\ \n\ \032 If you are using Unison with ssh, you may get some speed improvement\n\ \032 by enabling ssh's compression feature. Do this by adding the option\n\ \032 \"-rshargs -C\" to the command line or \"rshargs = -C\" to your profile.\n\ \n\ Making Unison Faster on Large Files\n\ \n\ \032 Unison's built-in implementation of the rsync algorithm makes\n\ \032 transferring updates to existing files pretty fast. However, for\n\ \032 whole-file copies of newly created files, the built-in transfer method\n\ \032 is not highly optimized. Also, if Unison is interrupted in the middle\n\ \032 of transferring a large file, it will attempt to retransfer the whole\n\ \032 thing on the next run.\n\ \n\ \032 These shortcomings can be addressed with a little extra work by\n\ \032 telling Unison to use an external file copying utility for whole-file\n\ \032 transfers. The recommended one is the standalone rsync tool, which is\n\ \032 available by default on most Unix systems and can easily be installed\n\ \032 on Windows systems using Cygwin.\n\ \n\ \032 If you have rsync installed on both hosts, you can make Unison use it\n\ \032 simply by setting the copythreshold flag to something non-negative. If\n\ \032 you set it to 0, Unison will use the external copy utility for all\n\ \032 whole-file transfers. (This is probably slower than letting Unison\n\ \032 copy small files by itself, but can be useful for testing.) If you set\n\ \032 it to a larger value, Unison will use the external utility for all\n\ \032 files larger than this size (which is given in kilobytes, so setting\n\ \032 it to 1000 will cause the external tool to be used for all transfers\n\ \032 larger than a megabyte).\n\ \n\ \032 If you want to use a different external copy utility, set both the\n\ \032 copyprog and copyprogpartial preferences--the former is used for the\n\ \032 first transfer of a file, while the latter is used when Unison sees a\n\ \032 partially transferred temp file on the receiving host. Be careful\n\ \032 here: Your external tool needs to be instructed to copy files in place\n\ \032 (otherwise if the transfer is interrupted Unison will not notice that\n\ \032 some of the data has already been transferred, the next time it\n\ \032 tries). The default values are:\n\ \032 copyprog = rsync --inplace --compress\n\ \032 copyprogrest = rsync --partial --inplace --compress\n\ \n\ \032 You may also need to set the copyquoterem preference. When it is set\n\ \032 to true, this causes Unison to add an extra layer of quotes to the\n\ \032 remote path passed to the external copy program. This is is needed by\n\ \032 rsync, for example, which internally uses an ssh connection, requiring\n\ \032 an extra level of quoting for paths containing spaces. When this flag\n\ \032 is set to default, extra quotes are added if the value of copyprog\n\ \032 contains the string rsync. The default value is default, naturally.\n\ \n\ \032 If a directory transfer is interrupted, the next run of Unison will\n\ \032 automatically skip any files that were completely transferred before\n\ \032 the interruption. (This behavior is always on: it does not depend on\n\ \032 the setting of the copythreshold preference.) Note, though, that the\n\ \032 new directory will not appear in the destination filesystem until\n\ \032 everything has been transferred--partially transferred directories are\n\ \032 kept in a temporary location (with names like .unison.DIRNAME....)\n\ \032 until the transfer is complete.\n\ \n\ Fast Update Detection\n\ \n\ \032 If your replicas are large and at least one of them is on a Windows\n\ \032 system, you may find that Unison's default method for detecting\n\ \032 changes (which involves scanning the full contents of every file on\n\ \032 every sync--the only completely safe way to do it under Windows) is\n\ \032 too slow. Unison provides a preference fastcheck that, when set to\n\ \032 true, causes it to use file creation times as 'pseudo inode numbers'\n\ \032 when scanning replicas for updates, instead of reading the full\n\ \032 contents of every file.\n\ \n\ \032 When fastcheck is set to no, Unison will perform slow\n\ \032 checking--re-scanning the contents of each file on each\n\ \032 synchronization--on all replicas. When fastcheck is set to default\n\ \032 (which, naturally, is the default), Unison will use fast checks on\n\ \032 Unix replicas and slow checks on Windows replicas.\n\ \n\ \032 This strategy may cause Unison to miss propagating an update if the\n\ \032 modification time and length of the file are both unchanged by the\n\ \032 update. However, Unison will never overwrite such an update with a\n\ \032 change from the other replica, since it always does a safe check for\n\ \032 updates just before propagating a change. Thus, it is reasonable to\n\ \032 use this switch most of the time and occasionally run Unison once with\n\ \032 fastcheck set to no, if you are worried that Unison may have\n\ \032 overlooked an update.\n\ \n\ \032 Fastcheck is (always) automatically disabled for files with extension\n\ \032 .xls or .mpp, to prevent Unison from being confused by the habits of\n\ \032 certain programs (Excel, in particular) of updating files without\n\ \032 changing their modification times.\n\ \n\ Mount Points and Removable Media\n\ \n\ \032 Using Unison removable media such as USB drives can be dangerous\n\ \032 unless you are careful. If you synchronize a directory that is stored\n\ \032 on removable media when the media is not present, it will look to\n\ \032 Unison as though the whole directory has been deleted, and it will\n\ \032 proceed to delete the directory from the other replica--probably not\n\ \032 what you want!\n\ \n\ \032 To prevent accidents, Unison provides a preference called mountpoint.\n\ \032 Including a line like\n\ \032 mountpoint = foo\n\ \n\ \032 in your preference file will cause Unison to check, after it finishes\n\ \032 detecting updates, that something actually exists at the path foo on\n\ \032 both replicas; if it does not, the Unison run will abort.\n\ \n\ Click-starting Unison\n\ \n\ \032 On Windows NT/2k/XP systems, the graphical version of Unison can be\n\ \032 invoked directly by clicking on its icon. On Windows 95/98 systems,\n\ \032 click-starting also works, as long as you are not using ssh. Due to an\n\ \032 incompatibility with ocaml and Windows 95/98 that is not under our\n\ \032 control, you must start Unison from a DOS window in Windows 95/98 if\n\ \032 you want to use ssh.\n\ \n\ \032 When you click on the Unison icon, two windows will be created:\n\ \032 Unison's regular window, plus a console window, which is used only for\n\ \032 giving your password to ssh (if you do not use ssh to connect, you can\n\ \032 ignore this window). When your password is requested, you'll need to\n\ \032 activate the console window (e.g., by clicking in it) before typing.\n\ \032 If you start Unison from a DOS window, Unison's regular window will\n\ \032 appear and you will type your password in the DOS window you were\n\ \032 using.\n\ \n\ \032 To use Unison in this mode, you must first create a profile (see the\n\ \032 section \"Profile\" ). Use your favorite editor for this.\n\ \n\ ")) :: ("ssh", ("Installing Ssh", "Installing Ssh\n\ \n\ \032 Warning: These instructions may be out of date. More current\n\ \032 information can be found the Unison Wiki\n\ \032 (http://alliance.seas.upenn.edu/ bcpierce/wiki/index.php?n=Main.Unison\n\ \032 FAQOSSpecific).\n\ \n\ \032 Your local host will need just an ssh client; the remote host needs an\n\ \032 ssh server (or daemon), which is available on Unix systems. Unison is\n\ \032 known to work with ssh version 1.2.27 (Unix) and version 1.2.14\n\ \032 (Windows); other versions may or may not work.\n\ \n\ Unix\n\ \n\ \032 Most modern Unix installations come with ssh pre-installed.\n\ \n\ Windows\n\ \n\ \032 Many Windows implementations of ssh only provide graphical interfaces,\n\ \032 but Unison requires an ssh client that it can invoke with a\n\ \032 command-line interface. A suitable version of ssh can be installed as\n\ \032 follows.\n\ \032 1. Download an ssh executable.\n\ \032 Warning: there are many implementations and ports of ssh for\n\ \032 Windows, and not all of them will work with Unison. We have gotten\n\ \032 Unison to work with Cygwin's port of openssh, and we suggest you\n\ \032 try that one first. Here's how to install it:\n\ \032 a. First, create a new folder on your desktop to hold temporary\n\ \032 installation files. It can have any name you like, but in\n\ \032 these instructions we'll assume that you call it Foo.\n\ \032 b. Direct your web browser to www.cygwin.com, and click on the\n\ \032 \"Install now!\" link. This will download a file, setup.exe;\n\ \032 save it in the directory Foo. The file setup.exe is a small\n\ \032 program that will download the actual install files from the\n\ \032 Internet when you run it.\n\ \032 c. Start setup.exe (by double-clicking). This brings up a series\n\ \032 of dialogs that you will have to go through. Select \"Install\n\ \032 from Internet.\" For \"Local Package Directory\" select the\n\ \032 directory Foo. For \"Select install root directory\" we\n\ \032 recommend that you use the default, C:\\cygwin. The next\n\ \032 dialog asks you to select the way that you want to connect to\n\ \032 the network to download the installation files; we have used\n\ \032 \"Use IE5 Settings\" successfully, but you may need to make a\n\ \032 different selection depending on your networking setup. The\n\ \032 next dialog gives a list of mirrors; select one close to you.\n\ \032 Next you are asked to select which packages to install. The\n\ \032 default settings in this dialog download a lot of packages\n\ \032 that are not strictly necessary to run Unison with ssh. If\n\ \032 you don't want to install a package, click on it until \"skip\"\n\ \032 is shown. For a minimum installation, select only the\n\ \032 packages \"cygwin\" and \"openssh,\" which come to about 1900KB;\n\ \032 the full installation is much larger.\n\ \n\ \032 Note that you are plan to build unison using the free CygWin GNU C\n\ \032 compiler, you need to install essential development packages such\n\ \032 as \"gcc\", \"make\", \"fileutil\", etc; we refer to the file\n\ \032 \"INSTALL.win32-cygwin-gnuc\" in the source distribution for further\n\ \032 details. \n\ \032 After the packages are downloaded and installed, the next\n\ \032 dialog allows you to choose whether to \"Create Desktop Icon\"\n\ \032 and \"Add to Start Menu.\" You make the call.\n\ \032 d. You can now delete the directory Foo and its contents.\n\ \032 Some people have reported problems using Cygwin's ssh with Unison.\n\ \032 If you have trouble, you might try this one instead:\n\ \032 http://opensores.thebunker.net/pub/mirrors/ssh/contrib/ssh-1.2.14-win32bin.zi\n\ p\n\ \032 2. You must set the environment variables HOME and PATH. Ssh will\n\ \032 create a directory .ssh in the directory given by HOME, so that it\n\ \032 has a place to keep data like your public and private keys. PATH\n\ \032 must be set to include the Cygwin bin directory, so that Unison\n\ \032 can find the ssh executable.\n\ \032 + On Windows 95/98, add the lines\n\ \032 set PATH=%PATH%;\n\ \032 set HOME=\n\ \032 to the file C:\\AUTOEXEC.BAT, where is the directory\n\ \032 where you want ssh to create its .ssh directory, and \n\ \032 is the directory where the executable ssh.exe is stored; if\n\ \032 you've installed Cygwin in the default location, this is\n\ \032 C:\\cygwin\\bin. You will have to reboot your computer to take\n\ \032 the changes into account.\n\ \032 + On Windows NT/2k/XP, open the environment variables dialog\n\ \032 box:\n\ \032 o Windows NT: My Computer/Properties/Environment\n\ \032 o Windows 2k: My Computer/Properties/Advanced/Environment\n\ \032 variables\n\ \032 then select Path and edit its value by appending ; to\n\ \032 it, where is the full name of the directory that\n\ \032 includes the ssh executable; if you've installed Cygwin in\n\ \032 the default location, this is C:\\cygwin\\bin.\n\ \032 3. Test ssh from a DOS shell by typing\n\ \032 ssh -l \n\ \032 You should get a prompt for your password on ,\n\ \032 followed by a working connection.\n\ \032 4. Note that ssh-keygen may not work (fails with \"gethostname: no\n\ \032 such file or directory\") on some systems. This is OK: you can use\n\ \032 ssh with your regular password for the remote system.\n\ \032 5. You should now be able to use Unison with an ssh connection. If\n\ \032 you are logged in with a different user name on the local and\n\ \032 remote hosts, provide your remote user name when providing the\n\ \032 remote root (i.e., //username@host/path...).\n\ \n\ ")) :: ("news", ("Changes in Version 2.32.52", "Changes in Version 2.32.52\n\ \n\ \032 Changes since 2.32.44:\n\ \032 * Improvement to the code for resuming directory transfers: (1) make\n\ \032 sure file information (permissions, ...) has been properly set\n\ \032 when using a previously transferred temp file (2) make sure\n\ \032 previously transferred directories are writable (other changes\n\ \032 made in the developer version of Unison require a protocol change)\n\ \032 * Got rid of the 16MiB marshalling limit by marshalling to a\n\ \032 bigarray\n\ \032 * Ignore one hour differences for deciding whether a file may have\n\ \032 been updated. This avoids slow update detection after daylight\n\ \032 saving time changes under Windows. This makes it slightly more\n\ \032 likely to miss an update, but that should be safe enough.\n\ \032 * Improved Unison icon under Windows\n\ \032 * Case sensitivity information put in the archive (in a backward\n\ \032 compatible way) and checked when the archive is loaded\n\ \032 * Uses improved emulation of \"select\" call provided by Ocaml 3.11\n\ \032 under Windows (the GUI does not freeze as much during\n\ \032 synchronization)\n\ \032 * Upgraded to GPL version 3 and added copyright notice to\n\ \032 documentation files.\n\ \032 * Unison can sometimes fail to transfer a file, giving the unhelpful\n\ \032 message \"Destination updated during synchronization\" even though\n\ \032 the file has not been changed. This can be caused by programs that\n\ \032 change either the file's contents *or* the file's extended\n\ \032 attributes without changing its modification time. I'm not sure\n\ \032 what is the best fix for this - it is not Unison's fault, but it\n\ \032 makes Unison's behavior puzzling - but at least Unison can be more\n\ \032 helpful about suggesting a workaround (running once with\n\ \032 'fastcheck' set to false). The failure message has been changed to\n\ \032 give this advice.\n\ \032 * Text UI\n\ \032 + During update detection, display status by updating a single\n\ \032 line rather than generating a new line of output every so\n\ \032 often. That should be less confusing.\n\ \032 + In repeat mode, don't save the archives when there is no\n\ \032 update. Indeed, in this mode, we should minimize the amount\n\ \032 of work performed and it is unlikely that the archives have\n\ \032 changed much.\n\ \032 * Bugfixes\n\ \032 + Fixed quotation of paths and names when writing to a\n\ \032 preference file\n\ \032 + Fixed bug resulting in slow performances when transferring a\n\ \032 file using our rsync implementation from a 64-bit\n\ \032 architecture to a 32-bit architecture.\n\ \032 + Fixed bug in Lwt_unix.run which could make it fail with a\n\ \032 Not_found exception (see [Not_found raised in\n\ \032 tryCopyMovedFile] errors)\n\ \032 + Properly deals with non-conformant AppleDouble files produced\n\ \032 by Mac OS X.\n\ \032 + Fixed bug that results in Unison missing ressource fork\n\ \032 changes\n\ \032 + Applied a patch from Karl M to make the GTK2 version build\n\ \032 with OCaml 3.11 on Windows.\n\ \032 + Added some extra debugging code to remote.ml to give more\n\ \032 informative error messages when people encounter the\n\ \032 longstanding \"assert failed during file transfer\" bug.\n\ \032 + Applied patch from Antoine Reilles for NetBSD compilation\n\ \032 + Resizing the update window vertically no longer moves the\n\ \032 status label. Fix contributed by Pedro Melo.\n\ \n\ \032 Changes since 2.31:\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 + Further improvements to the OS X GUI (thanks to Alan Schmitt\n\ \032 and Craig Federighi).\n\ \032 * Very preliminary support for triggering Unison from an external\n\ \032 filesystem-watching utility. The current implementation is very\n\ \032 simple, not efficient, and almost completely untested--not ready\n\ \032 for real users. But if someone wants to help improve it (e.g., by\n\ \032 writing a filesystem watcher for your favorite OS), please make\n\ \032 yourself known!\n\ \032 On the Unison side, the new behavior is very simple:\n\ \032 + use the text UI\n\ \032 + start Unison with the command-line flag \"-repeat FOO\", where\n\ \032 FOO is name of a file where Unison should look for\n\ \032 notifications of changes\n\ \032 + when it starts up, Unison will read the whole contents of\n\ \032 this file (on both hosts), which should be a\n\ \032 newline-separated list of paths (relative to the root of the\n\ \032 synchronization) and synchronize just these paths, as if it\n\ \032 had been started with the \"-path=xxx\" option for each one of\n\ \032 them\n\ \032 + when it finishes, it will sleep for a few seconds and then\n\ \032 examine the watchfile again; if anything has been added, it\n\ \032 will read the new paths, synchronize them, and go back to\n\ \032 sleep\n\ \032 + that's it!\n\ \032 To use this to drive Unison \"incrementally,\" just start it in this\n\ \032 mode and start up a tool (on each host) to watch for new changes\n\ \032 to the filesystem and append the appropriate paths to the\n\ \032 watchfile. Hopefully such tools should not be too hard to write.\n\ \032 * Bug fixes:\n\ \032 + Fixed a bug that was causing new files to be created with\n\ \032 permissions 0x600 instead of using a reasonable default (like\n\ \032 0x644), if the 'perms' flag was set to 0. (Bug reported by\n\ \032 Ben Crowell.)\n\ \032 + Follow maxthreads preference when transferring directories.\n\ \n\ \032 Changes since 2.17:\n\ \032 * Major rewrite and cleanup of the whole Mac OS X graphical user\n\ \032 interface by Craig Federighi. Thanks, Craig!!!\n\ \032 * Small fix to ctime (non-)handling in update detection under\n\ \032 windows with fastcheck.\n\ \032 * Several small fixes to the GTK2 UI to make it work better under\n\ \032 Windows [thanks to Karl M for these].\n\ \032 * The backup functionality has been completely rewritten. The\n\ \032 external interface has not changed, but numerous bugs, irregular\n\ \032 behaviors, and cross-platform inconsistencies have been corrected.\n\ \032 * The Unison project now accepts donations via PayPal. If you'd like\n\ \032 to donate, you can find a link to the donation page on the Unison\n\ \032 home page (http://www.cis.upenn.edu/ bcpierce/unison/lists.html).\n\ \032 * Some important safety improvements:\n\ \032 + Added a new mountpoint preference, which can be used to\n\ \032 specify a path that must exist in both replicas at the end of\n\ \032 update detection (otherwise Unison aborts). This can be used\n\ \032 to avoid potentially dangerous situations when Unison is used\n\ \032 with removable media such as external hard drives and compact\n\ \032 flash cards.\n\ \032 + The confirmation of \"big deletes\" is now controlled by a\n\ \032 boolean preference confirmbigdeletes. Default is true, which\n\ \032 gives the same behavior as previously. (This functionality is\n\ \032 at least partly superceded by the mountpoint preference, but\n\ \032 it has been left in place in case it is useful to some\n\ \032 people.)\n\ \032 + If Unison is asked to \"follow\" a symbolic link but there is\n\ \032 nothing at the other end of the link, it will now flag this\n\ \032 path as an error, rather than treating the symlink itself as\n\ \032 missing or deleted. This avoids a potentially dangerous\n\ \032 situation where a followed symlink points to an external\n\ \032 filesystem that might be offline when Unison is run\n\ \032 (whereupon Unison would cheerfully delete the corresponding\n\ \032 files in the other replica!).\n\ \032 * Smaller changes:\n\ \032 + Added forcepartial and preferpartial preferences, which\n\ \032 behave like force and prefer but can be specified on a\n\ \032 per-path basis. [Thanks to Alan Schmitt for this.]\n\ \032 + A bare-bones self test feature was added, which runs unison\n\ \032 through some of its paces and checks that the results are as\n\ \032 expected. The coverage of the tests is still very limited,\n\ \032 but the facility has already been very useful in debugging\n\ \032 the new backup functionality (especially in exposing some\n\ \032 subtle cross-platform issues).\n\ \032 + Refined debugging code so that the verbosity of individual\n\ \032 modules can be controlled separately. Instead of just putting\n\ \032 '-debug verbose' on the command line, you can put '-debug\n\ \032 update+', which causes all the extra messages in the Update\n\ \032 module, but not other modules, to be printed. Putting '-debug\n\ \032 verbose' causes all modules to print with maximum verbosity.\n\ \032 + Removed mergebatch preference. (It never seemed very useful,\n\ \032 and its semantics were confusing.)\n\ \032 + Rewrote some of the merging functionality, for better\n\ \032 cooperation with external Harmony instances.\n\ \032 + Changed the temp file prefix from .# to .unison.\n\ \032 + Compressed the output from the text user interface\n\ \032 (particularly when run with the -terse flag) to make it\n\ \032 easier to interpret the results when Unison is run several\n\ \032 times in succession from a script.\n\ \032 + Diff and merge functions now work under Windows.\n\ \032 + Changed the order of arguments to the default diff command\n\ \032 (so that the + and - annotations in diff's output are\n\ \032 reversed).\n\ \032 + Added .mpp files to the \"never fastcheck\" list (like .xls\n\ \032 files).\n\ \032 * Many small bugfixes, including:\n\ \032 + Fixed a longstanding bug regarding fastcheck and daylight\n\ \032 saving time under Windows when Unison is set up to\n\ \032 synchronize modification times. (Modification times cannot be\n\ \032 updated in the archive in this case, so we have to ignore one\n\ \032 hour differences.)\n\ \032 + Fixed a bug that would occasionally cause the archives to be\n\ \032 left in non-identical states on the two hosts after\n\ \032 synchronization.\n\ \032 + Fixed a bug that prevented Unison from communicating\n\ \032 correctly between 32- and 64-bit architectures.\n\ \032 + On windows, file creation times are no longer used as a proxy\n\ \032 for inode numbers. (This is unfortunate, as it makes\n\ \032 fastcheck a little less safe. But it turns out that file\n\ \032 creation times are not reliable under Windows: if a file is\n\ \032 removed and a new file is created in its place, the new one\n\ \032 will sometimes be given the same creation date as the old\n\ \032 one!)\n\ \032 + Set read-only file to R/W on OSX before attempting to change\n\ \032 other attributes.\n\ \032 + Fixed bug resulting in spurious \"Aborted\" errors during\n\ \032 transport (thanks to Jerome Vouillon)\n\ \032 + Enable diff if file contents have changed in one replica, but\n\ \032 only properties in the other.\n\ \032 + Removed misleading documentation for 'repeat' preference.\n\ \032 + Fixed a bug in merging code where Unison could sometimes\n\ \032 deadlock with the external merge program, if the latter\n\ \032 produced large amounts of output.\n\ \032 + Workaround for a bug compiling gtk2 user interface against\n\ \032 current versions of gtk2+ libraries.\n\ \032 + Added a better error message for \"ambiguous paths\".\n\ \032 + Squashed a longstanding bug that would cause file transfer to\n\ \032 fail with the message \"Failed: Error in readWrite: Is a\n\ \032 directory.\"\n\ \032 + Replaced symlinks with copies of their targets in the Growl\n\ \032 framework in src/uimac. This should make the sources easier\n\ \032 to check out from the svn repository on WinXP systems.\n\ \032 + Added a workaround (suggested by Karl M.) for the problem\n\ \032 discussed on the unison users mailing list where, on the\n\ \032 Windows platform, the server would hang when transferring\n\ \032 files. I conjecture that the problem has to do with the RPC\n\ \032 mechanism, which was used to make a call back from the server\n\ \032 to the client (inside the Trace.log function) so that the log\n\ \032 message would be appended to the log file on the client. The\n\ \032 workaround is to dump these messages (about when\n\ \032 xferbycopying shortcuts are applied and whether they succeed)\n\ \032 just to the standard output of the Unison process, not to the\n\ \032 log file.\n\ \n\ \032 Changes since 2.13.0:\n\ \032 * The features for performing backups and for invoking external\n\ \032 merge programs have been completely rewritten by Stephane Lescuyer\n\ \032 (thanks, Stephane!). The user-visible functionality should not\n\ \032 change, but the internals have been rationalized and there are a\n\ \032 number of new features. See the manual (in particular, the\n\ \032 description of the backupXXX preferences) for details.\n\ \032 * Incorporated patches for ipv6 support, contributed by Samuel\n\ \032 Thibault. (Note that, due to a bug in the released OCaml 3.08.3\n\ \032 compiler, this code will not actually work with ipv6 unless\n\ \032 compiled with the CVS version of the OCaml compiler, where the bug\n\ \032 has been fixed; however, ipv4 should continue to work normally.)\n\ \032 * OSX interface:\n\ \032 + Incorporated Ben Willmore's cool new icon for the Mac UI.\n\ \032 * Small fixes:\n\ \032 + Fixed off by one error in month numbers (in printed dates)\n\ \032 reported by Bob Burger\n\ \n\ \032 Changes since 2.12.0:\n\ \032 * New convention for release numbering: Releases will continue to be\n\ \032 given numbers of the form X.Y.Z, but, from now on, just the major\n\ \032 version number (X.Y) will be considered significant when checking\n\ \032 compatibility between client and server versions. The third\n\ \032 component of the version number will be used only to identify\n\ \032 \"patch levels\" of releases.\n\ \032 This change goes hand in hand with a change to the procedure for\n\ \032 making new releases. Candidate releases will initially be given\n\ \032 \"beta release\" status when they are announced for public\n\ \032 consumption. Any bugs that are discovered will be fixed in a\n\ \032 separate branch of the source repository (without changing the\n\ \032 major version number) and new tarballs re-released as needed. When\n\ \032 this process converges, the patched beta version will be dubbed\n\ \032 stable.\n\ \032 * Warning (failure in batch mode) when one path is completely\n\ \032 emptied. This prevents Unison from deleting everything on one\n\ \032 replica when the other disappear.\n\ \032 * Fix diff bug (where no difference is shown the first time the diff\n\ \032 command is given).\n\ \032 * User interface changes:\n\ \032 + Improved workaround for button focus problem (GTK2 UI)\n\ \032 + Put leading zeroes in date fields\n\ \032 + More robust handling of character encodings in GTK2 UI\n\ \032 + Changed format of modification time displays, from modified\n\ \032 at hh:mm:ss on dd MMM, yyyy to modified on yyyy-mm-dd\n\ \032 hh:mm:ss\n\ \032 + Changed time display to include seconds (so that people on\n\ \032 FAT filesystems will not be confused when Unison tries to\n\ \032 update a file time to an odd number of seconds and the\n\ \032 filesystem truncates it to an even number!)\n\ \032 + Use the diff \"-u\" option by default when showing differences\n\ \032 between files (the output is more readable)\n\ \032 + In text mode, pipe the diff output to a pager if the\n\ \032 environment variable PAGER is set\n\ \032 + Bug fixes and cleanups in ssh password prompting. Now works\n\ \032 with the GTK2 UI under Linux. (Hopefully the Mac OS X one is\n\ \032 not broken!)\n\ \032 + Include profile name in the GTK2 window name\n\ \032 + Added bindings ',' (same as '<') and '.' (same as '>') in the\n\ \032 GTK2 UI\n\ \032 * Mac GUI:\n\ \032 + actions like < and > scroll to the next item as necessary.\n\ \032 + Restart has a menu item and keyboard shortcut (command-R).\n\ \032 + Added a command-line tool for Mac OS X. It can be installed\n\ \032 from the Unison menu.\n\ \032 + New icon.\n\ \032 + Handle the \"help\" command-line argument properly.\n\ \032 + Handle profiles given on the command line properly.\n\ \032 + When a profile has been selected, the profile dialog is\n\ \032 replaced by a \"connecting\" message while the connection is\n\ \032 being made. This gives better feedback.\n\ \032 + Size of left and right columns is now large enough so that\n\ \032 \"PropsChanged\" is not cut off.\n\ \032 * Minor changes:\n\ \032 + Disable multi-threading when both roots are local\n\ \032 + Improved error handling code. In particular, make sure all\n\ \032 files are closed in case of a transient failure\n\ \032 + Under Windows, use $UNISON for home directory as a last\n\ \032 resort (it was wrongly moved before $HOME and $USERPROFILE in\n\ \032 Unison 2.12.0)\n\ \032 + Reopen the logfile if its name changes (profile change)\n\ \032 + Double-check that permissions and modification times have\n\ \032 been properly set: there are some combination of OS and\n\ \032 filesystem on which setting them can fail in a silent way.\n\ \032 + Check for bad Windows filenames for pure Windows\n\ \032 synchronization also (not just cross architecture\n\ \032 synchronization). This way, filenames containing backslashes,\n\ \032 which are not correctly handled by unison, are rejected right\n\ \032 away.\n\ \032 + Attempt to resolve issues with synchronizing modification\n\ \032 times of read-only files under Windows\n\ \032 + Ignore chmod failures when deleting files\n\ \032 + Ignore trailing dots in filenames in case insensitive mode\n\ \032 + Proper quoting of paths, files and extensions ignored using\n\ \032 the UI\n\ \032 + The strings CURRENT1 and CURRENT2 are now correctly\n\ \032 substitued when they occur in the diff preference\n\ \032 + Improvements to syncing resource forks between Macs via a\n\ \032 non-Mac system.\n\ \n\ \032 Changes since 2.10.2:\n\ \032 * INCOMPATIBLE CHANGE: Archive format has changed.\n\ \032 * Source code availability: The Unison sources are now managed using\n\ \032 Subversion. One nice side-effect is that anonymous checkout is now\n\ \032 possible, like this:\n\ \032 svn co https://cvs.cis.upenn.edu:3690/svnroot/unison/\n\ \032 We will also continue to export a \"developer tarball\" of the\n\ \032 current (modulo one day) sources in the web export directory. To\n\ \032 receive commit logs for changes to the sources, subscribe to the\n\ \032 unison-hackers list\n\ \032 (http://www.cis.upenn.edu/ bcpierce/unison/lists.html).\n\ \032 * Text user interface:\n\ \032 + Substantial reworking of the internal logic of the text UI to\n\ \032 make it a bit easier to modify.\n\ \032 + The dumbtty flag in the text UI is automatically set to true\n\ \032 if the client is running on a Unix system and the EMACS\n\ \032 environment variable is set to anything other than the empty\n\ \032 string.\n\ \032 * Native OS X gui:\n\ \032 + Added a synchronize menu item with keyboard shortcut\n\ \032 + Added a merge menu item, still needs to be debugged\n\ \032 + Fixes to compile for Panther\n\ \032 + Miscellaneous improvements and bugfixes\n\ \032 * Small changes:\n\ \032 + Changed the filename checking code to apply to Windows only,\n\ \032 instead of OS X as well.\n\ \032 + Finder flags now synchronized\n\ \032 + Fallback in copy.ml for filesystem that do not support O_EXCL\n\ \032 + Changed buffer size for local file copy (was highly\n\ \032 inefficient with synchronous writes)\n\ \032 + Ignore chmod failure when deleting a directory\n\ \032 + Fixed assertion failure when resolving a conflict content\n\ \032 change / permission changes in favor of the content change.\n\ \032 + Workaround for transferring large files using rsync.\n\ \032 + Use buffered I/O for files (this is the only way to open\n\ \032 files in binary mode under Cygwin).\n\ \032 + On non-Cygwin Windows systems, the UNISON environment\n\ \032 variable is now checked first to determine where to look for\n\ \032 Unison's archive and preference files, followed by HOME and\n\ \032 USERPROFILE in that order. On Unix and Cygwin systems, HOME\n\ \032 is used.\n\ \032 + Generalized diff preference so that it can be given either as\n\ \032 just the command name to be used for calculating diffs or\n\ \032 else a whole command line, containing the strings CURRENT1\n\ \032 and CURRENT2, which will be replaced by the names of the\n\ \032 files to be diff'ed before the command is called.\n\ \032 + Recognize password prompts in some newer versions of ssh.\n\ \n\ \032 Changes since 2.9.20:\n\ \032 * INCOMPATIBLE CHANGE: Archive format has changed.\n\ \032 * Major functionality changes:\n\ \032 + Major tidying and enhancement of 'merge' functionality. The\n\ \032 main user-visible change is that the external merge program\n\ \032 may either write the merged output to a single new file, as\n\ \032 before, or it may modify one or both of its input files, or\n\ \032 it may write two new files. In the latter cases, its\n\ \032 modifications will be copied back into place on both the\n\ \032 local and the remote host, and (if the two files are now\n\ \032 equal) the archive will be updated appropriately. More\n\ \032 information can be found in the user manual. Thanks to Malo\n\ \032 Denielou and Alan Schmitt for these improvements.\n\ \032 Warning: the new merging functionality is not completely\n\ \032 compatible with old versions! Check the manual for details.\n\ \032 + Files larger than 2Gb are now supported.\n\ \032 + Added preliminary (and still somewhat experimental) support\n\ \032 for the Apple OS X operating system.\n\ \032 o Resource forks should be transferred correctly. (See the\n\ \032 manual for details of how this works when synchronizing\n\ \032 HFS with non-HFS volumes.) Synchronization of file type\n\ \032 and creator information is also supported.\n\ \032 o On OSX systems, the name of the directory for storing\n\ \032 Unison's archives, preference files, etc., is now\n\ \032 determined as follows:\n\ \032 # if ~/.unison exists, use it\n\ \032 # otherwise, use ~/Library/Application\n\ \032 Support/Unison, creating it if necessary.\n\ \032 o A preliminary native-Cocoa user interface is under\n\ \032 construction. This still needs some work, and some users\n\ \032 experience unpredictable crashes, so it is only for\n\ \032 hackers for now. Run make with UISTYLE=mac to build this\n\ \032 interface.\n\ \032 * Minor functionality changes:\n\ \032 + Added an ignorelocks preference, which forces Unison to\n\ \032 override left-over archive locks. (Setting this preference is\n\ \032 dangerous! Use it only if you are positive you know what you\n\ \032 are doing.)\n\ \032 + Added a new preference assumeContentsAreImmutable. If a\n\ \032 directory matches one of the patterns set in this preference,\n\ \032 then update detection is skipped for files in this directory.\n\ \032 (The purpose is to speed update detection for cases like Mail\n\ \032 folders, which contain lots and lots of immutable files.)\n\ \032 Also a preference assumeContentsAreImmutableNot, which\n\ \032 overrides the first, similarly to ignorenot. (Later\n\ \032 amendment: these preferences are now called immutable and\n\ \032 immutablenot.)\n\ \032 + The ignorecase flag has been changed from a boolean to a\n\ \032 three-valued preference. The default setting, called default,\n\ \032 checks the operating systems running on the client and server\n\ \032 and ignores filename case if either of them is OSX or\n\ \032 Windows. Setting ignorecase to true or false overrides this\n\ \032 behavior. If you have been setting ignorecase on the command\n\ \032 line using -ignorecase=true or -ignorecase=false, you will\n\ \032 need to change to -ignorecase true or -ignorecase false.\n\ \032 + a new preference, 'repeat', for the text user interface\n\ \032 (only). If 'repeat' is set to a number, then, after it\n\ \032 finishes synchronizing, Unison will wait for that many\n\ \032 seconds and then start over, continuing this way until it is\n\ \032 killed from outside. Setting repeat to true will\n\ \032 automatically set the batch preference to true.\n\ \032 + Excel files are now handled specially, so that the fastcheck\n\ \032 optimization is skipped even if the fastcheck flag is set.\n\ \032 (Excel does some naughty things with modtimes, making this\n\ \032 optimization unreliable and leading to failures during change\n\ \032 propagation.)\n\ \032 + The ignorecase flag has been changed from a boolean to a\n\ \032 three-valued preference. The default setting, called\n\ \032 'default', checks the operating systems running on the client\n\ \032 and server and ignores filename case if either of them is OSX\n\ \032 or Windows. Setting ignorecase to 'true' or 'false' overrides\n\ \032 this behavior.\n\ \032 + Added a new preference, 'repeat', for the text user interface\n\ \032 (only, at the moment). If 'repeat' is set to a number, then,\n\ \032 after it finishes synchronizing, Unison will wait for that\n\ \032 many seconds and then start over, continuing this way until\n\ \032 it is killed from outside. Setting repeat to true will\n\ \032 automatically set the batch preference to true.\n\ \032 + The 'rshargs' preference has been split into 'rshargs' and\n\ \032 'sshargs' (mainly to make the documentation clearer). In\n\ \032 fact, 'rshargs' is no longer mentioned in the documentation\n\ \032 at all, since pretty much everybody uses ssh now anyway.\n\ \032 * Documentation\n\ \032 + The web pages have been completely redesigned and\n\ \032 reorganized. (Thanks to Alan Schmitt for help with this.)\n\ \032 * User interface improvements\n\ \032 + Added a GTK2 user interface, capable (among other things) of\n\ \032 displaying filenames in any locale encoding. Kudos to Stephen\n\ \032 Tse for contributing this code!\n\ \032 + The text UI now prints a list of failed and skipped transfers\n\ \032 at the end of synchronization.\n\ \032 + Restarting update detection from the graphical UI will reload\n\ \032 the current profile (which in particular will reset the -path\n\ \032 preference, in case it has been narrowed by using the\n\ \032 \"Recheck unsynchronized items\" command).\n\ \032 + Several small improvements to the text user interface,\n\ \032 including a progress display.\n\ \032 * Bug fixes (too numerous to count, actually, but here are some):\n\ \032 + The maxthreads preference works now.\n\ \032 + Fixed bug where warning message about uname returning an\n\ \032 unrecognized result was preventing connection to server. (The\n\ \032 warning is no longer printed, and all systems where 'uname'\n\ \032 returns anything other than 'Darwin' are assumed not to be\n\ \032 running OS X.)\n\ \032 + Fixed a problem on OS X that caused some valid file names\n\ \032 (e.g., those including colons) to be considered invalid.\n\ \032 + Patched Path.followLink to follow links under cygwin in\n\ \032 addition to Unix (suggested by Matt Swift).\n\ \032 + Small change to the storeRootsName function, suggested by\n\ \032 bliviero at ichips.intel.com, to fix a problem in unison with\n\ \032 the `rootalias' option, which allows you to tell unison that\n\ \032 two roots contain the same files. Rootalias was being applied\n\ \032 after the hosts were sorted, so it wouldn't work properly in\n\ \032 all cases.\n\ \032 + Incorporated a fix by Dmitry Bely for setting utimes of\n\ \032 read-only files on Win32 systems.\n\ \032 * Installation / portability:\n\ \032 + Unison now compiles with OCaml version 3.07 and later out of\n\ \032 the box.\n\ \032 + Makefile.OCaml fixed to compile out of the box under OpenBSD.\n\ \032 + a few additional ports (e.g. OpenBSD, Zaurus/IPAQ) are now\n\ \032 mentioned in the documentation\n\ \032 + Unison can now be installed easily on OSX systems using the\n\ \032 Fink package manager\n\ \n\ \032 Changes since 2.9.1:\n\ \032 * Added a preference maxthreads that can be used to limit the number\n\ \032 of simultaneous file transfers.\n\ \032 * Added a backupdir preference, which controls where backup files\n\ \032 are stored.\n\ \032 * Basic support added for OSX. In particular, Unison now recognizes\n\ \032 when one of the hosts being synchronized is running OSX and\n\ \032 switches to a case-insensitive treatment of filenames (i.e., 'foo'\n\ \032 and 'FOO' are considered to be the same file). (OSX is not yet\n\ \032 fully working, however: in particular, files with resource forks\n\ \032 will not be synchronized correctly.)\n\ \032 * The same hash used to form the archive name is now also added to\n\ \032 the names of the temp files created during file transfer. The\n\ \032 reason for this is that, during update detection, we are going to\n\ \032 silently delete any old temp files that we find along the way, and\n\ \032 we want to prevent ourselves from deleting temp files belonging to\n\ \032 other instances of Unison that may be running in parallel, e.g.\n\ \032 synchronizing with a different host. Thanks to Ruslan Ermilov for\n\ \032 this suggestion.\n\ \032 * Several small user interface improvements\n\ \032 * Documentation\n\ \032 + FAQ and bug reporting instructions have been split out as\n\ \032 separate HTML pages, accessible directly from the unison web\n\ \032 page.\n\ \032 + Additions to FAQ, in particular suggestions about performance\n\ \032 tuning.\n\ \032 * Makefile\n\ \032 + Makefile.OCaml now sets UISTYLE=text or UISTYLE=gtk\n\ \032 automatically, depending on whether it finds lablgtk\n\ \032 installed\n\ \032 + Unison should now compile \"out of the box\" under OSX\n\ \n\ \032 Changes since 2.8.1:\n\ \032 * Changing profile works again under Windows\n\ \032 * File movement optimization: Unison now tries to use local copy\n\ \032 instead of transfer for moved or copied files. It is controled by\n\ \032 a boolean option \"xferbycopying\".\n\ \032 * Network statistics window (transfer rate, amount of data\n\ \032 transferred). [NB: not available in Windows-Cygwin version.]\n\ \032 * symlinks work under the cygwin version (which is dynamically\n\ \032 linked).\n\ \032 * Fixed potential deadlock when synchronizing between Windows and\n\ \032 Unix\n\ \032 * Small improvements:\n\ \032 + If neither the USERPROFILE nor the HOME environment variables\n\ \032 are set, then Unison will put its temporary commit log\n\ \032 (called DANGER.README) into the directory named by the UNISON\n\ \032 environment variable, if any; otherwise it will use C:.\n\ \032 + alternative set of values for fastcheck: yes = true; no =\n\ \032 false; default = auto.\n\ \032 + -silent implies -contactquietly\n\ \032 * Source code:\n\ \032 + Code reorganization and tidying. (Started breaking up some of\n\ \032 the basic utility modules so that the non-unison-specific\n\ \032 stuff can be made available for other projects.)\n\ \032 + several Makefile and docs changes (for release);\n\ \032 + further comments in \"update.ml\";\n\ \032 + connection information is not stored in global variables\n\ \032 anymore.\n\ \n\ \032 Changes since 2.7.78:\n\ \032 * Small bugfix to textual user interface under Unix (to avoid\n\ \032 leaving the terminal in a bad state where it would not echo inputs\n\ \032 after Unison exited).\n\ \n\ \032 Changes since 2.7.39:\n\ \032 * Improvements to the main web page (stable and beta version docs\n\ \032 are now both accessible).\n\ \032 * User manual revised.\n\ \032 * Added some new preferences:\n\ \032 + \"sshcmd\" and \"rshcmd\" for specifying paths to ssh and rsh\n\ \032 programs.\n\ \032 + \"contactquietly\" for suppressing the \"contacting server\"\n\ \032 message during Unison startup (under the graphical UI).\n\ \032 * Bug fixes:\n\ \032 + Fixed small bug in UI that neglected to change the displayed\n\ \032 column headers if loading a new profile caused the roots to\n\ \032 change.\n\ \032 + Fixed a bug that would put the text UI into an infinite loop\n\ \032 if it encountered a conflict when run in batch mode.\n\ \032 + Added some code to try to fix the display of non-Ascii\n\ \032 characters in filenames on Windows systems in the GTK UI.\n\ \032 (This code is currently untested--if you're one of the people\n\ \032 that had reported problems with display of non-ascii\n\ \032 filenames, we'd appreciate knowing if this actually fixes\n\ \032 things.)\n\ \032 + `-prefer/-force newer' works properly now. (The bug was\n\ \032 reported by Sebastian Urbaniak and Sean Fulton.)\n\ \032 * User interface and Unison behavior:\n\ \032 + Renamed `Proceed' to `Go' in the graphical UI.\n\ \032 + Added exit status for the textual user interface.\n\ \032 + Paths that are not synchronized because of conflicts or\n\ \032 errors during update detection are now noted in the log file.\n\ \032 + [END] messages in log now use a briefer format\n\ \032 + Changed the text UI startup sequence so that ./unison -ui\n\ \032 text will use the default profile instead of failing.\n\ \032 + Made some improvements to the error messages.\n\ \032 + Added some debugging messages to remote.ml.\n\ \n\ \032 Changes since 2.7.7:\n\ \032 * Incorporated, once again, a multi-threaded transport sub-system.\n\ \032 It transfers several files at the same time, thereby making much\n\ \032 more effective use of available network bandwidth. Unlike the\n\ \032 earlier attempt, this time we do not rely on the native thread\n\ \032 library of OCaml. Instead, we implement a light-weight,\n\ \032 non-preemptive multi-thread library in OCaml directly. This\n\ \032 version appears stable.\n\ \032 Some adjustments to unison are made to accommodate the\n\ \032 multi-threaded version. These include, in particular, changes to\n\ \032 the user interface and logging, for example:\n\ \032 + Two log entries for each transferring task, one for the\n\ \032 beginning, one for the end.\n\ \032 + Suppressed warning messages against removing temp files left\n\ \032 by a previous unison run, because warning does not work\n\ \032 nicely under multi-threading. The temp file names are made\n\ \032 less likely to coincide with the name of a file created by\n\ \032 the user. They take the form\n\ \032 .#..unison.tmp. [N.b. This was later\n\ \032 changed to .unison...unison.tmp.]\n\ \032 * Added a new command to the GTK user interface: pressing 'f' causes\n\ \032 Unison to start a new update detection phase, using as paths just\n\ \032 those paths that have been detected as changed and not yet marked\n\ \032 as successfully completed. Use this command to quickly restart\n\ \032 Unison on just the set of paths still needing attention after a\n\ \032 previous run.\n\ \032 * Made the ignorecase preference user-visible, and changed the\n\ \032 initialization code so that it can be manually set to true, even\n\ \032 if neither host is running Windows. (This may be useful, e.g.,\n\ \032 when using Unison running on a Unix system with a FAT volume\n\ \032 mounted.)\n\ \032 * Small improvements and bug fixes:\n\ \032 + Errors in preference files now generate fatal errors rather\n\ \032 than warnings at startup time. (I.e., you can't go on from\n\ \032 them.) Also, we fixed a bug that was preventing these\n\ \032 warnings from appearing in the text UI, so some users who\n\ \032 have been running (unsuspectingly) with garbage in their\n\ \032 prefs files may now get error reports.\n\ \032 + Error reporting for preference files now provides file name\n\ \032 and line number.\n\ \032 + More intelligible message in the case of identical change to\n\ \032 the same files: \"Nothing to do: replicas have been changed\n\ \032 only in identical ways since last sync.\"\n\ \032 + Files with prefix '.#' excluded when scanning for preference\n\ \032 files.\n\ \032 + Rsync instructions are send directly instead of first\n\ \032 marshaled.\n\ \032 + Won't try forever to get the fingerprint of a continuously\n\ \032 changing file: unison will give up after certain number of\n\ \032 retries.\n\ \032 + Other bug fixes, including the one reported by Peter Selinger\n\ \032 (force=older preference not working).\n\ \032 * Compilation:\n\ \032 + Upgraded to the new OCaml 3.04 compiler, with the LablGtk\n\ \032 1.2.3 library (patched version used for compiling under\n\ \032 Windows).\n\ \032 + Added the option to compile unison on the Windows platform\n\ \032 with Cygwin GNU C compiler. This option only supports\n\ \032 building dynamically linked unison executables.\n\ \n\ \032 Changes since 2.7.4:\n\ \032 * Fixed a silly (but debilitating) bug in the client startup\n\ \032 sequence.\n\ \n\ \032 Changes since 2.7.1:\n\ \032 * Added addprefsto preference, which (when set) controls which\n\ \032 preference file new preferences (e.g. new ignore patterns) are\n\ \032 added to.\n\ \032 * Bug fix: read the initial connection header one byte at a time, so\n\ \032 that we don't block if the header is shorter than expected. (This\n\ \032 bug did not affect normal operation -- it just made it hard to\n\ \032 tell when you were trying to use Unison incorrectly with an old\n\ \032 version of the server, since it would hang instead of giving an\n\ \032 error message.)\n\ \n\ \032 Changes since 2.6.59:\n\ \032 * Changed fastcheck from a boolean to a string preference. Its legal\n\ \032 values are yes (for a fast check), no (for a safe check), or\n\ \032 default (for a fast check--which also happens to be safe--when\n\ \032 running on Unix and a safe check when on Windows). The default is\n\ \032 default.\n\ \032 * Several preferences have been renamed for consistency. All\n\ \032 preference names are now spelled out in lowercase. For backward\n\ \032 compatibility, the old names still work, but they are not\n\ \032 mentioned in the manual any more.\n\ \032 * The temp files created by the 'diff' and 'merge' commands are now\n\ \032 named by prepending a new prefix to the file name, rather than\n\ \032 appending a suffix. This should avoid confusing diff/merge\n\ \032 programs that depend on the suffix to guess the type of the file\n\ \032 contents.\n\ \032 * We now set the keepalive option on the server socket, to make sure\n\ \032 that the server times out if the communication link is\n\ \032 unexpectedly broken.\n\ \032 * Bug fixes:\n\ \032 + When updating small files, Unison now closes the destination\n\ \032 file.\n\ \032 + File permissions are properly updated when the file is behind\n\ \032 a followed link.\n\ \032 + Several other small fixes.\n\ \n\ \032 Changes since 2.6.38:\n\ \032 * Major Windows performance improvement!\n\ \032 We've added a preference fastcheck that makes Unison look only at\n\ \032 a file's creation time and last-modified time to check whether it\n\ \032 has changed. This should result in a huge speedup when checking\n\ \032 for updates in large replicas.\n\ \032 When this switch is set, Unison will use file creation times as\n\ \032 'pseudo inode numbers' when scanning Windows replicas for updates,\n\ \032 instead of reading the full contents of every file. This may cause\n\ \032 Unison to miss propagating an update if the create time,\n\ \032 modification time, and length of the file are all unchanged by the\n\ \032 update (this is not easy to achieve, but it can be done). However,\n\ \032 Unison will never overwrite such an update with a change from the\n\ \032 other replica, since it always does a safe check for updates just\n\ \032 before propagating a change. Thus, it is reasonable to use this\n\ \032 switch most of the time and occasionally run Unison once with\n\ \032 fastcheck set to false, if you are worried that Unison may have\n\ \032 overlooked an update.\n\ \032 Warning: This change is has not yet been thoroughly field-tested.\n\ \032 If you set the fastcheck preference, pay careful attention to what\n\ \032 Unison is doing.\n\ \032 * New functionality: centralized backups and merging\n\ \032 + This version incorporates two pieces of major new\n\ \032 functionality, implemented by Sylvain Roy during a summer\n\ \032 internship at Penn: a centralized backup facility that keeps\n\ \032 a full backup of (selected files in) each replica, and a\n\ \032 merging feature that allows Unison to invoke an external\n\ \032 file-merging tool to resolve conflicting changes to\n\ \032 individual files.\n\ \032 + Centralized backups:\n\ \032 o Unison now maintains full backups of the\n\ \032 last-synchronized versions of (some of) the files in\n\ \032 each replica; these function both as backups in the\n\ \032 usual sense and as the \"common version\" when invoking\n\ \032 external merge programs.\n\ \032 o The backed up files are stored in a directory\n\ \032 /.unison/backup on each host. (The name of this\n\ \032 directory can be changed by setting the environment\n\ \032 variable UNISONBACKUPDIR.)\n\ \032 o The predicate backup controls which files are actually\n\ \032 backed up: giving the preference 'backup = Path *'\n\ \032 causes backing up of all files.\n\ \032 o Files are added to the backup directory whenever unison\n\ \032 updates its archive. This means that\n\ \032 # When unison reconstructs its archive from scratch\n\ \032 (e.g., because of an upgrade, or because the\n\ \032 archive files have been manually deleted), all\n\ \032 files will be backed up.\n\ \032 # Otherwise, each file will be backed up the first\n\ \032 time unison propagates an update for it.\n\ \032 o The preference backupversions controls how many previous\n\ \032 versions of each file are kept. The default is 2 (i.e.,\n\ \032 the last synchronized version plus one backup).\n\ \032 o For backward compatibility, the backups preference is\n\ \032 also still supported, but backup is now preferred.\n\ \032 o It is OK to manually delete files from the backup\n\ \032 directory (or to throw away the directory itself).\n\ \032 Before unison uses any of these files for anything\n\ \032 important, it checks that its fingerprint matches the\n\ \032 one that it expects.\n\ \032 + Merging:\n\ \032 o Both user interfaces offer a new 'merge' command,\n\ \032 invoked by pressing 'm' (with a changed file selected).\n\ \032 o The actual merging is performed by an external program.\n\ \032 The preferences merge and merge2 control how this\n\ \032 program is invoked. If a backup exists for this file\n\ \032 (see the backup preference), then the merge preference\n\ \032 is used for this purpose; otherwise merge2 is used. In\n\ \032 both cases, the value of the preference should be a\n\ \032 string representing the command that should be passed to\n\ \032 a shell to invoke the merge program. Within this string,\n\ \032 the special substrings CURRENT1, CURRENT2, NEW, and OLD\n\ \032 may appear at any point. Unison will substitute these as\n\ \032 follows before invoking the command:\n\ \032 # CURRENT1 is replaced by the name of the local copy\n\ \032 of the file;\n\ \032 # CURRENT2 is replaced by the name of a temporary\n\ \032 file, into which the contents of the remote copy of\n\ \032 the file have been transferred by Unison prior to\n\ \032 performing the merge;\n\ \032 # NEW is replaced by the name of a temporary file\n\ \032 that Unison expects to be written by the merge\n\ \032 program when it finishes, giving the desired new\n\ \032 contents of the file; and\n\ \032 # OLD is replaced by the name of the backed up copy\n\ \032 of the original version of the file (i.e., its\n\ \032 state at the end of the last successful run of\n\ \032 Unison), if one exists (applies only to merge, not\n\ \032 merge2).\n\ \032 For example, on Unix systems setting the merge\n\ \032 preference to\n\ \032 merge = diff3 -m CURRENT1 OLD CURRENT2 > NEW\n\ \032 will tell Unison to use the external diff3 program for\n\ \032 merging.\n\ \032 A large number of external merging programs are\n\ \032 available. For example, emacs users may find the\n\ \032 following convenient:\n\ \032 merge2 = emacs -q --eval '(ediff-merge-files \"CURRENT1\" \"CURRENT2\"\n\ \032 nil \"NEW\")'\n\ \032 merge = emacs -q --eval '(ediff-merge-files-with-ancestor\n\ \032 \"CURRENT1\" \"CURRENT2\" \"OLD\" nil \"NEW\")'\n\ \032 (These commands are displayed here on two lines to avoid\n\ \032 running off the edge of the page. In your preference\n\ \032 file, each should be written on a single line.)\n\ \032 o If the external program exits without leaving any file\n\ \032 at the path NEW, Unison considers the merge to have\n\ \032 failed. If the merge program writes a file called NEW\n\ \032 but exits with a non-zero status code, then Unison\n\ \032 considers the merge to have succeeded but to have\n\ \032 generated conflicts. In this case, it attempts to invoke\n\ \032 an external editor so that the user can resolve the\n\ \032 conflicts. The value of the editor preference controls\n\ \032 what editor is invoked by Unison. The default is emacs.\n\ \032 o Please send us suggestions for other useful values of\n\ \032 the merge2 and merge preferences - we'd like to give\n\ \032 several examples in the manual.\n\ \032 * Smaller changes:\n\ \032 + When one preference file includes another, unison no longer\n\ \032 adds the suffix '.prf' to the included file by default. If a\n\ \032 file with precisely the given name exists in the .unison\n\ \032 directory, it will be used; otherwise Unison will add .prf,\n\ \032 as it did before. (This change means that included preference\n\ \032 files can be named blah.include instead of blah.prf, so that\n\ \032 unison will not offer them in its 'choose a preference file'\n\ \032 dialog.)\n\ \032 + For Linux systems, we now offer both a statically linked and\n\ \032 a dynamically linked executable. The static one is larger,\n\ \032 but will probably run on more systems, since it doesn't\n\ \032 depend on the same versions of dynamically linked library\n\ \032 modules being available.\n\ \032 + Fixed the force and prefer preferences, which were getting\n\ \032 the propagation direction exactly backwards.\n\ \032 + Fixed a bug in the startup code that would cause unison to\n\ \032 crash when the default profile (~/.unison/default.prf) does\n\ \032 not exist.\n\ \032 + Fixed a bug where, on the run when a profile is first\n\ \032 created, Unison would confusingly display the roots in\n\ \032 reverse order in the user interface.\n\ \032 * For developers:\n\ \032 + We've added a module dependency diagram to the source\n\ \032 distribution, in src/DEPENDENCIES.ps, to help new prospective\n\ \032 developers with navigating the code.\n\ \n\ \032 Changes since 2.6.11:\n\ \032 * INCOMPATIBLE CHANGE: Archive format has changed.\n\ \032 * INCOMPATIBLE CHANGE: The startup sequence has been completely\n\ \032 rewritten and greatly simplified. The main user-visible change is\n\ \032 that the defaultpath preference has been removed. Its effect can\n\ \032 be approximated by using multiple profiles, with include\n\ \032 directives to incorporate common settings. All uses of defaultpath\n\ \032 in existing profiles should be changed to path.\n\ \032 Another change in startup behavior that will affect some users is\n\ \032 that it is no longer possible to specify roots both in the profile\n\ \032 and on the command line.\n\ \032 You can achieve a similar effect, though, by breaking your profile\n\ \032 into two:\n\ \n\ \032 default.prf =\n\ \032 root = blah\n\ \032 root = foo\n\ \032 include common\n\ \n\ \032 common.prf =\n\ \032 \n\ \032 Now do\n\ \032 unison common root1 root2\n\ \032 when you want to specify roots explicitly.\n\ \032 * The -prefer and -force options have been extended to allow users\n\ \032 to specify that files with more recent modtimes should be\n\ \032 propagated, writing either -prefer newer or -force newer. (For\n\ \032 symmetry, Unison will also accept -prefer older or -force older.)\n\ \032 The -force older/newer options can only be used when -times is\n\ \032 also set.\n\ \032 The graphical user interface provides access to these facilities\n\ \032 on a one-off basis via the Actions menu.\n\ \032 * Names of roots can now be \"aliased\" to allow replicas to be\n\ \032 relocated without changing the name of the archive file where\n\ \032 Unison stores information between runs. (This feature is for\n\ \032 experts only. See the \"Archive Files\" section of the manual for\n\ \032 more information.)\n\ \032 * Graphical user-interface:\n\ \032 + A new command is provided in the Synchronization menu for\n\ \032 switching to a new profile without restarting Unison from\n\ \032 scratch.\n\ \032 + The GUI also supports one-key shortcuts for commonly used\n\ \032 profiles. If a profile contains a preference of the form 'key\n\ \032 = n', where n is a single digit, then pressing this key will\n\ \032 cause Unison to immediately switch to this profile and begin\n\ \032 synchronization again from scratch. (Any actions that may\n\ \032 have been selected for a set of changes currently being\n\ \032 displayed will be discarded.)\n\ \032 + Each profile may include a preference 'label = '\n\ \032 giving a descriptive string that described the options\n\ \032 selected in this profile. The string is listed along with the\n\ \032 profile name in the profile selection dialog, and displayed\n\ \032 in the top-right corner of the main Unison window.\n\ \032 * Minor:\n\ \032 + Fixed a bug that would sometimes cause the 'diff' display to\n\ \032 order the files backwards relative to the main user\n\ \032 interface. (Thanks to Pascal Brisset for this fix.)\n\ \032 + On Unix systems, the graphical version of Unison will check\n\ \032 the DISPLAY variable and, if it is not set, automatically\n\ \032 fall back to the textual user interface.\n\ \032 + Synchronization paths (path preferences) are now matched\n\ \032 against the ignore preferences. So if a path is both\n\ \032 specified in a path preference and ignored, it will be\n\ \032 skipped.\n\ \032 + Numerous other bugfixes and small improvements.\n\ \n\ \032 Changes since 2.6.1:\n\ \032 * The synchronization of modification times has been disabled for\n\ \032 directories.\n\ \032 * Preference files may now include lines of the form include ,\n\ \032 which will cause name.prf to be read at that point.\n\ \032 * The synchronization of permission between Windows and Unix now\n\ \032 works properly.\n\ \032 * A binding CYGWIN=binmode in now added to the environment so that\n\ \032 the Cygwin port of OpenSSH works properly in a non-Cygwin context.\n\ \032 * The servercmd and addversionno preferences can now be used\n\ \032 together: -addversionno appends an appropriate -NNN to the server\n\ \032 command, which is found by using the value of the -servercmd\n\ \032 preference if there is one, or else just unison.\n\ \032 * Both '-pref=val' and '-pref val' are now allowed for boolean\n\ \032 values. (The former can be used to set a preference to false.)\n\ \032 * Lot of small bugs fixed.\n\ \n\ \032 Changes since 2.5.31:\n\ \032 * The log preference is now set to true by default, since the log\n\ \032 file seems useful for most users.\n\ \032 * Several miscellaneous bugfixes (most involving symlinks).\n\ \n\ \032 Changes since 2.5.25:\n\ \032 * INCOMPATIBLE CHANGE: Archive format has changed (again).\n\ \032 * Several significant bugs introduced in 2.5.25 have been fixed.\n\ \n\ \032 Changes since 2.5.1:\n\ \032 * INCOMPATIBLE CHANGE: Archive format has changed. Make sure you\n\ \032 synchronize your replicas before upgrading, to avoid spurious\n\ \032 conflicts. The first sync after upgrading will be slow.\n\ \032 * New functionality:\n\ \032 + Unison now synchronizes file modtimes, user-ids, and\n\ \032 group-ids.\n\ \032 These new features are controlled by a set of new\n\ \032 preferences, all of which are currently false by default.\n\ \032 o When the times preference is set to true, file\n\ \032 modification times are propaged. (Because the\n\ \032 representations of time may not have the same\n\ \032 granularity on both replicas, Unison may not always be\n\ \032 able to make the modtimes precisely equal, but it will\n\ \032 get them as close as the operating systems involved\n\ \032 allow.)\n\ \032 o When the owner preference is set to true, file ownership\n\ \032 information is synchronized.\n\ \032 o When the group preference is set to true, group\n\ \032 information is synchronized.\n\ \032 o When the numericIds preference is set to true, owner and\n\ \032 group information is synchronized numerically. By\n\ \032 default, owner and group numbers are converted to names\n\ \032 on each replica and these names are synchronized. (The\n\ \032 special user id 0 and the special group 0 are never\n\ \032 mapped via user/group names even if this preference is\n\ \032 not set.)\n\ \032 + Added an integer-valued preference perms that can be used to\n\ \032 control the propagation of permission bits. The value of this\n\ \032 preference is a mask indicating which permission bits should\n\ \032 be synchronized. It is set by default to 0o1777: all bits but\n\ \032 the set-uid and set-gid bits are synchronised (synchronizing\n\ \032 theses latter bits can be a security hazard). If you want to\n\ \032 synchronize all bits, you can set the value of this\n\ \032 preference to -1.\n\ \032 + Added a log preference (default false), which makes Unison\n\ \032 keep a complete record of the changes it makes to the\n\ \032 replicas. By default, this record is written to a file called\n\ \032 unison.log in the user's home directory (the value of the\n\ \032 HOME environment variable). If you want it someplace else,\n\ \032 set the logfile preference to the full pathname you want\n\ \032 Unison to use.\n\ \032 + Added an ignorenot preference that maintains a set of\n\ \032 patterns for paths that should definitely not be ignored,\n\ \032 whether or not they match an ignore pattern. (That is, a path\n\ \032 will now be ignored iff it matches an ignore pattern and does\n\ \032 not match any ignorenot patterns.)\n\ \032 * User-interface improvements:\n\ \032 + Roots are now displayed in the user interface in the same\n\ \032 order as they were given on the command line or in the\n\ \032 preferences file.\n\ \032 + When the batch preference is set, the graphical user\n\ \032 interface no longer waits for user confirmation when it\n\ \032 displays a warning message: it simply pops up an advisory\n\ \032 window with a Dismiss button at the bottom and keeps on\n\ \032 going.\n\ \032 + Added a new preference for controlling how many status\n\ \032 messages are printed during update detection: statusdepth\n\ \032 controls the maximum depth for paths on the local machine\n\ \032 (longer paths are not displayed, nor are non-directory\n\ \032 paths). The value should be an integer; default is 1.\n\ \032 + Removed the trace and silent preferences. They did not seem\n\ \032 very useful, and there were too many preferences for\n\ \032 controlling output in various ways.\n\ \032 + The text UI now displays just the default command (the one\n\ \032 that will be used if the user just types ) instead of\n\ \032 all available commands. Typing ? will print the full list of\n\ \032 possibilities.\n\ \032 + The function that finds the canonical hostname of the local\n\ \032 host (which is used, for example, in calculating the name of\n\ \032 the archive file used to remember which files have been\n\ \032 synchronized) normally uses the gethostname operating system\n\ \032 call. However, if the environment variable\n\ \032 UNISONLOCALHOSTNAME is set, its value will now be used\n\ \032 instead. This makes it easier to use Unison in situations\n\ \032 where a machine's name changes frequently (e.g., because it\n\ \032 is a laptop and gets moved around a lot).\n\ \032 + File owner and group are now displayed in the \"detail window\"\n\ \032 at the bottom of the screen, when unison is configured to\n\ \032 synchronize them.\n\ \032 * For hackers:\n\ \032 + Updated to Jacques Garrigue's new version of lablgtk, which\n\ \032 means we can throw away our local patched version.\n\ \032 If you're compiling the GTK version of unison from sources,\n\ \032 you'll need to update your copy of lablgtk to the developers\n\ \032 release. (Warning: installing lablgtk under Windows is\n\ \032 currently a bit challenging.)\n\ \032 + The TODO.txt file (in the source distribution) has been\n\ \032 cleaned up and reorganized. The list of pending tasks should\n\ \032 be much easier to make sense of, for people that may want to\n\ \032 contribute their programming energies. There is also a\n\ \032 separate file BUGS.txt for open bugs.\n\ \032 + The Tk user interface has been removed (it was not being\n\ \032 maintained and no longer compiles).\n\ \032 + The debug preference now prints quite a bit of additional\n\ \032 information that should be useful for identifying sources of\n\ \032 problems.\n\ \032 + The version number of the remote server is now checked right\n\ \032 away during the connection setup handshake, rather than\n\ \032 later. (Somebody sent a bug report of a server crash that\n\ \032 turned out to come from using inconsistent versions: better\n\ \032 to check this earlier and in a way that can't crash either\n\ \032 client or server.)\n\ \032 + Unison now runs correctly on 64-bit architectures (e.g. Alpha\n\ \032 linux). We will not be distributing binaries for these\n\ \032 architectures ourselves (at least for a while) but if someone\n\ \032 would like to make them available, we'll be glad to provide a\n\ \032 link to them.\n\ \032 * Bug fixes:\n\ \032 + Pattern matching (e.g. for ignore) is now case-insensitive\n\ \032 when Unison is in case-insensitive mode (i.e., when one of\n\ \032 the replicas is on a windows machine).\n\ \032 + Some people had trouble with mysterious failures during\n\ \032 propagation of updates, where files would be falsely reported\n\ \032 as having changed during synchronization. This should be\n\ \032 fixed.\n\ \032 + Numerous smaller fixes.\n\ \n\ \032 Changes since 2.4.1:\n\ \032 * Added a number of 'sorting modes' for the user interface. By\n\ \032 default, conflicting changes are displayed at the top, and the\n\ \032 rest of the entries are sorted in alphabetical order. This\n\ \032 behavior can be changed in the following ways:\n\ \032 + Setting the sortnewfirst preference to true causes newly\n\ \032 created files to be displayed before changed files.\n\ \032 + Setting sortbysize causes files to be displayed in increasing\n\ \032 order of size.\n\ \032 + Giving the preference sortfirst= (where is\n\ \032 a path descriptor in the same format as 'ignore' and 'follow'\n\ \032 patterns, causes paths matching this pattern to be displayed\n\ \032 first.\n\ \032 + Similarly, giving the preference sortlast= causes\n\ \032 paths matching this pattern to be displayed last.\n\ \032 The sorting preferences are described in more detail in the user\n\ \032 manual. The sortnewfirst and sortbysize flags can also be accessed\n\ \032 from the 'Sort' menu in the grpahical user interface.\n\ \032 * Added two new preferences that can be used to change unison's\n\ \032 fundamental behavior to make it more like a mirroring tool instead\n\ \032 of a synchronizer.\n\ \032 + Giving the preference prefer with argument (by adding\n\ \032 -prefer to the command line or prefer=) to your\n\ \032 profile) means that, if there is a conflict, the contents of\n\ \032 should be propagated to the other replica (with no\n\ \032 questions asked). Non-conflicting changes are treated as\n\ \032 usual.\n\ \032 + Giving the preference force with argument will make\n\ \032 unison resolve all differences in favor of the given root,\n\ \032 even if it was the other replica that was changed.\n\ \032 These options should be used with care! (More information is\n\ \032 available in the manual.)\n\ \032 * Small changes:\n\ \032 + Changed default answer to 'Yes' in all two-button dialogs in\n\ \032 the graphical interface (this seems more intuitive).\n\ \032 + The rsync preference has been removed (it was used to\n\ \032 activate rsync compression for file transfers, but rsync\n\ \032 compression is now enabled by default).\n\ \032 + In the text user interface, the arrows indicating which\n\ \032 direction changes are being propagated are printed\n\ \032 differently when the user has overridded Unison's default\n\ \032 recommendation (====> instead of ---->). This matches the\n\ \032 behavior of the graphical interface, which displays such\n\ \032 arrows in a different color.\n\ \032 + Carriage returns (Control-M's) are ignored at the ends of\n\ \032 lines in profiles, for Windows compatibility.\n\ \032 + All preferences are now fully documented in the user manual.\n\ \n\ \032 Changes since 2.3.12:\n\ \032 * INCOMPATIBLE CHANGE: Archive format has changed. Make sure you\n\ \032 synchronize your replicas before upgrading, to avoid spurious\n\ \032 conflicts. The first sync after upgrading will be slow.\n\ \032 * New/improved functionality:\n\ \032 + A new preference -sortbysize controls the order in which\n\ \032 changes are displayed to the user: when it is set to true,\n\ \032 the smallest changed files are displayed first. (The default\n\ \032 setting is false.)\n\ \032 + A new preference -sortnewfirst causes newly created files to\n\ \032 be listed before other updates in the user interface.\n\ \032 + We now allow the ssh protocol to specify a port.\n\ \032 + Incompatible change: The unison: protocol is deprecated, and\n\ \032 we added file: and socket:. You may have to modify your\n\ \032 profiles in the .unison directory. If a replica is specified\n\ \032 without an explicit protocol, we now assume it refers to a\n\ \032 file. (Previously \"//saul/foo\" meant to use SSH to connect to\n\ \032 saul, then access the foo directory. Now it means to access\n\ \032 saul via a remote file mechanism such as samba; the old\n\ \032 effect is now achieved by writing ssh://saul/foo.)\n\ \032 + Changed the startup sequence for the case where roots are\n\ \032 given but no profile is given on the command line. The new\n\ \032 behavior is to use the default profile (creating it if it\n\ \032 does not exist), and temporarily override its roots. The\n\ \032 manual claimed that this case would work by reading no\n\ \032 profile at all, but AFAIK this was never true.\n\ \032 + In all user interfaces, files with conflicts are always\n\ \032 listed first\n\ \032 + A new preference 'sshversion' can be used to control which\n\ \032 version of ssh should be used to connect to the server. Legal\n\ \032 values are 1 and 2. (Default is empty, which will make unison\n\ \032 use whatever version of ssh is installed as the default 'ssh'\n\ \032 command.)\n\ \032 + The situation when the permissions of a file was updated the\n\ \032 same on both side is now handled correctly (we used to report\n\ \032 a spurious conflict)\n\ \032 * Improvements for the Windows version:\n\ \032 + The fact that filenames are treated case-insensitively under\n\ \032 Windows should now be handled correctly. The exact behavior\n\ \032 is described in the cross-platform section of the manual.\n\ \032 + It should be possible to synchronize with Windows shares,\n\ \032 e.g., //host/drive/path.\n\ \032 + Workarounds to the bug in syncing root directories in\n\ \032 Windows. The most difficult thing to fix is an ocaml bug:\n\ \032 Unix.opendir fails on c: in some versions of Windows.\n\ \032 * Improvements to the GTK user interface (the Tk interface is no\n\ \032 longer being maintained):\n\ \032 + The UI now displays actions differently (in blue) when they\n\ \032 have been explicitly changed by the user from Unison's\n\ \032 default recommendation.\n\ \032 + More colorful appearance.\n\ \032 + The initial profile selection window works better.\n\ \032 + If any transfers failed, a message to this effect is\n\ \032 displayed along with 'Synchronization complete' at the end of\n\ \032 the transfer phase (in case they may have scrolled off the\n\ \032 top).\n\ \032 + Added a global progress meter, displaying the percentage of\n\ \032 total bytes that have been transferred so far.\n\ \032 * Improvements to the text user interface:\n\ \032 + The file details will be displayed automatically when a\n\ \032 conflict is been detected.\n\ \032 + when a warning is generated (e.g. for a temporary file left\n\ \032 over from a previous run of unison) Unison will no longer\n\ \032 wait for a response if it is running in -batch mode.\n\ \032 + The UI now displays a short list of possible inputs each time\n\ \032 it waits for user interaction.\n\ \032 + The UI now quits immediately (rather than looping back and\n\ \032 starting the interaction again) if the user presses 'q' when\n\ \032 asked whether to propagate changes.\n\ \032 + Pressing 'g' in the text user interface will proceed\n\ \032 immediately with propagating updates, without asking any more\n\ \032 questions.\n\ \032 * Documentation and installation changes:\n\ \032 + The manual now includes a FAQ, plus sections on common\n\ \032 problems and on tricks contributed by users.\n\ \032 + Both the download page and the download directory explicitly\n\ \032 say what are the current stable and beta-test version\n\ \032 numbers.\n\ \032 + The OCaml sources for the up-to-the-minute developers'\n\ \032 version (not guaranteed to be stable, or even to compile, at\n\ \032 any given time!) are now available from the download page.\n\ \032 + Added a subsection to the manual describing cross-platform\n\ \032 issues (case conflicts, illegal filenames)\n\ \032 * Many small bug fixes and random improvements.\n\ \n\ \032 Changes since 2.3.1:\n\ \032 * Several bug fixes. The most important is a bug in the rsync module\n\ \032 that would occasionally cause change propagation to fail with a\n\ \032 'rename' error.\n\ \n\ \032 Changes since 2.2:\n\ \032 * The multi-threaded transport system is now disabled by default.\n\ \032 (It is not stable enough yet.)\n\ \032 * Various bug fixes.\n\ \032 * A new experimental feature:\n\ \032 The final component of a -path argument may now be the wildcard\n\ \032 specifier *. When Unison sees such a path, it expands this path on\n\ \032 the client into into the corresponding list of paths by listing\n\ \032 the contents of that directory.\n\ \032 Note that if you use wildcard paths from the command line, you\n\ \032 will probably need to use quotes or a backslash to prevent the *\n\ \032 from being interpreted by your shell.\n\ \032 If both roots are local, the contents of the first one will be\n\ \032 used for expanding wildcard paths. (Nb: this is the first one\n\ \032 after the canonization step - i.e., the one that is listed first\n\ \032 in the user interface - not the one listed first on the command\n\ \032 line or in the preferences file.)\n\ \n\ \032 Changes since 2.1:\n\ \032 * The transport subsystem now includes an implementation by Sylvain\n\ \032 Gommier and Norman Ramsey of Tridgell and Mackerras's rsync\n\ \032 protocol. This protocol achieves much faster transfers when only a\n\ \032 small part of a large file has been changed by sending just diffs.\n\ \032 This feature is mainly helpful for transfers over slow links--on\n\ \032 fast local area networks it can actually degrade performance--so\n\ \032 we have left it off by default. Start unison with the -rsync\n\ \032 option (or put rsync=true in your preferences file) to turn it on.\n\ \032 * \"Progress bars\" are now diplayed during remote file transfers,\n\ \032 showing what percentage of each file has been transferred so far.\n\ \032 * The version numbering scheme has changed. New releases will now be\n\ \032 have numbers like 2.2.30, where the second component is\n\ \032 incremented on every significant public release and the third\n\ \032 component is the \"patch level.\"\n\ \032 * Miscellaneous improvements to the GTK-based user interface.\n\ \032 * The manual is now available in PDF format.\n\ \032 * We are experimenting with using a multi-threaded transport\n\ \032 subsystem to transfer several files at the same time, making much\n\ \032 more effective use of available network bandwidth. This feature is\n\ \032 not completely stable yet, so by default it is disabled in the\n\ \032 release version of Unison.\n\ \032 If you want to play with the multi-threaded version, you'll need\n\ \032 to recompile Unison from sources (as described in the\n\ \032 documentation), setting the THREADS flag in Makefile.OCaml to\n\ \032 true. Make sure that your OCaml compiler has been installed with\n\ \032 the -with-pthreads configuration option. (You can verify this by\n\ \032 checking whether the file threads/threads.cma in the OCaml\n\ \032 standard library directory contains the string -lpthread near the\n\ \032 end.)\n\ \n\ \032 Changes since 1.292:\n\ \032 * Reduced memory footprint (this is especially important during the\n\ \032 first run of unison, where it has to gather information about all\n\ \032 the files in both repositories).\n\ \032 * Fixed a bug that would cause the socket server under NT to fail\n\ \032 after the client exits.\n\ \032 * Added a SHIFT modifier to the Ignore menu shortcut keys in GTK\n\ \032 interface (to avoid hitting them accidentally).\n\ \n\ \032 Changes since 1.231:\n\ \032 * Tunneling over ssh is now supported in the Windows version. See\n\ \032 the installation section of the manual for detailed instructions.\n\ \032 * The transport subsystem now includes an implementation of the\n\ \032 rsync protocol, built by Sylvain Gommier and Norman Ramsey. This\n\ \032 protocol achieves much faster transfers when only a small part of\n\ \032 a large file has been changed by sending just diffs. The rsync\n\ \032 feature is off by default in the current version. Use the -rsync\n\ \032 switch to turn it on. (Nb. We still have a lot of tuning to do:\n\ \032 you may not notice much speedup yet.)\n\ \032 * We're experimenting with a multi-threaded transport subsystem,\n\ \032 written by Jerome Vouillon. The downloadable binaries are still\n\ \032 single-threaded: if you want to try the multi-threaded version,\n\ \032 you'll need to recompile from sources. (Say make THREADS=true.)\n\ \032 Native thread support from the compiler is required. Use the\n\ \032 option -threads N to select the maximal number of concurrent\n\ \032 threads (default is 5). Multi-threaded and single-threaded\n\ \032 clients/servers can interoperate.\n\ \032 * A new GTK-based user interface is now available, thanks to Jacques\n\ \032 Garrigue. The Tk user interface still works, but we'll be shifting\n\ \032 development effort to the GTK interface from now on.\n\ \032 * OCaml 3.00 is now required for compiling Unison from sources. The\n\ \032 modules uitk and myfileselect have been changed to use labltk\n\ \032 instead of camltk. To compile the Tk interface in Windows, you\n\ \032 must have ocaml-3.00 and tk8.3. When installing tk8.3, put it in\n\ \032 c:\\Tcl rather than the suggested c:\\Program Files\\Tcl, and be sure\n\ \032 to install the headers and libraries (which are not installed by\n\ \032 default).\n\ \032 * Added a new -addversionno switch, which causes unison to use\n\ \032 unison- instead of just unison as the remote\n\ \032 server command. This allows multiple versions of unison to coexist\n\ \032 conveniently on the same server: whichever version is run on the\n\ \032 client, the same version will be selected on the server.\n\ \n\ \032 Changes since 1.219:\n\ \032 * INCOMPATIBLE CHANGE: Archive format has changed. Make sure you\n\ \032 synchronize your replicas before upgrading, to avoid spurious\n\ \032 conflicts. The first sync after upgrading will be slow.\n\ \032 * This version fixes several annoying bugs, including:\n\ \032 + Some cases where propagation of file permissions was not\n\ \032 working.\n\ \032 + umask is now ignored when creating directories\n\ \032 + directories are create writable, so that a read-only\n\ \032 directory and its contents can be propagated.\n\ \032 + Handling of warnings generated by the server.\n\ \032 + Synchronizing a path whose parent is not a directory on both\n\ \032 sides is now flagged as erroneous.\n\ \032 + Fixed some bugs related to symnbolic links and nonexistant\n\ \032 roots.\n\ \032 o When a change (deletion or new contents) is propagated\n\ \032 onto a 'follow'ed symlink, the file pointed to by the\n\ \032 link is now changed. (We used to change the link itself,\n\ \032 which doesn't fit our assertion that 'follow' means the\n\ \032 link is completely invisible)\n\ \032 o When one root did not exist, propagating the other root\n\ \032 on top of it used to fail, becuase unison could not\n\ \032 calculate the working directory into which to write\n\ \032 changes. This should be fixed.\n\ \032 * A human-readable timestamp has been added to Unison's archive\n\ \032 files.\n\ \032 * The semantics of Path and Name regular expressions now correspond\n\ \032 better.\n\ \032 * Some minor improvements to the text UI (e.g. a command for going\n\ \032 back to previous items)\n\ \032 * The organization of the export directory has changed -- should be\n\ \032 easier to find / download things now.\n\ \n\ \032 Changes since 1.200:\n\ \032 * INCOMPATIBLE CHANGE: Archive format has changed. Make sure you\n\ \032 synchronize your replicas before upgrading, to avoid spurious\n\ \032 conflicts. The first sync after upgrading will be slow.\n\ \032 * This version has not been tested extensively on Windows.\n\ \032 * Major internal changes designed to make unison safer to run at the\n\ \032 same time as the replicas are being changed by the user.\n\ \032 * Internal performance improvements.\n\ \n\ \032 Changes since 1.190:\n\ \032 * INCOMPATIBLE CHANGE: Archive format has changed. Make sure you\n\ \032 synchronize your replicas before upgrading, to avoid spurious\n\ \032 conflicts. The first sync after upgrading will be slow.\n\ \032 * A number of internal functions have been changed to reduce the\n\ \032 amount of memory allocation, especially during the first\n\ \032 synchronization. This should help power users with very big\n\ \032 replicas.\n\ \032 * Reimplementation of low-level remote procedure call stuff, in\n\ \032 preparation for adding rsync-like smart file transfer in a later\n\ \032 release.\n\ \032 * Miscellaneous bug fixes.\n\ \n\ \032 Changes since 1.180:\n\ \032 * INCOMPATIBLE CHANGE: Archive format has changed. Make sure you\n\ \032 synchronize your replicas before upgrading, to avoid spurious\n\ \032 conflicts. The first sync after upgrading will be slow.\n\ \032 * Fixed some small bugs in the interpretation of ignore patterns.\n\ \032 * Fixed some problems that were preventing the Windows version from\n\ \032 working correctly when click-started.\n\ \032 * Fixes to treatment of file permissions under Windows, which were\n\ \032 causing spurious reports of different permissions when\n\ \032 synchronizing between windows and unix systems.\n\ \032 * Fixed one more non-tail-recursive list processing function, which\n\ \032 was causing stack overflows when synchronizing very large\n\ \032 replicas.\n\ \n\ \032 Changes since 1.169:\n\ \032 * The text user interface now provides commands for ignoring files.\n\ \032 * We found and fixed some more non-tail-recursive list processing\n\ \032 functions. Some power users have reported success with very large\n\ \032 replicas.\n\ \032 * INCOMPATIBLE CHANGE: Files ending in .tmp are no longer ignored\n\ \032 automatically. If you want to ignore such files, put an\n\ \032 appropriate ignore pattern in your profile.\n\ \032 * INCOMPATIBLE CHANGE: The syntax of ignore and follow patterns has\n\ \032 changed. Instead of putting a line of the form\n\ \032 ignore = \n\ \032 in your profile (.unison/default.prf), you should put:\n\ \032 ignore = Regexp \n\ \032 Moreover, two other styles of pattern are also recognized:\n\ \032 ignore = Name \n\ \032 matches any path in which one component matches , while\n\ \032 ignore = Path \n\ \032 matches exactly the path .\n\ \032 Standard \"globbing\" conventions can be used in and :\n\ \032 + a ? matches any single character except /\n\ \032 + a * matches any sequence of characters not including /\n\ \032 + [xyz] matches any character from the set {x, y, z }\n\ \032 + {a,bb,ccc} matches any one of a, bb, or ccc.\n\ \032 See the user manual for some examples.\n\ \n\ \032 Changes since 1.146:\n\ \032 * Some users were reporting stack overflows when synchronizing huge\n\ \032 directories. We found and fixed some non-tail-recursive list\n\ \032 processing functions, which we hope will solve the problem. Please\n\ \032 give it a try and let us know.\n\ \032 * Major additions to the documentation.\n\ \n\ \032 Changes since 1.142:\n\ \032 * Major internal tidying and many small bugfixes.\n\ \032 * Major additions to the user manual.\n\ \032 * Unison can now be started with no arguments - it will prompt\n\ \032 automatically for the name of a profile file containing the roots\n\ \032 to be synchronized. This makes it possible to start the graphical\n\ \032 UI from a desktop icon.\n\ \032 * Fixed a small bug where the text UI on NT was raising a 'no such\n\ \032 signal' exception.\n\ \n\ \032 Changes since 1.139:\n\ \032 * The precompiled windows binary in the last release was compiled\n\ \032 with an old OCaml compiler, causing propagation of permissions not\n\ \032 to work (and perhaps leading to some other strange behaviors we've\n\ \032 heard reports about). This has been corrected. If you're using\n\ \032 precompiled binaries on Windows, please upgrade.\n\ \032 * Added a -debug command line flag, which controls debugging of\n\ \032 various modules. Say -debug XXX to enable debug tracing for module\n\ \032 XXX, or -debug all to turn on absolutely everything.\n\ \032 * Fixed a small bug where the text UI on NT was raising a 'no such\n\ \032 signal' exception.\n\ \n\ \032 Changes since 1.111:\n\ \032 * INCOMPATIBLE CHANGE: The names and formats of the preference files\n\ \032 in the .unison directory have changed. In particular:\n\ \032 + the file \"prefs\" should be renamed to default.prf\n\ \032 + the contents of the file \"ignore\" should be merged into\n\ \032 default.prf. Each line of the form REGEXP in ignore should\n\ \032 become a line of the form ignore = REGEXP in default.prf.\n\ \032 * Unison now handles permission bits and symbolic links. See the\n\ \032 manual for details.\n\ \032 * You can now have different preference files in your .unison\n\ \032 directory. If you start unison like this\n\ \032 unison profilename\n\ \032 (i.e. with just one \"anonymous\" command-line argument), then the\n\ \032 file ~/.unison/profilename.prf will be loaded instead of\n\ \032 default.prf.\n\ \032 * Some improvements to terminal handling in the text user interface\n\ \032 * Added a switch -killServer that terminates the remote server\n\ \032 process when the unison client is shutting down, even when using\n\ \032 sockets for communication. (By default, a remote server created\n\ \032 using ssh/rsh is terminated automatically, while a socket server\n\ \032 is left running.)\n\ \032 * When started in 'socket server' mode, unison prints 'server\n\ \032 started' on stderr when it is ready to accept connections. (This\n\ \032 may be useful for scripts that want to tell when a socket-mode\n\ \032 server has finished initalization.)\n\ \032 * We now make a nightly mirror of our current internal development\n\ \032 tree, in case anyone wants an up-to-the-minute version to hack\n\ \032 around with.\n\ \032 * Added a file CONTRIB with some suggestions for how to help us make\n\ \032 Unison better.\n\ \n\ ")) :: ("", ("Junk", "Junk\n\ \032 _________________________________________________________________\n\ \n\ \032 This document was translated from L^AT[E]X by [2]H^EV^EA.\n\ \n\ References\n\ \n\ \032 1. file://localhost/Users/bcpierce/current/unison/branches/2.32/doc/temp.html#ssh-win\n\ \032 2. http://pauillac.inria.fr/~maranget/hevea/index.html\n\ ")) :: [];; unison-2.32.52/strings.mli0000644000076500000000000000024611176730177015042 0ustar bcpiercewheel(* Unison file synchronizer: src/strings.mli *) (* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) val docs : (string * (string * string)) list unison-2.32.52/terminal.ml0000644000076500000000000002424511176730177015020 0ustar bcpiercewheel(* Parsing messages from OpenSSH *) (* Examples. "tjim@saul.cis.upenn.edu's password: " (to stdout) "Permission denied, please try again." (to stderr ...) "tjim@saul.cis.upenn.edu's password: " (... to stdout) "Permission denied (publickey,gssapi,password,hostbased)." (to stderr) "The authenticity of host 'saul.cis.upenn.edu (158.130.12.4)' can't be established. RSA key fingerprint is d1:d8:5e:08:8c:ae:56:15:66:af:4b:55:53:2a:bc:38. Are you sure you want to continue connecting (yes/no)? " (to stdout) "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @ WARNING: REMOTE HOST IDENTIFICATION HAS CHANGED! @ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ IT IS POSSIBLE THAT SOMEONE IS DOING SOMETHING NASTY! Someone could be eavesdropping on you right now (man-in-the-middle attack)! It is also possible that the RSA host key has just been changed. The fingerprint for the RSA key sent by the remote host is d1:d8:5e:08:8c:ae:56:15:66:af:4b:55:53:2a:bc:38. Please contact your system administrator. Add correct host key in /Users/trevor/.ssh/known_hosts to get rid of this message. Offending key in /Users/trevor/.ssh/known_hosts:22 RSA host key for saul.cis.upenn.edu has changed and you have requested strict checking. Host key verification failed." (to stderr) *) let passwordRx = Rx.rx ".*assword:[ ]*" let passphraseRx = Rx.rx "Enter passphrase for key.*" let authenticityRx = Rx.rx "The authenticity of host .* continue connecting \\(yes/no\\)\\? " let password s = Rx.match_string passwordRx s let passphrase s = Rx.match_string passphraseRx s let authenticity s = Rx.match_string authenticityRx s (* Create a new process with a new controlling terminal, useful for SSH password interaction. *) (* let a1 = [|'p';'q';'r';'s';'t';'u';'v';'w';'x';'y';'z';'P';'Q';'R';'S';'T'|] let a2 = [|'0';'1';'2';'3';'4';'5';'6';'7';'8';'9';'a';'b';'c';'d';'e';'f'|] exception Break of (Unix.file_descr * string) option let ptyMasterOpen () = if not(Osx.isMacOSX or Osx.isLinux) then None else try (* Adapted from Stevens' Advanced Programming in Unix *) let x = "/dev/pty--" in for i = 0 to Array.length a1 do x.[8] <- a1.(i); for j = 0 to Array.length a2 do x.[9] <- a2.(j); let fdOpt = try Some(Unix.openfile x [Unix.O_RDWR] 0) with _ -> None in match fdOpt with None -> () | Some fdMaster -> x.[5] <- 't'; raise (Break(Some(fdMaster,x))) done done; None with Break z -> z let ptySlaveOpen = function None -> None | Some(fdMaster,ttySlave) -> let slave = try Some (Unix.openfile ttySlave [Unix.O_RDWR] 0o600) with _ -> None in (try Unix.close fdMaster with Unix.Unix_error(_,_,_) -> ()); slave let printTermAttrs fd = (* for debugging *) let tio = Unix.tcgetattr fd in let boolPrint name x d = if x then Printf.printf "%s is ON (%s)\n" name d else Printf.printf "%s is OFF (%s)\n" name d in let intPrint name x d = Printf.printf "%s = %d (%s)\n" name x d in let charPrint name x d = Printf.printf "%s = '%c' (%s)\n" name x d in boolPrint "c_ignbrk" tio.Unix.c_ignbrk "Ignore the break condition."; boolPrint "c_brkint" tio.Unix.c_brkint "Signal interrupt on break condition."; boolPrint "c_ignpar" tio.Unix.c_ignpar "Ignore characters with parity errors."; boolPrint "c_parmrk" tio.Unix.c_parmrk "Mark parity errors."; boolPrint "c_inpck" tio.Unix.c_inpck "Enable parity check on input."; boolPrint "c_istrip" tio.Unix.c_istrip "Strip 8th bit on input characters."; boolPrint "c_inlcr" tio.Unix.c_inlcr "Map NL to CR on input."; boolPrint "c_igncr" tio.Unix.c_igncr "Ignore CR on input."; boolPrint "c_icrnl" tio.Unix.c_icrnl "Map CR to NL on input."; boolPrint "c_ixon" tio.Unix.c_ixon "Recognize XON/XOFF characters on input."; boolPrint "c_ixoff" tio.Unix.c_ixoff "Emit XON/XOFF chars to control input flow."; boolPrint "c_opost" tio.Unix.c_opost "Enable output processing."; intPrint "c_obaud" tio.Unix.c_obaud "Output baud rate (0 means close connection)."; intPrint "c_ibaud" tio.Unix.c_ibaud "Input baud rate."; intPrint "c_csize" tio.Unix.c_csize "Number of bits per character (5-8)."; intPrint "c_cstopb" tio.Unix.c_cstopb "Number of stop bits (1-2)."; boolPrint "c_cread" tio.Unix.c_cread "Reception is enabled."; boolPrint "c_parenb" tio.Unix.c_parenb "Enable parity generation and detection."; boolPrint "c_parodd" tio.Unix.c_parodd "Specify odd parity instead of even."; boolPrint "c_hupcl" tio.Unix.c_hupcl "Hang up on last close."; boolPrint "c_clocal" tio.Unix.c_clocal "Ignore modem status lines."; boolPrint "c_isig" tio.Unix.c_isig "Generate signal on INTR, QUIT, SUSP."; boolPrint "c_icanon" tio.Unix.c_icanon "Enable canonical processing (line buffering and editing)"; boolPrint "c_noflsh" tio.Unix.c_noflsh "Disable flush after INTR, QUIT, SUSP."; boolPrint "c_echo" tio.Unix.c_echo "Echo input characters."; boolPrint "c_echoe" tio.Unix.c_echoe "Echo ERASE (to erase previous character)."; boolPrint "c_echok" tio.Unix.c_echok "Echo KILL (to erase the current line)."; boolPrint "c_echonl" tio.Unix.c_echonl "Echo NL even if c_echo is not set."; charPrint "c_vintr" tio.Unix.c_vintr "Interrupt character (usually ctrl-C)."; charPrint "c_vquit" tio.Unix.c_vquit "Quit character (usually ctrl-\\)."; charPrint "c_verase" tio.Unix.c_verase "Erase character (usually DEL or ctrl-H)."; charPrint "c_vkill" tio.Unix.c_vkill "Kill line character (usually ctrl-U)."; charPrint "c_veof" tio.Unix.c_veof "End-of-file character (usually ctrl-D)."; charPrint "c_veol" tio.Unix.c_veol "Alternate end-of-line char. (usually none)."; intPrint "c_vmin" tio.Unix.c_vmin "Minimum number of characters to read before the read request is satisfied."; intPrint "c_vtime" tio.Unix.c_vtime "Maximum read wait (in 0.1s units)."; charPrint "c_vstart" tio.Unix.c_vstart "Start character (usually ctrl-Q)."; charPrint "c_vstop" tio.Unix.c_vstop "Stop character (usually ctrl-S)." *) (* Implemented in file pty.c *) external dumpFd : Unix.file_descr -> int = "%identity" external setControllingTerminal : Unix.file_descr -> unit = "setControllingTerminal" external c_openpty : unit -> Unix.file_descr * Unix.file_descr = "c_openpty" let openpty() = try Some (c_openpty ()) with Unix.Unix_error _ -> None (* Utility functions copied from ocaml's unix.ml because they are not exported :-| *) let rec safe_dup fd = let new_fd = Unix.dup fd in if dumpFd new_fd >= 3 then new_fd else begin let res = safe_dup fd in Unix.close new_fd; res end let safe_close fd = try Unix.close fd with Unix.Unix_error _ -> () let perform_redirections new_stdin new_stdout new_stderr = let newnewstdin = safe_dup new_stdin in let newnewstdout = safe_dup new_stdout in let newnewstderr = safe_dup new_stderr in safe_close new_stdin; safe_close new_stdout; safe_close new_stderr; Unix.dup2 newnewstdin Unix.stdin; Unix.close newnewstdin; Unix.dup2 newnewstdout Unix.stdout; Unix.close newnewstdout; Unix.dup2 newnewstderr Unix.stderr; Unix.close newnewstderr (* Like Unix.create_process except that we also try to set up a controlling terminal for the new process. If successful, a file descriptor for the master end of the controlling terminal is returned. *) let create_session cmd args new_stdin new_stdout new_stderr = match openpty () with None -> (None, Unix.create_process cmd args new_stdin new_stdout new_stderr) | Some (masterFd, slaveFd) -> (* Printf.printf "openpty returns %d--%d\n" (dumpFd fdM) (dumpFd fdS); flush stdout; Printf.printf "new_stdin=%d, new_stdout=%d, new_stderr=%d\n" (dumpFd new_stdin) (dumpFd new_stdout) (dumpFd new_stderr) ; flush stdout; *) begin match Unix.fork () with 0 -> begin try Unix.close masterFd; ignore (Unix.setsid ()); setControllingTerminal slaveFd; (* WARNING: SETTING ECHO TO FALSE! *) let tio = Unix.tcgetattr slaveFd in tio.Unix.c_echo <- false; Unix.tcsetattr slaveFd Unix.TCSANOW tio; perform_redirections new_stdin new_stdout new_stderr; Unix.execvp cmd args (* never returns *) with _ -> Printf.eprintf "Some error in create_session child\n"; flush stderr; exit 127 end | childPid -> Unix.close slaveFd; (Some masterFd, childPid) end let rec select a b c d = try Unix.select a b c d with Unix.Unix_error(Unix.EINTR,_,_) -> select a b c d (* Wait until there is input. If there is terminal input s, return Some s. Otherwise, return None. *) let rec termInput fdTerm fdInput = let (ready,_,_) = select [fdTerm;fdInput] [] [] (-1.0) in if not(Safelist.exists (fun x -> x=fdTerm) ready) then None else (* there's input waiting on the terminal *) (* read a line of input *) let msg = let n = 1024 in (* Assume length of input from terminal < n *) let s = String.create n in let howmany = let rec loop() = try Unix.read fdTerm s 0 n with Unix.Unix_error(Unix.EINTR,_,_) -> loop() in loop() in if howmany <= 0 then "" else String.sub s 0 howmany in let len = String.length msg in if len = 0 then None (* the terminal has been closed *) else if len = 2 && msg.[0] = '\r' && msg.[1] = '\n' then termInput fdTerm fdInput else Some msg let (>>=) = Lwt.bind (* Read messages from the terminal and use the callback to get an answer *) let handlePasswordRequests fdTerm callback = Unix.set_nonblock fdTerm; let buf = String.create 10000 in let rec loop () = Lwt_unix.read fdTerm buf 0 10000 >>= (fun len -> if len = 0 then (* The remote end is dead *) Lwt.return () else let query = String.sub buf 0 len in if query = "\r\n" then loop () else begin let response = callback query in Lwt_unix.write fdTerm (response ^ "\n") 0 (String.length response + 1) >>= (fun _ -> loop ()) end) in ignore (loop ()) unison-2.32.52/terminal.mli0000644000076500000000000000145111176730177015163 0ustar bcpiercewheel(* Like Unix.create_process except that we also try to set up a controlling terminal for the new process. If successful, a file descriptor for the master end of the controlling terminal is returned. *) val create_session : string -> string array -> Unix.file_descr -> Unix.file_descr -> Unix.file_descr -> Unix.file_descr option * int (* termInput fdTerm fdInput Wait until there is input on at least one file descriptor. If there is terminal input s, return Some s. Otherwise, return None. *) val termInput : Unix.file_descr -> Unix.file_descr -> string option val handlePasswordRequests : Unix.file_descr -> (string -> string) -> unit (* For recognizing messages from OpenSSH *) val password : string -> bool val passphrase : string -> bool val authenticity : string -> bool unison-2.32.52/test.ml0000644000076500000000000004150711176730177014164 0ustar bcpiercewheel(* Unison file synchronizer: src/test.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) let (>>=) = Lwt.(>>=) (* ---------------------------------------------------------------------- *) (* Utility functions *) let debug = Trace.debug "test" let verbose = Trace.debug "test" let rec remove_file_or_dir d = match try Some(Unix.lstat d) with Unix.Unix_error((Unix.ENOENT | Unix.ENOTDIR),_,_) -> None with | Some(s) -> if s.Unix.st_kind = Unix.S_DIR then begin let handle = Unix.opendir d in let rec loop () = let r = try Some(Unix.readdir handle) with End_of_file -> None in match r with | Some f -> if f="." || f=".." then loop () else begin remove_file_or_dir (d^"/"^f); loop () end | None -> Unix.closedir handle; Unix.rmdir d in loop () end else Sys.remove d | None -> () let read_chan chan = let nbytes = in_channel_length chan in let string = String.create nbytes in really_input chan string 0 nbytes; string let read file = if file = "-" then read_chan stdin else let chan = open_in_bin file in try let r = read_chan chan in close_in chan; r with exn -> close_in chan; raise exn let write file s = if file = "-" then output_string stdout s else let chan = open_out_bin file in try output_string chan s; close_out chan with exn -> close_out chan; raise exn let read_dir d = let ignored = ["."; ".."] in let d = Unix.opendir d in let rec do_read acc = try (match (Unix.readdir d) with | s when Safelist.mem s ignored -> do_read acc | f -> do_read (f :: acc)) with End_of_file -> acc in let files = do_read [] in Unix.closedir d; files let extend p file = p ^ "/" ^ file type fs = | File of string | Link of string | Dir of (string * fs) list let rec equal fs1 fs2 = match fs1,fs2 with | File s1, File s2 -> s1=s2 | Link s1, Link s2 -> s1=s2 | Dir d1, Dir d2 -> let dom d = Safelist.sort String.compare (Safelist.map fst d) in (dom d1 = dom d2) && (Safelist.for_all (fun x -> equal (Safelist.assoc x d1) (Safelist.assoc x d2))) (dom d1) | _,_ -> false let rec fs2string = function | File s -> "File \"" ^ s ^ "\"" | Link s -> "Link \"" ^ s ^ "\"" | Dir s -> "Dir [" ^ (String.concat "; " (Safelist.map (fun (n,fs') -> "(\""^n^"\", "^(fs2string fs')^")") s)) ^ "]" let fsopt2string = function None -> "MISSING" | Some(f) -> fs2string f let readfs p = let rec loop p = let s = Unix.lstat p in match s.Unix.st_kind with | Unix.S_REG -> File (read p) | Unix.S_LNK -> Link (Unix.readlink p) | Unix.S_DIR -> Dir (Safelist.map (fun x -> (x, loop (extend p x))) (read_dir p)) | _ -> assert false in try Some(loop p) with Unix.Unix_error (Unix.ENOENT,_,_) -> None let default_perm = 0o755 let writefs p fs = verbose (fun() -> Util.msg "Writing new test filesystem\n"); let rec loop p = function | File s -> verbose (fun() -> Util.msg "Writing %s with contents %s (fingerprint %s)\n" p s (Fingerprint.toString (Fingerprint.string s))); write p s | Link s -> Unix.symlink s p | Dir files -> Unix.mkdir p default_perm; Safelist.iter (fun (x,cont) -> loop (extend p x) cont) files in remove_file_or_dir p; loop p fs let checkRootEmpty : Common.root -> unit -> unit Lwt.t = Remote.registerRootCmd "checkRootEmpty" (fun (fspath, ()) -> if Os.exists fspath Path.empty then raise (Util.Fatal (Printf.sprintf "Path %s is not empty at start of tests!" (Fspath.toString fspath))); Lwt.return ()) let makeRootEmpty : Common.root -> unit -> unit Lwt.t = Remote.registerRootCmd "makeRootEmpty" (fun (fspath, ()) -> remove_file_or_dir (Fspath.toString fspath); Lwt.return ()) let getfs : Common.root -> unit -> (fs option) Lwt.t = Remote.registerRootCmd "getfs" (fun (fspath, ()) -> Lwt.return (readfs (Fspath.toString fspath))) let getbackup : Common.root -> unit -> (fs option) Lwt.t = Remote.registerRootCmd "getbackup" (fun (fspath, ()) -> Lwt.return (readfs (Fspath.toString (Stasher.backupDirectory ())))) let makeBackupEmpty : Common.root -> unit -> unit Lwt.t = Remote.registerRootCmd "makeBackupEmpty" (fun (fspath, ()) -> let b = Fspath.toString (Stasher.backupDirectory ()) in debug (fun () -> Util.msg "Removing %s\n" b); Lwt.return (remove_file_or_dir b)) let putfs : Common.root -> fs -> unit Lwt.t = Remote.registerRootCmd "putfs" (fun (fspath, fs) -> writefs (Fspath.toString fspath) fs; Lwt.return ()) let loadPrefs l = Prefs.loadStrings l; Lwt_unix.run (Globals.propagatePrefs ()); Stasher.initBackups() (* ---------------------------------------------------------------------------- *) let displayRis ris = Safelist.iter (fun ri -> Util.msg "%s\n" (Uicommon.reconItem2string Path.empty ri "")) ris let sync ?(verbose=false) () = let (reconItemList, _, _) = Recon.reconcileAll (Update.findUpdates()) in if verbose then begin Util.msg "Sync result:\n"; displayRis reconItemList end; Lwt_unix.run ( Lwt_util.iter (fun ri -> Transport.transportItem ri (Uutil.File.ofLine 0) (fun _ _ -> true)) reconItemList); Update.commitUpdates() let currentTest = ref "" type checkable = R1 | R2 | BACKUP1 | BACKUP2 let checkable2string = function R1 -> "R1" | R2 -> "R2" | BACKUP1 -> "BACKUP1" | BACKUP2 -> "BACKUP2" let test() = Util.warnPrinter := None; Prefs.set Trace.logging false; Prefs.set Trace.terse true; Trace.sendLogMsgsToStderr := false; let origPrefs = Prefs.dump() in let runtest name prefs f = Util.msg "%s...\n" name; Util.convertUnixErrorsToFatal "Test.test" (fun() -> currentTest := name; Prefs.load origPrefs; loadPrefs prefs; debug (fun() -> Util.msg "Emptying backup directory\n"); Lwt_unix.run (Globals.allRootsIter (fun r -> makeBackupEmpty r ())); debug (fun() -> Util.msg "Running test\n"); f(); ) in Util.msg "Running internal tests...\n"; (* Paranoid checks, to make sure we do not delete anybody's filesystem! *) if not (Safelist.for_all (fun r -> Util.findsubstring "test" r <> None) (Globals.rawRoots())) then raise (Util.Fatal "Self-tests can only be run if both roots include the string 'test'"); if Util.findsubstring "test" (Fspath.toString (Stasher.backupDirectory())) = None then raise (Util.Fatal ("Self-tests can only be run if the 'backupdir' preference (or wherever the backup " ^ "directory name is coming from, e.g. the UNISONBACKUPDIR environment variable) " ^ "includes the string 'test'")); Lwt_unix.run (Globals.allRootsIter (fun r -> makeRootEmpty r ())); let (r2,r1) = Globals.roots () in (* Util.msg "r1 = %s r2 = %s...\n" (Common.root2string r1) (Common.root2string r2); *) let bothRootsLocal = match (r1,r2) with (Common.Local,_),(Common.Local,_) -> true | _ -> false in let put c fs = Lwt_unix.run (match c with R1 -> putfs r1 fs | R2 -> putfs r2 fs | BACKUP1 | BACKUP2 -> assert false) in let failures = ref 0 in let check name c fs = debug (fun() -> Util.msg "Checking %s / %s\n" (!currentTest) name); let actual = Lwt_unix.run ((match c with R1 -> getfs r1 | R2 -> getfs r2 | BACKUP1 -> getbackup r1 | BACKUP2 -> getbackup r2) ()) in let fail () = Util.msg "Test %s / %s: \nExpected %s = \n %s\nbut found\n %s\n" (!currentTest) name (checkable2string c) (fs2string fs) (fsopt2string actual); failures := !failures+1; raise (Util.Fatal (Printf.sprintf "Self-test %s / %s failed!" (!currentTest) name)) in match actual with Some(a) -> if not (equal a fs) then fail() | None -> fail() in let checkmissing name c = debug (fun() -> Util.msg "Checking nonexistence %s / %s\n" (!currentTest) name); let actual = Lwt_unix.run ((match c with R1 -> getfs r1 | R2 -> getfs r2 | BACKUP1 -> getbackup r1 | BACKUP2 -> getbackup r2) ()) in if actual <> None then begin Util.msg "Test %s / %s: \nExpected %s MISSING\nbut found\n %s\n" (!currentTest) name (checkable2string c) (fsopt2string actual); failures := !failures+1; raise (Util.Fatal (Printf.sprintf "Self-test %s / %s failed!" (!currentTest) name)) end in (* N.b.: When making up tests, it's important to choose file contents of different lengths. The reason for this is that, on some Unix systems, it is possible for the inode number of a just-deleted file to be reassigned to the very next file created -- i.e., to the updated version of the file that the test script has just written. If the length of the contents is also the same and the test is running fast enough that the whole thing happens within a second, then the update will be missed! *) (* Check for the bug reported by Ralf Lehmann *) if not bothRootsLocal then runtest "backups 1 (remote)" ["backup = Name *"] (fun() -> put R1 (Dir []); put R2 (Dir []); sync(); debug (fun () -> Util.msg "First check\n"); checkmissing "1" BACKUP1; checkmissing "2" BACKUP2; (* Create a file *) put R1 (Dir ["test.txt", File "1"]); sync(); checkmissing "3" BACKUP1; checkmissing "4" BACKUP2; (* Change it and check that the old version got backed up on the target host *) put R1 (Dir ["test.txt", File "2"]); sync(); checkmissing "5" BACKUP1; check "6" BACKUP2 (Dir [("test.txt", File "1")]); ); if bothRootsLocal then runtest "backups 1 (local)" ["backup = Name *"] (fun() -> put R1 (Dir []); put R2 (Dir []); sync(); (* Create a file and a directory *) put R1 (Dir ["x", File "foo"; "d", Dir ["a", File "barr"]]); sync(); (* Delete them *) put R1 (Dir []); sync(); check "1" BACKUP1 (Dir ["x", File "foo"; "d", Dir ["a", File "barr"]]); (* Put them back and delete them once more *) put R1 (Dir ["x", File "FOO"; "d", Dir ["a", File "BARR"]]); sync(); put R1 (Dir []); sync(); check "2" BACKUP1 (Dir [("x", File "FOO"); ("d", Dir [("a", File "BARR")]); (".bak.1.x", File "foo"); (".bak.1.d", Dir [("a", File "barr")])]) ); runtest "backups 2" ["backup = Name *"; "backuplocation = local"] (fun() -> put R1 (Dir []); put R2 (Dir []); sync(); (* Create a file and a directory *) put R1 (Dir ["x", File "foo"; "d", Dir ["a", File "barr"]]); sync(); (* Delete them *) put R1 (Dir []); sync(); (* Check that they have been backed up correctly on the other side *) check "1" R2 (Dir [(".bak.0.x", File "foo"); (".bak.0.d", Dir [("a", File "barr")])]); ); runtest "backups 2a" ["backup = Name *"; "backuplocation = local"] (fun() -> put R1 (Dir []); put R2 (Dir []); sync(); (* Create a file and a directory *) put R1 (Dir ["foo", File "1"]); sync(); check "1" R1 (Dir [("foo", File "1")]); check "2" R1 (Dir [("foo", File "1")]); put R1 (Dir ["foo", File "2"]); sync(); check "3" R1 (Dir [("foo", File "2")]); check "4" R2 (Dir [("foo", File "2"); (".bak.0.foo", File "1")]); ); runtest "backups 3" ["backup = Name *"; "backuplocation = local"; "backupcurrent = Name *"] (fun() -> put R1 (Dir []); put R2 (Dir []); sync(); put R1 (Dir ["x", File "foo"]); sync (); check "1a" R1 (Dir [("x", File "foo"); (".bak.0.x", File "foo")]); check "1b" R2 (Dir [("x", File "foo"); (".bak.0.x", File "foo")]); put R2 (Dir ["x", File "barr"; (".bak.0.x", File "foo")]); sync (); check "2a" R1 (Dir [("x", File "barr"); (".bak.1.x", File "foo"); (".bak.0.x", File "barr")]); check "2b" R2 (Dir [("x", File "barr"); (".bak.1.x", File "foo"); (".bak.0.x", File "barr")]); ); runtest "backups 4" ["backup = Name *"; "backupcurrent = Name *"; "maxbackups = 7"] (fun() -> put R1 (Dir []); put R2 (Dir []); sync(); put R1 (Dir ["x", File "foo"]); sync(); check "1a" BACKUP1 (Dir [("x", File "foo")]); put R1 (Dir ["x", File "barr"]); sync(); check "1b" BACKUP1 (Dir [("x", File "barr"); (".bak.1.x", File "foo")]); put R2 (Dir ["x", File "bazzz"]); sync(); check "1c" BACKUP1 (Dir [("x", File "bazzz"); (".bak.2.x", File "foo"); (".bak.1.x", File "barr")]); ); runtest "backups 5 (directories)" ["backup = Name *"; "backupcurrent = Name *"; "maxbackups = 7"] (fun() -> put R1 (Dir []); put R2 (Dir []); sync(); (* Create a directory x containing files a and l; check that the current version gets backed up *) put R1 (Dir ["x", Dir ["a", File "foo"; "l", File "./foo"]]); sync(); check "1" BACKUP1 (Dir [("x", Dir [("l", File "./foo"); ("a", File "foo")])]); (* On replica 2, delete file a, create file b, and edit file l *) put R2 (Dir ["x", Dir ["b", File "barr"; "l", File "./barr"]]); sync(); check "2" BACKUP1 (Dir [("x", Dir [("l", File "./barr"); ("b", File "barr"); ("a", File "foo"); (".bak.1.l", File "./foo")])]); (* On replica 1, replace the whole directory by a file; when we check the result, we need to know whether we're running the test locally or remotely; in the former case, we should see *both* the old and the new version as backups *) put R1 (Dir ["x", File "bazzz"]); sync(); if bothRootsLocal then check "3" BACKUP1 (Dir [("x", File "bazzz"); (".bak.2.x", Dir [("l", File "./barr"); ("b", File "barr"); ("a", File "foo"); (".bak.1.l", File "./foo")]); (".bak.1.x", Dir [("l", File "./barr"); ("b", File "barr")])]) else check "3" BACKUP1 (Dir [("x", File "bazzz"); (".bak.1.x", Dir [("l", File "./barr"); ("b", File "barr"); ("a", File "foo"); (".bak.1.l", File "./foo")])]); ); runtest "backups 6 (backup prefix/suffix)" ["backup = Name *"; "backuplocation = local"; "backupprefix = back/$VERSION-"; "backupsuffix = .backup"; "backupcurrent = Name *"] (fun() -> put R1 (Dir []); put R2 (Dir []); sync(); put R1 (Dir ["x", File "foo"]); sync(); check "1" R1 (Dir [("x", File "foo"); ("back", Dir [("0-x.backup", File "foo")])]); ); if not (Prefs.read Globals.someHostIsRunningWindows) then begin runtest "links 1 (directories and links)" ["backup = Name *"; "backupcurrent = Name *"; "maxbackups = 7"] (fun() -> put R1 (Dir []); put R2 (Dir []); sync(); put R1 (Dir ["x", Dir ["a", File "foo"; "l", Link "./foo"]]); sync(); check "1" BACKUP1 (Dir [("x", Dir [("l", Link "./foo"); ("a", File "foo")])]); put R2 (Dir ["x", Dir ["b", File "barr"; "l", Link "./barr"]]); sync(); check "2" BACKUP1 (Dir [("x", Dir [("l", Link "./barr"); ("b", File "barr"); ("a", File "foo"); (".bak.1.l", Link "./foo")])]); put R1 (Dir ["x", File "bazzz"]); sync(); if bothRootsLocal then check "3" BACKUP1 (Dir [("x", File "bazzz"); (".bak.2.x", Dir [("l", Link "./barr"); ("b", File "barr"); ("a", File "foo"); (".bak.1.l", Link "./foo")]); (".bak.1.x", Dir [("l", Link "./barr"); ("b", File "barr")])]) else check "3" BACKUP1 (Dir [("x", File "bazzz"); (".bak.1.x", Dir [("l", Link "./barr"); ("b", File "barr"); ("a", File "foo"); (".bak.1.l", Link "./foo")])]); ); (* Test that we correctly fail when we try to 'follow' a symlink that does not point to anything *) runtest "links 2 (symlink to nowhere)" ["follow = Name y"] (fun() -> let orig = (Dir []) in put R1 orig; put R2 orig; sync(); put R1 (Dir ["y", Link "x"]); sync(); check "1" R2 orig; ); end; if !failures = 0 then Util.msg "Success :-)\n" else raise (Util.Fatal "Self-tests failed\n") (* Initialization: tie the knot between this module and Uicommon *) let _ = (Uicommon.testFunction := test) unison-2.32.52/test.mli0000644000076500000000000000025011176730177014323 0ustar bcpiercewheel(* Unison file synchronizer: src/test.mli *) (* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) (* Internal self-tests *) val test: unit -> unit unison-2.32.52/TODO.txt0000644000076500000000000015215011176730177014156 0ustar bcpiercewheelHere 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@y..., "Matt Swift" wrote: > I just posted a msg to cygwin@c... detailing some very strange > behavior of chmod when a file's owner is also the file's group. It I was right about the crucial circumstances of owner = group. Moral: do not let user=group under Cygwin. I know it causes a problem when you make unison use the full permissions model on Cygwin systems; I think this may also explain similar problems I had using the default unison behavior (which treats Cygwin files as read-only or read-write only) -- though there are several possible causes of like failures to syncrhonize permissions. The answer is obvious, following from the basic handling of permissions in Cygwin (in NT permissions mode), but I didn't see it. Users and groups to Windows are the same kind of object (SID), and permissions on a file or directory are represented as a list of (any number of) SIDs paired with permissions such as read, write, execute (and quite a few more). When you try to map this to the Unix model of user and group, when the user and group happen to be the same, the user-permissions and the group-permissions are operating on the same underlying Windows object, and so they cannot be different. I think the user-permissions prevail. For example, if you try to sync a Unix file with permissions rw-r--r-- with a Cygwin file with permissions rw-rw-r-- whose owner happens to be the same as the group, unison will report success, but the actual permissions will not be changed. Moreover, during the next sync, unison will by default propogate the Cygwin file back to the Unix file, so that the degenerate permissions under Cygwin will migrate to the Unix system unless you are careful to prevent unison from doing it. (When you are trying to sync some 75,000 email and font files, this all is more than a little exasperating!) --- Further important advice if you are going to synchronize Cygwin filesystems with unison's full Unix permissions model (and perhaps it is also important even with unison's default behavior): Background: the flags "ntsec" or "ntea" in the CYGWIN environment variable signals Cygwin's libraries to use the richer NT permissions model rather than a simplified Win95-98 model. "ntsec" requires an NTFS filesystem, "ntea" will work with FAT filesystems. I use "ntsec". If unison does not have CYGWIN set appropriately in its environment, some chmod calls will not do the expected thing, even though they return with success. This will result in the file coming up again in the next synchronization, and unison will then by default propagate the (wrong) permissions from the Cygwin file back to the Unix system. (The first chmod apparently succeeded, so unison records the new permissions in its archive; the second time, when the file does not match the archive, it seems to unison that the Cygwin file has been changed.) If you run unison from the bash command line, you will most likely not have a problem, since CYGWIN is probably set appropriately and exported in the .bat script that launches bash. Likewise, when the Cygwin filesystem is the remote one, Cygwin's sshd is by default set up (by /usr/bin/ssh-host-config) to establish and export an appropriate value of CYGWIN to ssh clients. If you launch unison directly from a Windows shortcut, however, you must set CYGWIN in your Windows environment variables. This is certainly a convenient way to launch unison either with a particular profile or generically. The instructions for setting up Cygwin and the discussions of the CYGWIN envariable in the user manual never mention any need to put CYGWIN in the Windows envariables, however. (I'm writing them to suggest they do.) >From the unison standpoint, the code which chooses to use the full permissions model on Cygwin hosts (right now I have it hacked simply to always use full permissions, by commenting out a line) perhaps ought to confirm that "ntsec" or "ntea" is in the CYGWIN envariable and issue a big warning that permissions may not be properly synchronized if neither value is there. ** add '' to the head section of all the unison web pages. ** Peter Selinger has built an SHA256 implementation that should be usable as a drop-in replacement for MD5, if we ever need to do that * BUILDING AND INSTALLING * ======================= ** 'make install' could be improved (and documented) 1. Typing "make install' after a "make" should simply install the program that was made, not attempt to do a remake with different options. ===> Doesn't it??? 2. "make install' should try to install as /usr/local/bin/unison, not ~/bin/, especially considering that ~/bin is the wrong place to do the install under OSX (it should be ~/Apps or ~/Apps/bin) ** document the dynamically linked version, as some user already reported that it works fine. Also, try to make the statistics window work with this version. [This is "under windows," I think.] should strip symbols from binary files in 'make exportnative' * DOCUMENTATION * ============= ** Put a little more order on the flags and preferences -- e.g., organize them into "basic preferences", "advanced preferences," "expert preferences," etc. Requires hacking the Uarg module. ** Add something to docs about how to use 'rootalias'. Include an explanation of the semantics, a couple of examples, and a suggestion for how to debug what it's doing by turning on appropriate debugging flags. (And maybe we should actually make the debug output there a bit more verbose?) ** Misc: - document good trick: use -1 switch to ssh if the paths are set up wrong on the remote host - should say whether trailing slashes are ok for paths; should say that leading slashes are illegal. ===> check - not so clear what you have to do with a Regex to match a directory and all its subfiles: foo or foo/ or foo/.* ? ===> the first. document it. (Does foo/ match foo? I don't think so. Document, one way or the other.) - what happens when files are included whose parent dirs are excluded? (With Regex? With multiple Path and Name?) ===> document - the documentation is very good, but i couldn't find a description of how to respond to the prompts in the textual ui. is that explained somewhere? a few typos i noticed: "with t fast", "nison", "off of". ** what happens when we ssh through loopback and sync the same directory? ===> Needs to be thought about. In particular, what is the name of the archive in this case? Could they ever be exactly the same? ===> Try it and see. * SMALL FUNCTIONALITY IMPROVEMENTS * ================================ **** When I tell unison to ignore a file whose name has a comma in it, then unison adds to the preferences file a line like: ignore = Path{this file, has a comma} which gets interpreted as "this file" OR " has a comma". unison should be escaping that comma and write it as \, instead. **** Please let me say root = ~/bla instead of requiring me to give an absolute path to my home dir. **** The archive should indicate whether it is case-dependant or not. (This is important for correctness -- if the case-insensitive flag is set differently on different runs, things can get very confused!) **** Use LargeFile (submodule of Unix) instead of standard file commands, to avoid problems with huge files DONE *** [Marcus Sundman, 2008] Unison can't propagate changes in read-only folders. The correct way to do it is to temporarily add write permissions for the user to the folder, then do the changes and then reset the permissions. Now unison tries to just do the changes, which fails with a "permission denied" error. *** [Adrian Stephens, 2007] I would like the scope of rootalias to be expanded so that any command that expects a root will perform aliasing on the command. In my application, I need to change the root statement as I move my machine from desk to the road. I also have a "force" statement, and I also have to remember to edit this to match. It would be more convenient to have to edit in a single place and, more importantly, avoids introducing any inconsistency. --- [BCP:] I like this idea. However, since I'm struggling at the moment to find time to finish polishing 2.27 to become the new stable release, I am not going to undertake to implement it. If you (or someone else) would like to give it a shot, here is what I think needs to happen: - Move the rootalias preference and the rootalias-expanding code from Update.root2stringOrAlias into the Common module (creating a new function there for rootalias expansion). - Find places like Recon.lookupPreferredRoot that deal with names of roots and add a call to the rootalias-expanding function. *** Delete old backups mechanism and, instead, extend new one to cover its functionality - put backups in same dir as files by default - otherwise, put them in a central place if one is given - Update.incrVersionsOfBackups should not be externally visible *** there's an HFS+ aware version of rsync called rsyncx. It should be relatively easy to import that functionality into unison. *** Consider altering the socket method, so the server accepts connections only on a particular address? This would be very useful, because many people tunnel unison over an OpenVPN Link, and this software works with virtual devices and additional IP addresses on it. If unison would accept connections only on the virtual device, the security would be enhanced, because the OpenVPN key should be unavailable for the black hats. *** unison -help doesn't go to stdout so it's hard to pipe it into less ===> Probably *all* output should go to stdout, not stderr (but maybe we need a switch to recover the current behavior) *** for the MSVC version of unison, we should deal with the nonstandard semantics regarding read-only files. ===> What does that mean?? *** If a root resides on a `host' with an ever and unpredictably changing host name (like a public login cluster with dozens of machines and a shared file system), listing each possible host name for this root is not feasible. The ability of specifing patterns in rootaliases would help a lot in this case. I'm thinking of something like this: rootalias = //.*//afs/cern.ch/user/n/nagya -> //cern.ch//afs/cern.ch/user/n/nagya [NAGY Andras , March 12] ===> We definitely ought to do something about this problem -- it's increasingly common. Not sure if this is the right proposal, but something. *** Currently, if a file changes on either side between the initial update detection and the time when the transport module tries to propagate changes, the transport is aborted. But if the change occurred on the replica that is being used as the source for the transfer (which will be the common case!), then there is no reason to abort -- we should just propagate the newest version. *** When unison notices lock files in the archive directory, it should offer to delete them *for* the user, rather than forcing the user to delete them manually. *** improve error reporting when Unison is started with different versions of client and server *** A switch to delete files before replication. It's not something I would have considered doing, and in normal replication, there have already been pointed out good reasons why Unison works the way it does, but Roman makes a good reason for why this is useful in CD-RW backups, and why this could be useful on a general to do list. And this is certainly *generic*, which my point is not (as it only applies to the Microsoft Windows NTFS situation). *** A switch to include NTFS ACE/ACL file permissions to be copied when copying from one NTFS location to another NTFS location. As I mentioned this is less generic, but of fundamental usefullness in Windows usage, as NTFS permissions are absolutely essential in many backup/replication situations in Windows systems. Robocopy has the /SEC switch, but Unison is a far better tool, and I was hoping in that light that Unison could implement the rights/permissions stuff also. *** There is no command-line argument to tell Unison where the .unison directory is; Unison finds it in the environment or not at all. I was able to workaround this with a symbolic link to put .unison where it was expected, but it seems like an easy option to add. *** The other is possibly a bit more difficult, but more useful as well. There is a brief window of vulnerability between when the local server is started and when the remote client connects to it. (It's no longer than that because Unison won't take more than one connection at a time.) I can tolerate it, but the window could be eliminated entirely by allowing socket connections to require a nonce. ** Would be nice to transfer directories "incrementally" rather than atomically (i.e., if Unison is interrupted during the transfer of a directory, the partially-transferred directory should persist). Is this allowed by the specification? (If so, then it should just become the default behavior.) ===> BCP and William Lovas have discussed how to do this, but it is not all that straightforward. ** we should reload the current preference file (if it's changed, at least) when we restart ** [A good idea for the ssh prompt issue...] I'm not sure why you would need a C implementation; you could do the same thing in CAML that expect does: allocate a PTY, start up ssh on that, and interact with it. On Windows, you can probably do the same with the Win32 console API, although I don't see why such an improvement needs to work uniformly across all platforms to be useful. [Note that allocating PTYs is not very portable, but we could at least try allocating one and see if something useful comes back...] ** An idea for the interface to the external merge functionality: created a general mechanism for invoking external functionality... - in profile, declare a command of the form key M = external "merge ##1 ##2 ###" --> overwriting originals (concrete syntax open to discussion!). Main parts are - what key to bind it to in the UI(s) - the command line to start up - variables (##1 and ##2) for the local and remote files (the remote file will automatically be copied to a local temp file, if this variable is used) - a variable (###) for a temporary output file - an indication of what to do with this output file (or maybe this could be automatic) - (should also indicate which machine(s) to run the command on?) ** small additions to merge functionality: - if the external merge program *deletes* one of the files it is given, Unison should interpret this as "Copy the other file onto this location (instead of merging)". This will allow some other interesting functionality, e.g. external programs that may decide to keep both versions by moving one of them out of the way (mh-rename). - the invocation of the external 'diff' program should be selectable using the same conventions as the 'merge' program - would be nice to be able to invoke DIFFERENT merge programs depending on paths ** We should document other available merge tools, e.g., idiff [BCP has a copy of the code for idiff that Norman sent.] ** Allow 'default.prf' in place of 'default' for profile names ** [dlux@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@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: unison-2.32.52/transfer.ml0000644000076500000000000006163411216376164015031 0ustar bcpiercewheel(* Unison file synchronizer: src/transfer.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) (* rsync compression algorithm To compress, we use a compression buffer with a size a lot greater than the size of a block, typically half a megabyte. This buffer is loaded with the file contents. Its valid part is represented by its limit 'length'. We scan the file contents by sliding a window with the size of a block over the compression buffer. This window is represented by its 'offset' and its size 'blockSize'. We transmit STRING tokens, containing the differences between the files, and BLOCK tokens, containing the number of a block from the old file found in the new one. The data not transmitted yet are pointed by 'toBeSent'. For each position of the window, we compute the checksum of the block it contains and try to find a matching entry in the hashed block information data. If there is a match, we compute the fingerprint of our block to match it with the candidates' fingerprints : - if there is a match, we've just hit, we can transmit the data not sent yet as a STRING token and emit a BLOCK token representing our match, then we slide the window one block ahead and try again; - in any other case, we've missed, we just slide the window one character ahead and try again. If the file size is greater than the compression buffer size, then we have to update the compression buffer when the window reaches its limit. We do so by sending any data not sent yet, then copying the end of the buffer at its beginning and filling it up with the file contents coming next. We now place our window at the beginning of the buffer and we continue the process. The compression is over when we reach the end of the file. We just have to send the data not sent yet together with the last characters that could not fill a block. *) let debug = Trace.debug "transfer" let debugV = Trace.debug "transfer+" let debugToken = Trace.debug "rsynctoken" let debugLog = Trace.debug "rsynclog" open Lwt type transfer_instruction = Bytearray.t * 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 : Bytearray.t; (* 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 > Bytearray.length q.data) >>= (fun () -> q.data.{q.pos} <- 'E'; q.pos <- q.pos + 1; q.previous <- `None; return ()) let pushString q id transmit s pos len = flushQueue q id transmit (q.pos + len + 3 > Bytearray.length q.data) >>= (fun () -> if q.pos + 3 + len > Bytearray.length q.data then begin (* The file is longer than expected, so the string does not fit in the buffer *) assert (q.pos = 0); q.data <- Bytearray.create maxQueueSize end; q.data.{q.pos} <- 'S'; encodeInt2 q.data (q.pos + 1) len; assert (q.pos + 3 + len <= Bytearray.length q.data); Bytearray.blit_from_string s pos q.data (q.pos + 3) len; q.pos <- q.pos + len + 3; q.prog <- q.prog + len; q.previous <- `Str len; return ()) let rec growString q id transmit len' s pos len = let l = min (Bytearray.length q.data - q.pos) len in Bytearray.blit_from_string s pos q.data q.pos l; assert (q.data.{q.pos - len' - 3} = 'S'); assert (decodeInt2 q.data (q.pos - len' - 2) = len'); let len'' = len' + l in encodeInt2 q.data (q.pos - len' - 2) len''; 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 > Bytearray.length q.data) >>= (fun () -> q.data.{q.pos} <- 'B'; encodeInt3 q.data (q.pos + 1) pos; encodeInt1 q.data (q.pos + 4) 1; q.pos <- q.pos + 5; 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) *) Bytearray.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 (Bytearray.sub data (pos + 3) length) 0 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 (Bytearray.sub data (pos + 3) length) 0 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), _ -> (* Negative 31-bits integers are sign-extended when unmarshalled on a 64-bit architecture, so we truncate them back to 31 bits. *) let cs = cs land 0x7fffffff in 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 unison-2.32.52/transfer.mli0000644000076500000000000001053211207765162015171 0ustar bcpiercewheel(* 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 = Bytearray.t * 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 unison-2.32.52/transport.ml0000644000076500000000000001727311176730177015244 0ustar bcpiercewheel(* Unison file synchronizer: src/transport.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) open Common open Lwt let debug = Trace.debug "transport" (*****************************************************************************) (* MAIN FUNCTIONS *) (*****************************************************************************) let fileSize uiFrom uiTo = match uiFrom, uiTo with _, Updates (File (props, ContentsUpdated (_, _, ress)), _) -> (Props.length props, Osx.ressLength ress) | Updates (_, Previous (`FILE, props, _, ress)), (NoUpdates | Updates (File (_, ContentsSame), _)) -> (Props.length props, Osx.ressLength ress) | _ -> assert false let maxthreads = Prefs.createInt "maxthreads" 20 "!maximum number of simultaneous file transfers" ("This preference controls how much concurrency is allowed during" ^ " the transport phase. Normally, it should be set reasonably high " ^ "(default is 20) to maximize performance, but when Unison is used " ^ "over a low-bandwidth link it may be helpful to set it lower (e.g. " ^ "to 1) so that Unison doesn't soak up all the available bandwidth." ) let actionReg = Lwt_util.make_region (Prefs.read maxthreads) (* Logging for a thread: write a message before and a message after the execution of the thread. *) let logLwt (msgBegin: string) (t: unit -> 'a Lwt.t) (fMsgEnd: 'a -> string) : 'a Lwt.t = Trace.log msgBegin; Lwt.bind (t ()) (fun v -> Trace.log (fMsgEnd v); Lwt.return v) (* [logLwtNumbered desc t] provides convenient logging for a thread given a description [desc] of the thread [t ()], generate pair of messages of the following form in the log: * [BGN] ... [END] **) let rLogCounter = ref 0 let logLwtNumbered (lwtDescription: string) (lwtShortDescription: string) (t: unit -> 'a Lwt.t): 'a Lwt.t = let _ = (rLogCounter := (!rLogCounter) + 1; !rLogCounter) in let lwtDescription = Util.replacesubstring lwtDescription "\n " "" in logLwt (Printf.sprintf "[BGN] %s\n" lwtDescription) t (fun _ -> Printf.sprintf "[END] %s\n" lwtShortDescription) let stashCurrentVersionOnRoot: Common.root -> Path.t -> unit Lwt.t = Remote.registerRootCmd "stashCurrentVersion" (fun (fspath, path) -> Lwt.return (Stasher.stashCurrentVersion fspath (Update.translatePathLocal fspath path) None)) let stashCurrentVersions fromRoot toRoot path = stashCurrentVersionOnRoot fromRoot path >>= (fun()-> stashCurrentVersionOnRoot toRoot path) let doAction (fromRoot,toRoot) path fromContents toContents id = Lwt_util.resize_region actionReg (Prefs.read maxthreads); Lwt_util.resize_region Files.copyReg (Prefs.read maxthreads); Lwt_util.run_in_region actionReg 1 (fun () -> if not !Trace.sendLogMsgsToStderr then Trace.statusDetail (Path.toString path); Remote.Thread.unwindProtect (fun () -> match fromContents, toContents with (`ABSENT, _, _, _), (_, _, _, uiTo) -> logLwtNumbered ("Deleting " ^ Path.toString path ^ "\n from "^ root2string toRoot) ("Deleting " ^ Path.toString path) (fun () -> Files.delete fromRoot path toRoot path uiTo) (* No need to transfer the whole directory/file if there were only property modifications on one side. (And actually, it would be incorrect to transfer a directory in this case.) *) | (_, (`Unchanged | `PropsChanged), fromProps, uiFrom), (_, (`Unchanged | `PropsChanged), toProps, uiTo) -> logLwtNumbered ("Copying properties for " ^ Path.toString path ^ "\n from " ^ root2string fromRoot ^ "\n to " ^ root2string toRoot) ("Copying properties for " ^ Path.toString path) (fun () -> Files.setProp fromRoot path toRoot path fromProps toProps uiFrom uiTo) | (`FILE, _, _, uiFrom), (`FILE, _, _, uiTo) -> logLwtNumbered ("Updating file " ^ Path.toString path ^ "\n from " ^ root2string fromRoot ^ "\n to " ^ root2string toRoot) ("Updating file " ^ Path.toString path) (fun () -> Files.copy (`Update (fileSize uiFrom uiTo)) fromRoot path uiFrom toRoot path uiTo id >>= (fun()-> stashCurrentVersions fromRoot toRoot path)) | (_, _, _, uiFrom), (_, _, _, uiTo) -> logLwtNumbered ("Copying " ^ Path.toString path ^ "\n from " ^ root2string fromRoot ^ "\n to " ^ root2string toRoot) ("Copying " ^ Path.toString path) (fun () -> Files.copy `Copy fromRoot path uiFrom toRoot path uiTo id >>= (fun()-> stashCurrentVersions fromRoot toRoot path))) (fun e -> Trace.log (Printf.sprintf "Failed: %s\n" (Util.printException e)); return ())) let propagate root1 root2 reconItem id showMergeFn = let path = reconItem.path in match reconItem.replicas with Problem p -> Trace.log (Printf.sprintf "[ERROR] Skipping %s\n %s\n" (Path.toString path) p); return () | Different(rc1,rc2,dir,_) -> match !dir with Conflict -> Trace.log (Printf.sprintf "[CONFLICT] Skipping %s\n" (Path.toString path)); return () | Replica1ToReplica2 -> doAction (root1, root2) path rc1 rc2 id | Replica2ToReplica1 -> doAction (root2, root1) path rc2 rc1 id | Merge -> begin match (rc1,rc2) with (`FILE, _, _, ui1), (`FILE, _, _, ui2) -> Files.merge root1 root2 path id ui1 ui2 showMergeFn; return () | _ -> raise (Util.Transient "Can only merge two existing files") end let transportItem reconItem id showMergeFn = let (root1,root2) = Globals.roots() in propagate root1 root2 reconItem id showMergeFn (* ---------------------------------------------------------------------- *) let logStart () = Abort.reset (); let tm = Util.localtime (Util.time()) in let m = Printf.sprintf "%s%s started propagating changes at %02d:%02d:%02d on %02d %s %04d\n" (if Prefs.read Trace.terse || Prefs.read Globals.batch then "" else "\n\n") (String.uppercase Uutil.myNameAndVersion) tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec tm.Unix.tm_mday (Util.monthname tm.Unix.tm_mon) (tm.Unix.tm_year+1900) in Trace.logverbose m let logFinish () = let tm = Util.localtime (Util.time()) in let m = Printf.sprintf "%s finished propagating changes at %02d:%02d:%02d on %02d %s %04d\n%s" (String.uppercase Uutil.myNameAndVersion) tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec tm.Unix.tm_mday (Util.monthname tm.Unix.tm_mon) (tm.Unix.tm_year+1900) (if Prefs.read Trace.terse || Prefs.read Globals.batch then "" else "\n\n") in Trace.logverbose m unison-2.32.52/transport.mli0000644000076500000000000000114411176730177015403 0ustar bcpiercewheel(* 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 unison-2.32.52/tree.ml0000644000076500000000000000605711176730177014145 0ustar bcpiercewheel(* Unison file synchronizer: src/tree.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) type ('a, 'b) t = Node of ('a * ('a, 'b) t) list * 'b option | Leaf of 'b type ('a, 'b) u = { anc: (('a, 'b) u * 'a) option; node: 'b option; children: ('a * ('a, 'b) t) list} let start = {anc = None; node = None; children = []} let add t v = {t with node = Some v} let enter t n = {anc = Some (t, n); node = None; children = []} let leave t = match t with {anc = Some (t, n); node = None; children = []} -> t | {anc = Some (t, n); node = Some v; children = []} -> {t with children = (n, Leaf v) :: t.children} | {anc = Some (t, n); node = v; children = l} -> {t with children = (n, (Node (Safelist.rev l, v))) :: t.children} | {anc = None} -> invalid_arg "Tree.leave" let finish t = match t with {anc = Some _} -> invalid_arg "Tree.finish" | {anc = None; node = Some v; children = []} -> Leaf v | {anc = None; node = v; children = l} -> Node (Safelist.rev l, v) let rec leave_all t = if t.anc = None then t else leave_all (leave t) let rec empty t = {anc = begin match t.anc with Some (t', n) -> Some (empty t', n) | None -> None end; node = None; children = []} let slice t = (finish (leave_all t), empty t) (****) let is_empty t = match t with Node ([], None) -> true | _ -> false let rec map f g t = match t with Node (l, v) -> Node (Safelist.map (fun (n, t') -> (f n, map f g t')) l, match v with None -> None | Some v -> Some (g v)) | Leaf v -> Leaf (g v) let rec iteri t path pcons f = match t with Node (l, v) -> begin match v with Some v -> f path v | None -> () end; Safelist.iter (fun (n, t') -> iteri t' (pcons path n) pcons f) l | Leaf v -> f path v let rec size_rec s t = match t with Node (l, v) -> let s' = if v = None then s else s + 1 in Safelist.fold_left (fun s (_, t') -> size_rec s t') s' l | Leaf v -> s + 1 let size t = size_rec 0 t let rec flatten t path pcons result = match t with Leaf v -> (path, v) :: result | Node (l, v) -> let rem = Safelist.fold_right (fun (name, t') rem -> flatten t' (pcons path name) pcons rem) l result in match v with None -> rem | Some v -> (path, v) :: rem unison-2.32.52/tree.mli0000644000076500000000000000566311176730177014320 0ustar bcpiercewheel(* 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 unison-2.32.52/ubase/0000755000076500000000000000000011222164527013733 5ustar bcpiercewheelunison-2.32.52/ubase/depend0000644000076500000000000000114711176730177015130 0ustar bcpiercewheelmyMap.cmo: myMap.cmi myMap.cmx: myMap.cmi prefs.cmo: util.cmi uarg.cmi safelist.cmi prefs.cmi prefs.cmx: util.cmx uarg.cmx safelist.cmx prefs.cmi rx.cmo: rx.cmi rx.cmx: rx.cmi safelist.cmo: safelist.cmi safelist.cmx: safelist.cmi trace.cmo: util.cmi safelist.cmi prefs.cmi trace.cmi trace.cmx: util.cmx safelist.cmx prefs.cmx trace.cmi uarg.cmo: util.cmi safelist.cmi uarg.cmi uarg.cmx: util.cmx safelist.cmx uarg.cmi uprintf.cmo: uprintf.cmi uprintf.cmx: uprintf.cmi util.cmo: uprintf.cmi safelist.cmi util.cmi util.cmx: uprintf.cmx safelist.cmx util.cmi prefs.cmi: util.cmi trace.cmi: prefs.cmi unison-2.32.52/ubase/Makefile0000644000076500000000000000256411176730177015412 0ustar bcpiercewheelNAME = ubase OBJECTS = \ safelist.cmo uprintf.cmo util.cmo uarg.cmo prefs.cmo trace.cmo rx.cmo \ myMap.cmo OCAMLC = ocamlfind ocamlc -g OCAMLOPT = ocamlfind ocamlopt OCAMLDEP = ocamldep XOBJECTS = $(OBJECTS:cmo=cmx) ARCHIVE = $(NAME).cma XARCHIVE = $(NAME).cmxa REQUIRES = PREDICATES = all: $(ARCHIVE) opt: $(XARCHIVE) $(ARCHIVE): $(OBJECTS) $(OCAMLC) -a -o $(ARCHIVE) -package "$(REQUIRES)" -linkpkg \ -predicates "$(PREDICATES)" $(OBJECTS) $(XARCHIVE): $(XOBJECTS) $(OCAMLOPT) -a -o $(XARCHIVE) -package "$(REQUIRES)" -linkpkg \ -predicates "$(PREDICATES)" $(XOBJECTS) .SUFFIXES: .cmo .cmi .cmx .ml .mli .ml.cmo: $(OCAMLC) -package "$(REQUIRES)" -predicates "$(PREDICATES)" \ -c $< .mli.cmi: $(OCAMLC) -package "$(REQUIRES)" -predicates "$(PREDICATES)" \ -c $< .ml.cmx: $(OCAMLOPT) -package "$(REQUIRES)" -predicates "$(PREDICATES)" \ -c $< depend: *.ml *.mli $(OCAMLDEP) *.ml *.mli > depend include depend install: all { test ! -f $(XARCHIVE) || extra="$(XARCHIVE) "`basename $(XARCHIVE) .cmxa`.a; }; \ ocamlfind install $(NAME) *.mli *.cmi $(ARCHIVE) META $$extra uninstall: ocamlfind remove $(NAME) clean:: rm -f *.cmi *.cmo *.cmx *.cma *.cmxa *.a *.o *~ *.bak # Used by BCP to update Harmony's copy of these files from Unison's update: cp $(HOME)/current/unison/trunk/src/ubase/{*.ml,*.mli,Makefile} .unison-2.32.52/ubase/META0000644000076500000000000000013511176730177014413 0ustar bcpiercewheelrequires = "unix" version = "0.1" archive(byte) = "ubase.cma" archive(native) = "ubase.cmxa" unison-2.32.52/ubase/myMap.ml0000644000076500000000000002104211176730177015357 0ustar bcpiercewheel(* This file is taken from the Objective Caml standard library. Some functions have been added to suite Unison needs. *) (***********************************************************************) (* *) (* Objective Caml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) (* under the terms of the GNU Library General Public License, with *) (* the special exception on linking described in file ../LICENSE. *) (* *) (***********************************************************************) module type OrderedType = sig type t val compare: t -> t -> int end module type S = sig type key type +'a t val empty: 'a t val is_empty: 'a t -> bool val add: key -> 'a -> 'a t -> 'a t val find: key -> 'a t -> 'a val findi: key -> 'a t -> key * 'a val remove: key -> 'a t -> 'a t val mem: key -> 'a t -> bool val iter: (key -> 'a -> unit) -> 'a t -> unit val map: ('a -> 'b) -> 'a t -> 'b t val mapi: (key -> 'a -> 'b) -> 'a t -> 'b t val mapii: (key -> 'a -> key * 'b) -> 'a t -> 'b t val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool val validate: 'a t -> [`Ok | `Duplicate of key | `Invalid] end module Make(Ord: OrderedType) = struct type key = Ord.t type 'a t = Empty | Node of 'a t * key * 'a * 'a t * int let height = function Empty -> 0 | Node(_,_,_,_,h) -> h let create l x d r = let hl = height l and hr = height r in Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1)) let bal l x d r = let hl = match l with Empty -> 0 | Node(_,_,_,_,h) -> h in let hr = match r with Empty -> 0 | Node(_,_,_,_,h) -> h in if hl > hr + 2 then begin match l with Empty -> invalid_arg "Map.bal" | Node(ll, lv, ld, lr, _) -> if height ll >= height lr then create ll lv ld (create lr x d r) else begin match lr with Empty -> invalid_arg "Map.bal" | Node(lrl, lrv, lrd, lrr, _)-> create (create ll lv ld lrl) lrv lrd (create lrr x d r) end end else if hr > hl + 2 then begin match r with Empty -> invalid_arg "Map.bal" | Node(rl, rv, rd, rr, _) -> if height rr >= height rl then create (create l x d rl) rv rd rr else begin match rl with Empty -> invalid_arg "Map.bal" | Node(rll, rlv, rld, rlr, _) -> create (create l x d rll) rlv rld (create rlr rv rd rr) end end else Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1)) let empty = Empty let is_empty = function Empty -> true | _ -> false let rec add x data = function Empty -> Node(Empty, x, data, Empty, 1) | Node(l, v, d, r, h) -> let c = Ord.compare x v in if c = 0 then Node(l, x, data, r, h) else if c < 0 then bal (add x data l) v d r else bal l v d (add x data r) let rec find x = function Empty -> raise Not_found | Node(l, v, d, r, _) -> let c = Ord.compare x v in if c = 0 then d else find x (if c < 0 then l else r) let rec findi x = function Empty -> raise Not_found | Node(l, v, d, r, _) -> let c = Ord.compare x v in if c = 0 then (v, d) else findi x (if c < 0 then l else r) let rec mem x = function Empty -> false | Node(l, v, d, r, _) -> let c = Ord.compare x v in c = 0 || mem x (if c < 0 then l else r) let rec min_binding = function Empty -> raise Not_found | Node(Empty, x, d, r, _) -> (x, d) | Node(l, x, d, r, _) -> min_binding l let rec remove_min_binding = function Empty -> invalid_arg "Map.remove_min_elt" | Node(Empty, x, d, r, _) -> r | Node(l, x, d, r, _) -> bal (remove_min_binding l) x d r let merge t1 t2 = match (t1, t2) with (Empty, t) -> t | (t, Empty) -> t | (_, _) -> let (x, d) = min_binding t2 in bal t1 x d (remove_min_binding t2) let rec remove x = function Empty -> Empty | Node(l, v, d, r, h) -> let c = Ord.compare x v in if c = 0 then merge l r else if c < 0 then bal (remove x l) v d r else bal l v d (remove x r) let rec iter f = function Empty -> () | Node(l, v, d, r, _) -> iter f l; f v d; iter f r let rec map f = function Empty -> Empty | Node(l, v, d, r, h) -> Node(map f l, v, f d, map f r, h) let rec mapi f = function Empty -> Empty | Node(l, v, d, r, h) -> Node(mapi f l, v, f v d, mapi f r, h) let rec mapii f = function Empty -> Empty | Node(l, v, d, r, h) -> let l' = mapii f l in let (v', d') = f v d in if v' != v && Ord.compare v v' <> 0 then invalid_arg "Map.mapii"; let r' = mapii f r in Node(l', v', d', r', h) let rec fold f m accu = match m with Empty -> accu | Node(l, v, d, r, _) -> fold f l (f v d (fold f r accu)) type 'a enumeration = End | More of key * 'a * 'a t * 'a enumeration let rec cons_enum m e = match m with Empty -> e | Node(l, v, d, r, _) -> cons_enum l (More(v, d, r, e)) let compare cmp m1 m2 = let rec compare_aux e1 e2 = match (e1, e2) with (End, End) -> 0 | (End, _) -> -1 | (_, End) -> 1 | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) -> let c = Ord.compare v1 v2 in if c <> 0 then c else let c = cmp d1 d2 in if c <> 0 then c else compare_aux (cons_enum r1 e1) (cons_enum r2 e2) in compare_aux (cons_enum m1 End) (cons_enum m2 End) let equal cmp m1 m2 = let rec equal_aux e1 e2 = match (e1, e2) with (End, End) -> true | (End, _) -> false | (_, End) -> false | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) -> Ord.compare v1 v2 = 0 && cmp d1 d2 && equal_aux (cons_enum r1 e1) (cons_enum r2 e2) in equal_aux (cons_enum m1 End) (cons_enum m2 End) let val_combine r r' = match r, r' with `Ok , _ -> r' | `Duplicate _, `Ok -> r | `Duplicate _, _ -> r' | _ , _ -> r let rec validate_both v m v' = match m with Empty -> `Ok | Node (l, v'', _, r, _) -> val_combine (val_combine (let c = Ord.compare v'' v' in if c < 0 then `Ok else if c = 0 then `Duplicate v'' else `Invalid) (let c = Ord.compare v v'' in if c < 0 then `Ok else if c = 0 then `Duplicate v'' else `Invalid)) (val_combine (validate_both v l v'') (validate_both v'' r v')) let rec validate_left m v = match m with Empty -> `Ok | Node (l, v', _, r, _) -> val_combine (let c = Ord.compare v' v in if c < 0 then `Ok else if c = 0 then `Duplicate v' else `Invalid) (val_combine (validate_left l v') (validate_both v' r v)) let rec validate_right v m = match m with Empty -> `Ok | Node (l, v', _, r, _) -> val_combine (let c = Ord.compare v v' in if c < 0 then `Ok else if c = 0 then `Duplicate v' else `Invalid) (val_combine (validate_both v l v') (validate_right v' r)) let validate m = match m with Empty -> `Ok | Node (l, v, _, r, _) -> val_combine (validate_left l v) (validate_right v r) end unison-2.32.52/ubase/myMap.mli0000644000076500000000000001244411176730177015536 0ustar bcpiercewheel(* This file is taken from the Objective Caml standard library. Some functions has been added to suite Unison needs. *) (***********************************************************************) (* *) (* Objective Caml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) (* under the terms of the GNU Library General Public License, with *) (* the special exception on linking described in file ../LICENSE. *) (* *) (***********************************************************************) (** Association tables over ordered types. This module implements applicative association tables, also known as finite maps or dictionaries, given a total ordering function over the keys. All operations over maps are purely applicative (no side-effects). The implementation uses balanced binary trees, and therefore searching and insertion take time logarithmic in the size of the map. *) module type OrderedType = sig type t (** The type of the map keys. *) val compare : t -> t -> int (** A total ordering function over the keys. This is a two-argument function [f] such that [f e1 e2] is zero if the keys [e1] and [e2] are equal, [f e1 e2] is strictly negative if [e1] is smaller than [e2], and [f e1 e2] is strictly positive if [e1] is greater than [e2]. Example: a suitable ordering function is the generic structural comparison function {!Pervasives.compare}. *) end (** Input signature of the functor {!Map.Make}. *) module type S = sig type key (** The type of the map keys. *) type (+'a) t (** The type of maps from type [key] to type ['a]. *) val empty: 'a t (** The empty map. *) val is_empty: 'a t -> bool (** Test whether a map is empty or not. *) val add: key -> 'a -> 'a t -> 'a t (** [add x y m] returns a map containing the same bindings as [m], plus a binding of [x] to [y]. If [x] was already bound in [m], its previous binding disappears. *) val find: key -> 'a t -> 'a (** [find x m] returns the current binding of [x] in [m], or raises [Not_found] if no such binding exists. *) val findi: key -> 'a t -> key * 'a (** [find x m] returns the current binding of [x] in [m], or raises [Not_found] if no such binding exists. *) val remove: key -> 'a t -> 'a t (** [remove x m] returns a map containing the same bindings as [m], except for [x] which is unbound in the returned map. *) val mem: key -> 'a t -> bool (** [mem x m] returns [true] if [m] contains a binding for [x], and [false] otherwise. *) val iter: (key -> 'a -> unit) -> 'a t -> unit (** [iter f m] applies [f] to all bindings in map [m]. [f] receives the key as first argument, and the associated value as second argument. The bindings are passed to [f] in increasing order with respect to the ordering over the type of the keys. Only current bindings are presented to [f]: bindings hidden by more recent bindings are not passed to [f]. *) val map: ('a -> 'b) -> 'a t -> 'b t (** [map f m] returns a map with same domain as [m], where the associated value [a] of all bindings of [m] has been replaced by the result of the application of [f] to [a]. The bindings are passed to [f] in increasing order with respect to the ordering over the type of the keys. *) val mapi: (key -> 'a -> 'b) -> 'a t -> 'b t (** Same as {!Map.S.map}, but the function receives as arguments both the key and the associated value for each binding of the map. *) val mapii: (key -> 'a -> key * 'b) -> 'a t -> 'b t (** Same as {!Map.S.map}, but the function receives as arguments both the key and the associated value for each binding of the map. *) val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b (** [fold f m a] computes [(f kN dN ... (f k1 d1 a)...)], where [k1 ... kN] are the keys of all bindings in [m] (in increasing order), and [d1 ... dN] are the associated data. *) val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int (** Total ordering between maps. The first argument is a total ordering used to compare data associated with equal keys in the two maps. *) val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool (** [equal cmp m1 m2] tests whether the maps [m1] and [m2] are equal, that is, contain equal keys and associate them with equal data. [cmp] is the equality predicate used to compare the data associated with the keys. *) val validate: 'a t -> [`Ok | `Duplicate of key | `Invalid] end (** Output signature of the functor {!Map.Make}. *) module Make (Ord : OrderedType) : S with type key = Ord.t (** Functor building an implementation of the map structure given a totally ordered type. *) unison-2.32.52/ubase/prefs.ml0000644000076500000000000003417611176730177015427 0ustar bcpiercewheel(* Unison file synchronizer: src/ubase/prefs.ml *) (* $I3: Copyright 1999-2002 (see COPYING for details) $ *) let debug = Util.debug "prefs" type 'a t = ('a * string list) ref let read p = fst !p let set p v = p:=(v, snd !p) let name p = snd !p let rawPref default = ref default (* ------------------------------------------------------------------------- *) let profileName = ref None let profilePathname n = let f = Util.fileInUnisonDir n in if Sys.file_exists f then f else Util.fileInUnisonDir (n ^ ".prf") let thePrefsFile () = match !profileName with None -> raise (Util.Transient("No preference file has been specified")) | Some(n) -> profilePathname n (* ------------------------------------------------------------------------- *) (* When preferences change, we need to dump them out to the file we loaded *) (* them from. This is accomplished by associating each preference with a *) (* printing function. *) let printers = ref ([] : (string * (unit -> string list)) list) let addprinter name f = printers := (name, f) :: !printers (* ---------------------------------------------------------------------- *) (* When we load a new profile, we need to reset all preferences to their *) (* default values. Each preference has a resetter for doing this. *) let resetters = ref [] let addresetter f = resetters := f :: !resetters let resetToDefaults () = Safelist.iter (fun f -> f()) !resetters (* ------------------------------------------------------------------------- *) (* When the server starts up, we need to ship it the current state of all *) (* the preference settings. This is accomplished by dumping them on the *) (* client side and loading on the server side; as each preference is *) (* created, a dumper (marshaler) and a loader (parser) are added to the list *) (* kept here... *) type dumpedPrefs = (string * string) list let dumpers = ref ([] : (string * (unit->string)) list) let loaders = ref (Util.StringMap.empty : (string->unit) Util.StringMap.t) let adddumper name f = dumpers := (name,f) :: !dumpers let addloader name f = loaders := Util.StringMap.add name f !loaders let dump () = Safelist.map (fun (name,f) -> (name, f())) !dumpers let load d = begin Safelist.iter (fun (name, dumpedval) -> let loaderfn = try Util.StringMap.find name !loaders with Not_found -> raise (Util.Fatal ("Preference "^name^" not found: inconsistent Unison versions??")) in loaderfn dumpedval) d end (* For debugging *) let dumpPrefsToStderr() = Printf.eprintf "Preferences:\n"; Safelist.iter (fun (name,f) -> Safelist.iter (fun s -> Printf.eprintf "%s = %s\n" name s) (f())) !printers (* ------------------------------------------------------------------------- *) (* Each preference is associated with a handler function taking an argument *) (* of appropriate type. These functions should raise IllegalValue if they *) (* are invoked with a value that falls outside the range they expect. This *) (* exception will be caught within the preferences module and used to *) (* generate an appropriate usage message. *) exception IllegalValue of string (* prefs: prefName -> (doc, pspec, fulldoc) *) let prefs = ref (Util.StringMap.empty : (string * Uarg.spec * string) Util.StringMap.t) (* aliased pref has *-prefixed doc and empty fulldoc *) let alias pref newname = (* pref must have been registered, so name pref is not empty, and will be *) (* found in the map, no need for catching exception *) let (_,pspec,_) = Util.StringMap.find (Safelist.hd (name pref)) !prefs in prefs := Util.StringMap.add newname ("*", pspec, "") !prefs; pref := (fst !pref, newname::(snd !pref)) let registerPref name pspec doc fulldoc = if Util.StringMap.mem name !prefs then raise (Util.Fatal ("Preference " ^ name ^ " registered twice")); prefs := Util.StringMap.add name (doc, pspec, fulldoc) !prefs let createPrefInternal name default doc fulldoc printer parsefn = let newCell = rawPref (default, [name]) in registerPref name (parsefn newCell) doc fulldoc; adddumper name (fun () -> Marshal.to_string !newCell []); addprinter name (fun () -> printer (fst !newCell)); addresetter (fun () -> newCell := (default, [name])); addloader name (fun s -> newCell := Marshal.from_string s 0); newCell let create name default doc fulldoc intern printer = createPrefInternal name default doc fulldoc printer (fun cell -> Uarg.String (fun s -> set cell (intern (fst !cell) s))) let createBool name default doc fulldoc = let doc = if default then doc ^ " (default true)" else doc in createPrefInternal name default doc fulldoc (fun v -> [if v then "true" else "false"]) (fun cell -> Uarg.Bool (fun b -> set cell b)) let createInt name default doc fulldoc = createPrefInternal name default doc fulldoc (fun v -> [string_of_int v]) (fun cell -> Uarg.Int (fun i -> set cell i)) let createString name default doc fulldoc = createPrefInternal name default doc fulldoc (fun v -> [v]) (fun cell -> Uarg.String (fun s -> set cell s)) let createStringList name doc fulldoc = createPrefInternal name [] doc fulldoc (fun v -> v) (fun cell -> Uarg.String (fun s -> set cell (s::(fst !cell)))) (*****************************************************************************) (* Command-line parsing *) (*****************************************************************************) let prefArg = function Uarg.Bool(_) -> "" | Uarg.Int(_) -> "n" | Uarg.String(_) -> "xxx" | _ -> assert false let argspecs hook = Util.StringMap.fold (fun name (doc, pspec, _) l -> ("-" ^ name, hook name pspec, "")::l) !prefs [] let oneLineDocs u = let formatOne name pspec doc p = if not p then "" else let doc = if doc.[0] = '!' then String.sub doc 1 ((String.length doc) - 1) else doc in let arg = prefArg pspec in let arg = if arg = "" then "" else " " ^ arg in let spaces = String.make (max 1 (18 - String.length (name ^ arg))) ' ' in " -" ^ name ^ arg ^ spaces ^ doc ^ "\n" in let formatAll p = String.concat "" (Safelist.rev (Util.StringMap.fold (fun name (doc, pspec, _) l -> (formatOne name pspec doc (String.length doc > 0 && doc.[0] <> '*' && p doc)) :: l) !prefs [])) in u ^ "\n" ^ "Basic options: \n" ^ formatAll (fun doc -> doc.[0] <> '!') ^ "\nAdvanced options: \n" ^ formatAll (fun doc -> doc.[0] = '!') let printUsage usage = Uarg.usage (argspecs (fun _ s -> s)) (oneLineDocs usage) let processCmdLine usage hook = Uarg.current := 0; let argspecs = argspecs hook in let defaultanonfun _ = print_string "Anonymous arguments not allowed\n"; Uarg.usage argspecs (oneLineDocs usage); exit 2 in let anonfun = try let (_, p, _) = Util.StringMap.find "rest" !prefs in match hook "rest" p with Uarg.String stringFunction -> stringFunction | _ -> defaultanonfun with Not_found -> defaultanonfun in try Uarg.parse argspecs anonfun (oneLineDocs usage) with IllegalValue str -> raise(Util.Fatal(Printf.sprintf "%s \n%s\n" (oneLineDocs usage) str)) let parseCmdLine usage = processCmdLine usage (fun _ sp -> sp) (* Scan command line without actually setting any preferences; return a *) (* string map associating a list of strings with each option appearing on *) (* the command line. *) let scanCmdLine usage = let m = ref (Util.StringMap.empty : (string list) Util.StringMap.t) in let insert name s = let old = try Util.StringMap.find name !m with Not_found -> [] in m := Util.StringMap.add name (s :: old) !m in processCmdLine usage (fun name p -> match p with Uarg.Bool _ -> Uarg.Bool (fun b -> insert name (string_of_bool b)) | Uarg.Int _ -> Uarg.Int (fun i -> insert name (string_of_int i)) | Uarg.String _ -> Uarg.String (fun s -> insert name s) | _ -> assert false); !m (*****************************************************************************) (* Preferences file parsing *) (*****************************************************************************) let string2bool name = function "true" -> true | "false" -> false | other -> raise (Util.Fatal (name^" expects a boolean value, but \n"^other ^ " is not a boolean")) let string2int name string = try int_of_string string with Failure "int_of_string" -> raise (Util.Fatal (name ^ " expects an integer value, but\n" ^ string ^ " is not an integer")) (* Takes a filename and returns a list of "parsed lines" containing (filename, lineno, varname, value) in the same order as in the file. *) let rec readAFile filename : (string * int * string * string) list = let chan = try open_in (profilePathname filename) with Sys_error _ -> raise(Util.Fatal(Printf.sprintf "Preference file %s not found" filename)) in let rec loop lines = match (try Some(input_line chan) with End_of_file -> None) with None -> close_in chan; parseLines filename lines | Some(theLine) -> loop (theLine::lines) in loop [] (* Takes a list of strings in reverse order and yields a list of "parsed lines" in correct order *) and parseLines filename lines = let rec loop lines lineNum res = match lines with [] -> res | theLine :: rest -> let l = Util.trimWhitespace theLine in if l = "" || l.[0]='#' then loop rest (lineNum+1) res else if Util.startswith theLine "include " then match Util.splitIntoWords theLine ' ' with [_;f] -> let sublines = readAFile f in loop rest (lineNum+1) (Safelist.append sublines res) | _ -> raise (Util.Fatal(Printf.sprintf "File \"%s\", line %d:\nGarbled 'include' directive: %s" filename lineNum theLine)) else try let pos = String.index theLine '=' in let varName = Util.trimWhitespace (String.sub theLine 0 pos) in let theResult = Util.trimWhitespace (String.sub theLine (pos+1) (String.length theLine - pos - 1)) in loop rest (lineNum+1) ((filename, lineNum, varName, theResult)::res) with Not_found -> (* theLine does not contain '=' *) raise(Util.Fatal(Printf.sprintf "File \"%s\", line %d:\nGarbled line (no '='):\n%s" filename lineNum theLine)) in loop lines 1 [] let processLines lines = Safelist.iter (fun (fileName, lineNum, varName,theResult) -> try let _, theFunction, _ = Util.StringMap.find varName !prefs in match theFunction with Uarg.Bool boolFunction -> boolFunction (string2bool varName theResult) | Uarg.Int intFunction -> intFunction (string2int varName theResult) | Uarg.String stringFunction -> stringFunction theResult | _ -> assert false with Not_found -> raise (Util.Fatal ("File \""^ fileName ^ "\", line " ^ string_of_int lineNum ^ ": `" ^ varName ^ "' is not a valid option")) | IllegalValue str -> raise(Util.Fatal("File \""^ fileName ^ "\", line " ^ string_of_int lineNum ^ ": " ^ str))) lines let loadTheFile () = match !profileName with None -> () | Some(n) -> processLines(readAFile n) let loadStrings l = processLines (parseLines "" l) (*****************************************************************************) (* Printing *) (*****************************************************************************) let listVisiblePrefs () = let l = Util.StringMap.fold (fun name (_, pspec, fulldoc) l -> if String.length fulldoc > 0 then begin (name, pspec, fulldoc) :: l end else l) !prefs [] in Safelist.stable_sort (fun (name1,_,_) (name2,_,_) -> compare name1 name2) l let printFullDocs () = Printf.eprintf "\\begin{description}\n"; Safelist.iter (fun (name, pspec, fulldoc) -> Printf.eprintf "\\item [{%s \\tt %s}]\n%s\n\n" name (prefArg pspec) fulldoc) (listVisiblePrefs()); Printf.eprintf "\\end{description}\n" (*****************************************************************************) (* Adding stuff to the prefs file *) (*****************************************************************************) let addprefsto = createString "addprefsto" "" "!file to add new prefs to" "By default, new preferences added by Unison (e.g., new \\verb|ignore| \ clauses) will be appended to whatever preference file Unison was told \ to load at the beginning of the run. Setting the preference \ \\texttt{addprefsto \\ARG{filename}} makes Unison \ add new preferences to the file named \\ARG{filename} instead." let addLine l = let filename = if read addprefsto <> "" then profilePathname (read addprefsto) else thePrefsFile() in try debug (fun() -> Util.msg "Adding '%s' to %s\n" l filename); let resultmsg = l ^ "' added to profile " ^ filename in let ochan = open_out_gen [Open_wronly; Open_append; Open_creat] 0o600 filename in output_string ochan l; output_string ochan "\n"; close_out ochan; resultmsg with Sys_error e -> begin let resultmsg = (Printf.sprintf "Could not write preferences file (%s)\n" e) in Util.warn resultmsg; resultmsg end let add name value = addLine (name ^ " = " ^ value) let addComment c = ignore (addLine ("# " ^ c)) unison-2.32.52/ubase/prefs.mli0000644000076500000000000001206611176730177015572 0ustar bcpiercewheel(* Unison file synchronizer: src/ubase/prefs.mli *) (* $I3: Copyright 1999-2002 (see COPYING for details) $ *) type 'a t val read : 'a t -> 'a val set : 'a t -> 'a -> unit val name : 'a t -> string list (* Convenient functions for registering simple kinds of preferences. Note *) (* that createStringPref creates a preference that can only be set once, *) (* while createStringListPref creates a reference to a list of strings that *) (* accumulates a list of values. *) val createBool : string (* preference name *) -> bool (* initial value *) -> string (* documentation string *) -> string (* full (tex) documentation string *) -> bool t (* -> new preference value *) val createInt : string (* preference name *) -> int (* initial value *) -> string (* documentation string *) -> string (* full (tex) documentation string *) -> int t (* -> new preference value *) val createString : string (* preference name *) -> string (* initial value *) -> string (* documentation string *) -> string (* full (tex) documentation string *) -> string t (* -> new preference value *) val createStringList : string (* preference name *) -> string (* documentation string *) -> string (* full (tex) documentation string *) -> string list t (* -> new preference value *) exception IllegalValue of string (* A more general creation function that allows arbitrary functions for *) (* interning and printing values. The interning function should raise *) (* IllegalValue if it is passed a string it cannot deal with. *) val create : string (* preference name *) -> 'a (* initial value *) -> string (* documentation string *) -> string (* full (tex) documentation string *) -> ('a->string->'a) (* interning function for preference values (1st arg is old value of preference) *) -> ('a -> string list) (* printing function for preference values *) -> 'a t (* -> new preference value *) (* Create an alternate name for a preference (the new name will not appear *) (* in usage messages or generated documentation) *) val alias : 'a t (* existing preference *) -> string (* new name *) -> unit (* Reset all preferences to their initial values *) val resetToDefaults : unit -> unit (* ------------------------------------------------------------------------- *) (* Parse command-line arguments, exiting program if there are any problems. *) (* If a StringList preference named "rest" has been registered, then any *) (* anonymous arguments on the command line will be added to its value. *) val parseCmdLine : string (* Usage message *) -> unit (* Make a preliminary scan without setting any preferences *) val scanCmdLine : string -> (string list) Util.StringMap.t val printUsage : string -> unit (* ---------------------------------------------------------------------- *) (* The name of the preferences file (if any), not including the .prf *) val profileName : string option ref (* Calculate the full pathname of a preference file *) val profilePathname : string -> string (* Add a new preference to the file on disk (the result is a diagnostic *) (* message that can be displayed to the user to verify where the new pref *) (* went) *) val add : string -> string -> string (* Add a comment line to the preferences file on disk *) val addComment : string -> unit (* Scan a given preferences file and return a list of tuples of the form *) (* (fileName, lineno, name, value), without changing any of the preferences *) val readAFile : string -> (string * int * string * string) list (* Parse the preferences file, raising Fatal if there are any problems *) val loadTheFile : unit -> unit (* Parse the given strings as if they were part of the preferences file *) val loadStrings : string list -> unit (* ------------------------------------------------------------------------- *) type dumpedPrefs (* Dump current values of all preferences into a value that can be marshalled and sent over the network or stored in a file for fast retrieval *) val dump : unit -> dumpedPrefs (* Load new values of all preferences from a string created by dump *) val load : dumpedPrefs -> unit (* ------------------------------------------------------------------------- *) val printFullDocs : unit -> unit val dumpPrefsToStderr : unit -> unit unison-2.32.52/ubase/rx.ml0000644000076500000000000005612611176730177014740 0ustar bcpiercewheel(* Unison file synchronizer: src/ubase/rx.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) (* Inspired by some code and algorithms from Mark William Hopkins (regexp.tar.gz, available in the comp.compilers file archive) *) (* Missing POSIX features ---------------------- - Collating sequences *) type v = Cst of int list | Alt of u list | Seq of u list | Rep of u * int * int option | Bol | Eol | Int of u list | Dif of u * u and u = { desc : v; hash : int } (****) let hash x = match x with Cst l -> List.fold_left (fun h i -> h + 757 * i) 0 l | Alt l -> 199 * List.fold_left (fun h y -> h + 883 * y.hash) 0 l | Seq l -> 821 * List.fold_left (fun h y -> h + 883 * y.hash) 0 l | Rep (y, i, Some j) -> 197 * y.hash + 137 * i + j | Rep (y, i, None) -> 197 * y.hash + 137 * i + 552556457 | Bol -> 165160782 | Eol -> 152410806 | Int l -> 71 * List.fold_left (fun h y -> h + 883 * y.hash) 0 l | Dif (y, z) -> 379 * y.hash + 563 * z.hash let make x = {desc = x; hash = hash x} let epsilon = make (Seq []) let empty = make (Alt []) (**** Printing ****) open Format let print_list sep print l = match l with [] -> () | v::r -> print v; List.iter (fun v -> sep (); print v) r let rec print n t = match t.desc with Cst l -> open_box 1; print_string "["; print_list print_space print_int l; print_string "]"; close_box () | Alt tl -> if n > 0 then begin open_box 1; print_string "(" end; print_list (fun () -> print_string "|"; print_cut ()) (print 1) tl; if n > 0 then begin print_string ")"; close_box () end | Seq tl -> if n > 1 then begin open_box 1; print_string "(" end; print_list (fun () -> print_cut ()) (print 2) tl; if n > 1 then begin print_string ")"; close_box () end | Rep (t, 0, None) -> print 2 t; print_string "*" | Rep (t, i, None) -> print 2 t; print_string "{"; print_int i; print_string ",}" | Rep (t, i, Some j) -> print 2 t; print_string "{"; print_int i; print_string ","; print_int j; print_string "}" | _ -> assert false (**** Constructors for regular expressions *) let seq2 x y = match x.desc, y.desc with Alt [], _ | _, Alt [] -> empty | Seq [], s -> y | r, Seq [] -> x | Seq r, Seq s -> make (Seq (r @ s)) | Seq r, _ -> make (Seq (r @ [y])) | _, Seq s -> make (Seq (x :: s)) | r, s -> make (Seq [x; y]) let seq l = List.fold_right seq2 l epsilon let seq' l = match l with [] -> epsilon | [x] -> x | _ -> make (Seq l) let rec alt_merge r s = match r, s with [], _ -> s | _, [] -> r | {desc = Seq (x::m)} :: s, {desc = Seq (y::n)} :: r when x = y -> alt_merge (seq2 x (alt2 (seq' m) (seq' n))::s) r | x :: r', y :: s' -> let c = compare x y in if c = 0 then x :: alt_merge r' s' else if c < 0 then x :: alt_merge r' s else (* if c > 0 then *) y :: alt_merge r s' and alt2 x y = let c = compare x y in if c = 0 then x else match x.desc, y.desc with Alt [], _ -> y | _, Alt [] -> x | Alt r, Alt s -> make (Alt (alt_merge r s)) | Alt [r], _ when r = y -> y | _, Alt [s] when x = s -> x | Alt r, _ -> make (Alt (alt_merge r [y])) | _, Alt s -> make (Alt (alt_merge [x] s)) | Seq (r::m), Seq (s::n) when r = s -> seq2 r (alt2 (seq' m) (seq' n)) | _, _ -> make (if c < 0 then Alt [x; y] else Alt [y; x]) let alt l = List.fold_right alt2 l empty let rep x i j = match x.desc with Alt [] when i > 0 -> empty | Alt [] | Seq [] -> epsilon | _ -> match i, j with _, Some 0 -> epsilon | 0, Some 1 -> alt2 epsilon x | 1, Some 1 -> x | _ -> make (Rep (x, i, j)) let rec int2 x y = let c = compare x y in if c = 0 then x else match x.desc, y.desc with Int [], _ -> y | _, Int [] -> x | Int r, Int s -> make (Int (alt_merge r s)) | Int [r], _ when r = y -> y | _, Int [s] when s = x -> x | Int r, _ -> make (Int (alt_merge r [y])) | _, Int s -> make (Int (alt_merge [x] s)) | _, _ -> make (if c < 0 then Int [x; y] else Int [y; x]) let int l = List.fold_right int2 l empty let cst c = Cst [Char.code c] let rec dif x y = if x = y then empty else match x.desc, y.desc with Dif (x1, y1), _ -> dif x1 (alt2 y1 y) | Alt [], _ -> empty | _, Alt [] -> x | _ -> make (Dif (x, y)) (**** Computation of the next states of an automata ****) type pos = Pos_bol | Pos_other let never = 0 let always = (-1) let when_eol = 2 let combine top bot op f l = let rec combine v l = match l with [] -> v | a::r -> let c = f a in if c = bot then c else combine (op v c) r in combine top l module ReTbl = Hashtbl.Make (struct type t = u let equal x y = x.hash = y.hash && x = y let hash x = x.hash end) let h = ReTbl.create 101 let rec contains_epsilon pos x = try ReTbl.find h x with Not_found -> let res = match x.desc with Cst _ -> never | Alt l -> combine never always (lor) (contains_epsilon pos) l | Seq l -> combine always never (land) (contains_epsilon pos) l | Rep (_, 0, _) -> always | Rep (y, _, _) -> contains_epsilon pos y | Bol -> if pos = Pos_bol then always else never | Eol -> when_eol | Int l -> combine always never (land) (contains_epsilon pos) l | Dif (y, z) -> contains_epsilon pos y land (lnot (contains_epsilon pos z)) in ReTbl.add h x res; res module DiffTbl = Hashtbl.Make (struct type t = int * u let equal ((c : int), x) (d, y) = c = d && x.hash = y.hash && x = y let hash (c, x) = x.hash + 11 * c end) let diff_cache = DiffTbl.create 101 let rec delta_seq nl pos c l = match l with [] -> empty | x::r -> let rdx = seq2 (delta nl pos c x) (seq' r) in let eps = contains_epsilon pos x in if eps land always = always then alt2 rdx (delta_seq nl pos c r) else if eps land when_eol = when_eol && c = nl then alt2 rdx (delta_seq nl pos c r) else rdx and delta nl pos c x = let p = (c, x) in try DiffTbl.find diff_cache p with Not_found -> let res = match x.desc with Cst l -> if List.mem c l then epsilon else empty | Alt l -> alt (List.map (delta nl pos c) l) | Seq l -> delta_seq nl pos c l | Rep (y, 0, None) -> seq2 (delta nl pos c y) x | Rep (y, i, None) -> seq2 (delta nl pos c y) (rep y (i - 1) None) | Rep (y, 0, Some j) -> seq2 (delta nl pos c y) (rep y 0 (Some (j - 1))) | Rep (y, i, Some j) -> seq2 (delta nl pos c y) (rep y (i - 1) (Some (j-1))) | Eol | Bol -> empty | Int l -> int (List.map (delta nl pos c) l) | Dif (y, z) -> dif (delta nl pos c y) (delta nl pos c z) in DiffTbl.add diff_cache p res; res (**** String matching ****) type state = { mutable valid : bool; mutable next : state array; pos : pos; final : bool; desc : u } type rx = { initial : state; categ : int array; ncat : int; states : state ReTbl.t } let unknown = { valid = false; next = [||]; desc = empty ; pos = Pos_bol; final = false } let mk_state ncat pos desc = { valid = desc <> empty; next = Array.make ncat unknown; pos = pos; desc = desc; final = contains_epsilon pos desc <> 0 } let find_state states ncat pos desc = try ReTbl.find states desc with Not_found -> let st = mk_state ncat pos desc in ReTbl.add states desc st; st let rec validate s i l rx cat st c = let nl = cat.(Char.code '\n') in let desc = delta nl st.pos c st.desc in st.next.(c) <- find_state rx.states rx.ncat (if c = nl then Pos_bol else Pos_other) desc; loop s i l rx cat st and loop s i l rx cat st = let rec loop i st = let c = Array.unsafe_get cat (Char.code (String.unsafe_get s i)) in let st' = Array.unsafe_get st.next c in if st'.valid then begin let i = i + 1 in if i < l then loop i st' else st'.final end else if st' != unknown then false else validate s i l rx cat st c in loop i st let match_str rx s = let l = String.length s in if l = 0 then rx.initial.final else loop s 0 l rx rx.categ rx.initial (* Combining the final and valid fields may make things slightly faster (one less memory access) *) let rec validate_pref s i l l0 rx cat st c = let nl = cat.(Char.code '\n') in let desc = delta nl st.pos c st.desc in st.next.(c) <- find_state rx.states rx.ncat (if c = nl then Pos_bol else Pos_other) desc; loop_pref s i l l0 rx cat st and loop_pref s i l l0 rx cat st = let rec loop i l0 st = let c = Array.unsafe_get cat (Char.code (String.unsafe_get s i)) in let st' = Array.unsafe_get st.next c in if st'.valid then begin let i = i + 1 in let l0 = if st'.final then i else l0 in if i < l then loop i l0 st' else l0 end else if st' != unknown then l0 else validate_pref s i l l0 rx cat st c in loop i l0 st let match_pref rx s p = let l = String.length s in if p < 0 || p > l then invalid_arg "Rx.rep"; let l0 = if rx.initial.final then p else -1 in let l0 = if l = p then l0 else loop_pref s p l l0 rx rx.categ rx.initial in if l0 >= 0 then Some (l0 - p) else None let mk_rx init categ ncat = let states = ReTbl.create 97 in { initial = find_state states ncat Pos_bol init; categ = categ; ncat = ncat; states = states } (**** Character sets ****) let rec cunion l l' = match l, l' with _, [] -> l | [], _ -> l' | (c1, c2)::r, (c1', c2')::r' -> if c2 + 1 < c1' then (c1, c2)::cunion r l' else if c2' + 1 < c1 then (c1', c2')::cunion l r' else if c2 < c2' then cunion r ((min c1 c1', c2')::r') else cunion ((min c1 c1', c2)::r) r' let rec cinter l l' = match l, l' with _, [] -> [] | [], _ -> [] | (c1, c2)::r, (c1', c2')::r' -> if c2 < c1' then cinter r l' else if c2' < c1 then cinter l r' else if c2 < c2' then (max c1 c1', c2)::cinter r l' else (max c1 c1', c2')::cinter l r' let rec cnegate mi ma l = match l with [] -> if mi <= ma then [(mi, ma)] else [] | (c1, c2)::r when ma < c1 -> if mi <= ma then [(mi, ma)] else [] | (c1, c2)::r when mi < c1 -> (mi, c1 - 1) :: cnegate c1 ma l | (c1, c2)::r (* when c1 <= mi *) -> cnegate (max mi (c2 + 1)) ma r let csingle c = let i = Char.code c in [i, i] let cadd c l = cunion (csingle c) l let cseq c c' = let i = Char.code c in let i' = Char.code c' in if i <= i' then [i, i'] else [i', i] let rec ctrans o l = match l with [] -> [] | (c1, c2) :: r -> if c2 + o < 0 || c1 + o > 255 then ctrans o r else (c1 + o, c2 + o) :: ctrans o r let cany = [0, 255] type cset = (int * int) list (**** Compilation of a regular expression ****) type regexp = Set of cset | Sequence of regexp list | Alternative of regexp list | Repeat of regexp * int * int option | Beg_of_line | End_of_line | Intersection of regexp list | Difference of regexp * regexp let rec split s cm = match s with [] -> () | (i, j)::r -> cm.(i) <- true; cm.(j + 1) <- true; split r cm let rec colorize c regexp = let rec colorize regexp = match regexp with Set s -> split s c | Sequence l -> List.iter colorize l | Alternative l -> List.iter colorize l | Repeat (r, _, _) -> colorize r | Beg_of_line | End_of_line -> split (csingle '\n') c | Intersection l -> List.iter colorize l | Difference (s, t) -> colorize s; colorize t in colorize regexp let make_cmap () = Array.make 257 false let flatten_cmap cm = let c = Array.make 256 0 in let v = ref 0 in for i = 1 to 255 do if cm.(i) then incr v; c.(i) <- !v done; (c, !v + 1) let rec interval i j = if i > j then [] else i :: interval (i + 1) j let rec cset_hash_rec l = match l with [] -> 0 | (i, j)::r -> i + 13 * j + 257 * cset_hash_rec r let cset_hash l = (cset_hash_rec l) land 0x3FFFFFFF module CSetMap = Map.Make (struct type t = int * (int * int) list let compare (i, u) (j, v) = let c = compare i j in if c <> 0 then c else compare u v end) let trans_set cache cm s = match s with [i, j] when i = j -> [cm.(i)] | _ -> let v = (cset_hash_rec s, s) in try CSetMap.find v !cache with Not_found -> let l = List.fold_right (fun (i, j) l -> cunion [cm.(i), cm.(j)] l) s [] in let res = List.flatten (List.map (fun (i, j) -> interval i j) l) in cache := CSetMap.add v res !cache; res let rec trans_seq cache c r rem = match r with Sequence l -> List.fold_right (trans_seq cache c) l rem | _ -> seq2 (translate cache c r) rem and translate cache c r = match r with Set s -> make (Cst (trans_set cache c s)) | Alternative l -> alt (List.map (translate cache c) l) | Sequence l -> trans_seq cache c r epsilon | Repeat (r', i, j) -> rep (translate cache c r') i j | Beg_of_line -> make Bol | End_of_line -> make Eol | Intersection l -> int (List.map (translate cache c) l) | Difference (r', r'') -> dif (translate cache c r') (translate cache c r'') let compile regexp = let c = make_cmap () in colorize c regexp; let (cat, ncat) = flatten_cmap c in let r = translate (ref (CSetMap.empty)) cat regexp in mk_rx r cat ncat (**** Regexp type ****) type t = {def : regexp; mutable comp: rx option; mutable comp': rx option} let force r = match r.comp with Some r' -> r' | None -> let r' = compile r.def in r.comp <- Some r'; r' let anything = Repeat (Set [0, 255], 0, None) let force' r = match r.comp' with Some r' -> r' | None -> let r1 = Sequence [anything; r.def; anything] in let r' = compile r1 in r.comp' <- Some r'; r' let wrap r = {def = r; comp = None; comp' = None} let def r = r.def let alt rl = wrap (Alternative (List.map def rl)) let seq rl = wrap (Sequence (List.map def rl)) let empty = alt [] let epsilon = seq [] let rep r i j = if i < 0 then invalid_arg "Rx.rep"; begin match j with Some j when j < i -> invalid_arg "Rx.rep" | _ -> () end; wrap (Repeat (def r, i, j)) let rep0 r = rep r 0 None let rep1 r = rep r 1 None let opt r = alt [epsilon; r] let bol = wrap Beg_of_line let eol = wrap End_of_line let any = wrap (Set [0, 255]) let notnl = wrap (Set (cnegate 0 255 (csingle '\n'))) let inter rl = wrap (Intersection (List.map def rl)) let diff r r' = wrap (Difference (def r, def r')) let set str = let s = ref [] in for i = 0 to String.length str - 1 do s := cunion (csingle str.[i]) !s done; wrap (Set !s) let str s = let l = ref [] in for i = String.length s - 1 downto 0 do l := Set (csingle s.[i]) :: !l done; wrap (Sequence !l) let match_string t s = match_str (force t) s let match_substring t s = match_str (force' t) s let match_prefix t s p = match_pref (force t) s p let uppercase = cunion (cseq 'A' 'Z') (cunion (cseq '\192' '\214') (cseq '\216' '\222')) let lowercase = ctrans 32 uppercase let rec case_insens r = match r with Set s -> Set (cunion s (cunion (ctrans 32 (cinter s uppercase)) (ctrans (-32) (cinter s lowercase)))) | Sequence l -> Sequence (List.map case_insens l) | Alternative l -> Alternative (List.map case_insens l) | Repeat (r, i, j) -> Repeat (case_insens r, i, j) | Beg_of_line | End_of_line -> r | Intersection l -> Intersection (List.map case_insens l) | Difference (r, r') -> Difference (case_insens r, case_insens r') let case_insensitive r = wrap (case_insens (def r)) (**** Parser ****) exception Parse_error exception Not_supported let parse s = let i = ref 0 in let l = String.length s in let eos () = !i = l in let test c = not (eos ()) && s.[!i] = c in let accept c = let r = test c in if r then incr i; r in let get () = let r = s.[!i] in incr i; r in let unget () = decr i in let rec regexp () = regexp' (branch ()) and regexp' left = if accept '|' then regexp' (Alternative [left; branch ()]) else left and branch () = branch' (piece ()) and branch' left = if eos () || test '|' || test ')' then left else branch' (Sequence [left; piece ()]) and piece () = let r = atom () in if accept '*' then Repeat (r, 0, None) else if accept '+' then Repeat (r, 1, None) else if accept '?' then Alternative [Sequence []; r] else if accept '{' then match integer () with Some i -> let j = if accept ',' then integer () else Some i in if not (accept '}') then raise Parse_error; begin match j with Some j when j < i -> raise Parse_error | _ -> () end; Repeat (r, i, j) | None -> unget (); r else r and atom () = if accept '.' then Set cany else if accept '(' then begin let r = regexp () in if not (accept ')') then raise Parse_error; r end else if accept '^' then Beg_of_line else if accept '$' then End_of_line else if accept '[' then begin if accept '^' then Set (cnegate 0 255 (bracket [])) else Set (bracket []) end else if accept '\\' then begin if eos () then raise Parse_error; match get () with '|' | '(' | ')' | '*' | '+' | '?' | '[' | '.' | '^' | '$' | '{' | '\\' as c -> Set (csingle c) | _ -> raise Parse_error end else begin if eos () then raise Parse_error; match get () with '*' | '+' | '?' | '{' | '\\' -> raise Parse_error | c -> Set (csingle c) end and integer () = if eos () then None else match get () with '0'..'9' as d -> integer' (Char.code d - Char.code '0') | _ -> unget (); None and integer' i = if eos () then Some i else match get () with '0'..'9' as d -> let i' = 10 * i + (Char.code d - Char.code '0') in if i' < i then raise Parse_error; integer' i' | _ -> unget (); Some i and bracket s = if s <> [] && accept ']' then s else begin let c = char () in if accept '-' then begin if accept ']' then (cadd c (cadd '-' s)) else begin let c' = char () in bracket (cunion (cseq c c') s) end end else bracket (cadd c s) end and char () = if eos () then raise Parse_error; let c = get () in if c = '[' then begin if accept '=' || accept ':' then raise Not_supported; if accept '.' then begin if eos () then raise Parse_error; let c = get () in if not (accept '.') then raise Not_supported; if not (accept ']') then raise Parse_error; c end else c end else c in let res = regexp () in if not (eos ()) then raise Parse_error; res let rx s = wrap (parse s) (**** File globbing ****) let gany = cnegate 0 255 (csingle '/') let notdot = cnegate 0 255 (cunion (csingle '.') (csingle '/')) let dot = csingle '.' type loc = Beg | BegAny | Mid let beg_start = Alternative [Sequence []; Sequence [Set notdot; Repeat (Set gany, 0, None)]] let beg_start' = Sequence [Set notdot; Repeat (Set gany, 0, None)] let glob_parse init s = let i = ref 0 in let l = String.length s in let eos () = !i = l in let test c = not (eos ()) && s.[!i] = c in let accept c = let r = test c in if r then incr i; r in let get () = let r = s.[!i] in incr i; r in (* let unget () = decr i in *) let rec expr () = expr' init (Sequence []) and expr' beg left = if eos () then match beg with Mid | Beg -> left | BegAny -> Sequence [left; beg_start] else let (piec, beg) = piece beg in expr' beg (Sequence [left; piec]) and piece beg = if accept '*' then begin if beg <> Mid then (Sequence [], BegAny) else (Repeat (Set gany, 0, None), Mid) end else if accept '?' then (begin match beg with Beg -> Set notdot | BegAny -> Sequence [Set notdot; Repeat (Set gany, 0, None)] | Mid -> Set gany end, Mid) else if accept '[' then begin (* let mask = if beg <> Mid then notdot else gany in *) let set = if accept '^' || accept '!' then cnegate 0 255 (bracket []) else bracket [] in (begin match beg with Beg -> Set (cinter notdot set) | BegAny -> Alternative [Sequence [beg_start; Set (cinter notdot set)]; Sequence [beg_start'; Set (cinter dot set)]] | Mid -> Set (cinter gany set) end, Mid) end else let c = char () in ((if beg <> BegAny then Set (csingle c) else if c = '.' then Sequence [beg_start'; Set (csingle c)] else Sequence [beg_start; Set (csingle c)]), if c = '/' then init else Mid) and bracket s = if s <> [] && accept ']' then s else begin let c = char () in if accept '-' then begin if accept ']' then (cadd c (cadd '-' s)) else begin let c' = char () in bracket (cunion (cseq c c') s) end end else bracket (cadd c s) end and char () = ignore (accept '\\'); if eos () then raise Parse_error; get () in let res = expr () in res let rec mul l l' = List.flatten (List.map (fun s -> List.map (fun s' -> s ^ s') l') l) let explode str = let l = String.length str in let rec expl inner s i acc beg = if i >= l then begin if inner then raise Parse_error; (mul beg [String.sub str s (i - s)], i) end else match str.[i] with '\\' -> expl inner s (i + 2) acc beg | '{' -> let (t, i') = expl true (i + 1) (i + 1) [] [""] in expl inner i' i' acc (mul beg (mul [String.sub str s (i - s)] t)) | ',' when inner -> expl inner (i + 1) (i + 1) (mul beg [String.sub str s (i - s)] @ acc) [""] | '}' when inner -> (mul beg [String.sub str s (i - s)] @ acc, i + 1) | _ -> expl inner s (i + 1) acc beg in List.rev (fst (expl false 0 0 [] [""])) let glob' nodot s = wrap (glob_parse (if nodot then Beg else Mid) s) let glob s = glob' true s let globx' nodot s = alt (List.map (glob' nodot) (explode s)) let globx s = globx' true s unison-2.32.52/ubase/rx.mli0000644000076500000000000000432611176730177015104 0ustar bcpiercewheel(* 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 unison-2.32.52/ubase/safelist.ml0000644000076500000000000001051511176730177016111 0ustar bcpiercewheel(* Unison file synchronizer: src/ubase/safelist.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) let filterBoth f l = let rec loop r1 r2 = function [] -> (List.rev r1, List.rev r2) | hd::tl -> if f hd then loop (hd::r1) r2 tl else loop r1 (hd::r2) tl in loop [] [] l let filterMap f l = let rec loop r = function [] -> List.rev r | hd::tl -> begin match f hd with None -> loop r tl | Some x -> loop (x::r) tl end in loop [] l let filterMap2 f l = let rec loop r s = function [] -> List.rev r, List.rev s | hd::tl -> begin let (a, b) = f hd in let r' = match a with None -> r | Some x -> x::r in let s' = match b with None -> s | Some x -> x::s in loop r' s' tl end in loop [] [] l (* These are tail-recursive versions of the standard ones from the List module *) let rec concat_rec accu = function [] -> List.rev accu | l::r -> concat_rec (List.rev_append l accu) r let concat l = concat_rec [] l let flatten = concat let append l l' = match l' with [] -> l | _ -> List.rev_append (List.rev l) l' let rev_map f l = let rec rmap_f accu = function | [] -> accu | a::l -> rmap_f (f a :: accu) l in rmap_f [] l let map f l = List.rev (rev_map f l) let rev_map2 f l1 l2 = let rec rmap2_f accu l1 l2 = match (l1, l2) with | ([], []) -> accu | (a1::l1, a2::l2) -> rmap2_f (f a1 a2 :: accu) l1 l2 | (_, _) -> invalid_arg "List.rev_map2" in rmap2_f [] l1 l2 ;; let map2 f l1 l2 = List.rev (rev_map2 f l1 l2) let rec allElementsEqual = function [] -> true | [a] -> true | a::b::rest -> a=b && (allElementsEqual (b::rest)) let rec fold_left f accu l = match l with [] -> accu | a::_ -> (* We don't want l to be live when f is called *) let l' = List.tl l in fold_left f (f accu a) l' let split l = let rec loop acc1 acc2 = function [] -> (List.rev acc1, List.rev acc2) | (x,y)::l -> loop (x::acc1) (y::acc2) l in loop [] [] l let rec transpose_rec accu l = match l with [] | []::_ -> accu | [x]::_ -> (map (function [x] -> x | _ -> invalid_arg "Safelist.transpose") l)::accu | _ -> let (l0, r) = fold_left (fun (l0, r) l1 -> match l1 with [] -> invalid_arg "Safelist.transpose (2)" | a::r1 -> (a::l0, r1::r)) ([], []) l in transpose_rec ((List.rev l0)::accu) (List.rev r) let transpose l = List.rev (transpose_rec [] l) let combine l1 l2 = let rec loop acc = function ([], []) -> List.rev acc | (a1::l1r, a2::l2r) -> loop ((a1, a2)::acc) (l1r,l2r) | (_, _) -> invalid_arg "Util.combine" in loop [] (l1,l2) let remove_assoc x l = let rec loop acc = function | [] -> List.rev acc | (a, b as pair) :: rest -> if a = x then loop acc rest else loop (pair::acc) rest in loop [] l let fold_right f l accu = fold_left (fun x y -> f y x) accu (List.rev l) let flatten_map f l = flatten (map f l) let remove x l = let rec loop acc = function | [] -> List.rev acc | a :: rest -> if a = x then loop acc rest else loop (a::acc) rest in loop [] l let iteri f l = let rec loop n = function | [] -> () | h::t -> ((f n h); loop (n+1) t) in loop 0 l (* These are already tail recursive in the List module *) let iter = List.iter let iter2 = List.iter2 let rev = List.rev let rev_append = List.rev_append let hd = List.hd let tl = List.tl let nth = List.nth let length = List.length let mem = List.mem let assoc = List.assoc let for_all = List.for_all let exists = List.exists let find = List.find let filter = List.filter let stable_sort = List.stable_sort let sort = List.sort let partition = List.partition unison-2.32.52/ubase/safelist.mli0000644000076500000000000000412711176730177016264 0ustar bcpiercewheel(* 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 unison-2.32.52/ubase/trace.ml0000644000076500000000000002050211176730177015372 0ustar bcpiercewheel(* Unison file synchronizer: src/ubase/trace.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) (* ---------------------------------------------------------------------- *) (* Choosing where messages go *) type trace_printer_choices = [`Stdout | `Stderr | `FormatStdout] let traceprinter = ref (`Stderr : trace_printer_choices) let redirect x = (traceprinter := x) (* ---------------------------------------------------------------------- *) (* Debugging messages *) let debugmods = Prefs.createStringList "debug" "!debug module xxx ('all' -> everything, 'verbose' -> more)" ("This preference is used to make Unison print various sorts of " ^ "information about what it is doing internally on the standard " ^ "error stream. It can be used many times, each time with the name " ^ "of a module for which debugging information should be printed. " ^ "Possible arguments for \\verb|debug| can be found " ^ "by looking for calls to \\verb|Util.debug| in the " ^ "sources (using, e.g., \\verb|grep|). " ^ "Setting \\verb|-debug all| causes information from {\\em all} " ^ "modules to be printed (this mode of usage is the first one to try, " ^ "if you are trying to understand something that Unison seems to be " ^ "doing wrong); \\verb|-debug verbose| turns on some additional " ^ "debugging output from some modules (e.g., it will show exactly " ^ "what bytes are being sent across the network).") let debugtimes = Prefs.createBool "debugtimes" false "*annotate debugging messages with timestamps" "" let runningasserver = ref false let debugging() = (Prefs.read debugmods) <> [] let enabled modname = let m = Prefs.read debugmods in let en = m <> [] && ( (* tracing labeled "" is enabled if anything is *) (modname = "") || (* '-debug verbose' enables everything *) (Safelist.mem "verbose" m) || (* '-debug all+' likewise *) (Safelist.mem "all+" m) || (* '-debug all' enables all tracing not marked + *) (Safelist.mem "all" m && not (Util.endswith modname "+")) || (* '-debug m' enables m and '-debug m+' enables m+ *) (Safelist.mem modname m) || (* '-debug m+' also enables m *) (Safelist.mem (modname ^ "+") m) ) in en let enable modname onoff = let m = Prefs.read debugmods in let m' = if onoff then (modname::m) else (Safelist.remove modname m) in Prefs.set debugmods m' let debug modname thunk = if enabled modname then begin let s = if !runningasserver then "server: " else "" in let time = if Prefs.read debugtimes then let tm = Util.localtime (Util.time()) in Printf.sprintf "%02d:%02d:%02d" tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec else "" in if time<>"" || s<>"" || modname<>"" then begin let time = if time="" || (s=""&&modname="") then time else time^": " in match !traceprinter with | `Stdout -> Printf.printf "[%s%s%s] " time s modname | `Stderr -> Printf.eprintf "[%s%s%s] " time s modname | `FormatStdout -> Format.printf "[%s%s%s] " time s modname end; thunk(); flush stderr end (* We set the debugPrinter variable in the Util module so that other modules lower down in the module dependency graph (so that they can't just import Trace) can also print debugging messages. *) let _ = Util.debugPrinter := Some(debug) (* ---------------------------------------------------------------------- *) (* Logging *) let logging = Prefs.createBool "log" true "!record actions in logfile" "When this flag is set, Unison will log all changes to the filesystems on a file." let logfile = Prefs.createString "logfile" (Util.fileInHomeDir "unison.log") "!logfile name" "By default, logging messages will be appended to the file \\verb|unison.log| in your HOME directory. Set this preference if you prefer another file." let logch = ref None let rec getLogch() = Util.convertUnixErrorsToFatal "getLogch" (fun() -> match !logch with None -> let file = Prefs.read logfile in let ch = open_out_gen [Open_wronly; Open_append; Open_creat] 0o600 file in logch := Some (ch, file); ch | Some(ch, file) -> if Prefs.read logfile = file then ch else begin close_out ch; logch := None; getLogch () end) let sendLogMsgsToStderr = ref true let writeLog s = if !sendLogMsgsToStderr then begin match !traceprinter with | `Stdout -> Printf.printf "%s" s | `Stderr -> Util.msg "%s" s | `FormatStdout -> Format.printf "%s " s end else debug "" (fun() -> match !traceprinter with | `Stdout -> Printf.printf "%s" s | `Stderr -> Util.msg "%s" s | `FormatStdout -> Format.printf "%s " s); if Prefs.read logging then begin let ch = getLogch() in output_string ch s; flush ch end (* ---------------------------------------------------------------------- *) (* Formatting and displaying messages *) let terse = Prefs.createBool "terse" false "suppress status messages" ("When this preference is set to {\\tt true}, the user " ^ "interface will not print status messages.") type msgtype = Msg | StatusMajor | StatusMinor | Log type msg = msgtype * string let defaultMessageDisplayer s = if not (Prefs.read terse) then begin let show() = if s<>"" then Util.msg "%s\n" s in if enabled "" then debug "" show else if not !runningasserver then show() end let messageDisplayer = ref defaultMessageDisplayer let defaultStatusFormatter s1 s2 = s1 ^ " " ^ s2 let statusFormatter = ref defaultStatusFormatter let statusMsgMajor = ref "" let statusMsgMinor = ref "" let displayMessageLocally (mt,s) = let display = !messageDisplayer in let displayStatus() = display (!statusFormatter !statusMsgMajor !statusMsgMinor) in match mt with Msg -> display s | StatusMajor -> statusMsgMajor := s; statusMsgMinor := ""; displayStatus() | StatusMinor -> statusMsgMinor := s; displayStatus() | Log -> writeLog s let messageForwarder = ref None let displayMessage m = match !messageForwarder with None -> displayMessageLocally m | Some(f) -> f m (* ---------------------------------------------------------------------- *) (* Convenience functions for displaying various kinds of messages *) let message s = displayMessage (Msg, s) let status s = displayMessage (StatusMajor, s) let statusMinor s = displayMessage (StatusMinor, s) let statusDetail s = let ss = if not !runningasserver then s else (Util.padto 30 s) ^ " [server]" in displayMessage (StatusMinor, ss) let log s = displayMessage (Log, s) let logverbose s = let temp = !sendLogMsgsToStderr in sendLogMsgsToStderr := !sendLogMsgsToStderr && not (Prefs.read terse); displayMessage (Log, s); sendLogMsgsToStderr := temp (* ---------------------------------------------------------------------- *) (* Timing *) let printTimers = Prefs.createBool "timers" false "*print timing information" "" type timer = string * float let gettime () = Unix.gettimeofday() let startTimer desc = if Prefs.read(printTimers) then (message (desc ^ "..."); (desc, gettime())) else (desc,0.0) let startTimerQuietly desc = if Prefs.read(printTimers) then (desc, gettime()) else (desc,0.0) let showTimer (desc, t1) = (* Showing timer values from the server process does not work at the moment: it confuses the RPC mechanism *) if not !runningasserver then if Prefs.read(printTimers) then let t2 = gettime() in message (Printf.sprintf "%s (%.2f seconds)" desc (t2 -. t1)) unison-2.32.52/ubase/trace.mli0000644000076500000000000001012311176730177015541 0ustar bcpiercewheel(* 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 unison-2.32.52/ubase/uarg.ml0000644000076500000000000000712111176730177015234 0ustar bcpiercewheel(* 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; ;; unison-2.32.52/ubase/uarg.mli0000644000076500000000000001112611176730177015405 0ustar bcpiercewheel(***********************************************************************) (* *) (* Objective Caml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) (***********************************************************************) (* Slightly modified version by BCP for Unison in 1999 and 2008 *) (* Module [Uarg]: parsing of command line arguments *) (* This module provides a general mechanism for extracting options and arguments from the command line to the program. *) (* Syntax of command lines: A keyword is a character string starting with a [-]. An option is a keyword alone or followed by an argument. The types of keywords are: [Unit], [Set], [Clear], [String], [Int], [Float], and [Rest]. [Unit], [Set] and [Clear] keywords take no argument. [String], [Int], and [Float] keywords take the following word on the command line as an argument. A [Rest] keyword takes the remaining of the command line as (string) arguments. Arguments not preceded by a keyword are called anonymous arguments. *) (* Examples ([cmd] is assumed to be the command name): - [cmd -flag ](a unit option) - [cmd -int 1 ](an int option with argument [1]) - [cmd -string foobar ](a string option with argument ["foobar"]) - [cmd -float 12.34 ](a float option with argument [12.34]) - [cmd a b c ](three anonymous arguments: ["a"], ["b"], and ["c"]) - [cmd a b -- c d ](two anonymous arguments and a rest option with - [ ] two arguments) *) 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 *) (* The concrete type describing the behavior associated with a keyword. *) val parse : (string * spec * string) list -> (string -> unit) -> string -> unit (* [Uarg.parse speclist anonfun usage_msg] parses the command line. [speclist] is a list of triples [(key, spec, doc)]. [key] is the option keyword, it must start with a ['-'] character. [spec] gives the option type and the function to call when this option is found on the command line. [doc] is a one-line description of this option. [anonfun] is called on anonymous arguments. The functions in [spec] and [anonfun] are called in the same order as their arguments appear on the command line. If an error occurs, [Uarg.parse] exits the program, after printing an error message as follows: - The reason for the error: unknown option, invalid or missing argument, etc. - [usage_msg] - The list of options, each followed by the corresponding [doc] string. For the user to be able to specify anonymous arguments starting with a [-], include for example [("-", String anonfun, doc)] in [speclist]. By default, [parse] recognizes a unit option [-help], which will display [usage_msg] and the list of options, and exit the program. You can override this behaviour by specifying your own [-help] option in [speclist]. *) exception Bad of string (* Functions in [spec] or [anonfun] can raise [Uarg.Bad] with an error message to reject invalid arguments. *) val usage: (string * spec * string) list -> string -> unit (* [Uarg.usage speclist usage_msg] prints an error message including the list of valid options. This is the same message that [Uarg.parse] prints in case of error. [speclist] and [usage_msg] are the same as for [Uarg.parse]. *) val current: int ref;; (* Position (in [Sys.argv]) of the argument being processed. You can change this value, e.g. to force [Uarg.parse] to skip some arguments. *) unison-2.32.52/ubase/uprintf.ml0000644000076500000000000000705611176730177015774 0ustar bcpiercewheel(***********************************************************************) (* *) (* Objective Caml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) (* under the terms of the GNU Library General Public License. *) (* *) (***********************************************************************) external caml_format_int: string -> int -> string = "caml_format_int" external caml_format_float: string -> float -> string = "caml_format_float" let fprintf outchan doafter format = let format = (Obj.magic format : string) in let rec doprn i = if i >= String.length format then (doafter(); Obj.magic ()) else begin let c = String.unsafe_get format i in if c <> '%' then begin output_char outchan c; doprn (succ i) end else begin let j = skip_args (succ i) in match String.unsafe_get format j with '%' -> output_char outchan '%'; doprn (succ j) | 's' -> Obj.magic(fun s -> if j <= i+1 then output_string outchan s else begin let p = try int_of_string (String.sub format (i+1) (j-i-1)) with _ -> invalid_arg "fprintf: bad %s format" in if p > 0 && String.length s < p then begin output_string outchan (String.make (p - String.length s) ' '); output_string outchan s end else if p < 0 && String.length s < -p then begin output_string outchan s; output_string outchan (String.make (-p - String.length s) ' ') end else output_string outchan s end; doprn (succ j)) | 'c' -> Obj.magic(fun c -> output_char outchan c; doprn (succ j)) | 'd' | 'i' | 'o' | 'x' | 'X' | 'u' -> Obj.magic(fun n -> output_string outchan (caml_format_int (String.sub format i (j-i+1)) n); doprn (succ j)) | 'f' | 'e' | 'E' | 'g' | 'G' -> Obj.magic(fun f -> output_string outchan (caml_format_float (String.sub format i (j-i+1)) f); doprn (succ j)) | 'b' -> Obj.magic(fun b -> output_string outchan (string_of_bool b); doprn (succ j)) | 'a' -> Obj.magic(fun printer arg -> printer outchan arg; doprn(succ j)) | 't' -> Obj.magic(fun printer -> printer outchan; doprn(succ j)) | c -> invalid_arg ("fprintf: unknown format") end end and skip_args j = match String.unsafe_get format j with '0' .. '9' | ' ' | '.' | '-' -> skip_args (succ j) | c -> j in doprn 0 let printf doafter fmt = fprintf stdout doafter fmt and eprintf doafter fmt = fprintf stderr doafter fmt unison-2.32.52/ubase/uprintf.mli0000644000076500000000000001027511176730177016142 0ustar bcpiercewheel(***********************************************************************) (* *) (* Objective Caml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) (* under the terms of the GNU Library General Public License. *) (* *) (***********************************************************************) (* Modified for Unison *) (* Module [Printf]: formatting printing functions *) val fprintf: out_channel -> (unit->unit) -> ('a, out_channel, unit) format -> 'a (* [fprintf outchan doafter format arg1 ... argN] formats the arguments [arg1] to [argN] according to the format string [format], outputs the resulting string on the channel [outchan], and then executes the thunk [doafter]. The format is a character string which contains two types of objects: plain characters, which are simply copied to the output channel, and conversion specifications, each of which causes conversion and printing of one argument. Conversion specifications consist in the [%] character, followed by optional flags and field widths, followed by one conversion character. The conversion characters and their meanings are: - [d] or [i]: convert an integer argument to signed decimal - [u]: convert an integer argument to unsigned decimal - [x]: convert an integer argument to unsigned hexadecimal, using lowercase letters. - [X]: convert an integer argument to unsigned hexadecimal, using uppercase letters. - [o]: convert an integer argument to unsigned octal. - [s]: insert a string argument - [c]: insert a character argument - [f]: convert a floating-point argument to decimal notation, in the style [dddd.ddd] - [e] or [E]: convert a floating-point argument to decimal notation, in the style [d.ddd e+-dd] (mantissa and exponent) - [g] or [G]: convert a floating-point argument to decimal notation, in style [f] or [e], [E] (whichever is more compact) - [b]: convert a boolean argument to the string [true] or [false] - [a]: user-defined printer. Takes two arguments and apply the first one to [outchan] (the current output channel) and to the second argument. The first argument must therefore have type [out_channel -> 'b -> unit] and the second ['b]. The output produced by the function is therefore inserted in the output of [fprintf] at the current point. - [t]: same as [%a], but takes only one argument (with type [out_channel -> unit]) and apply it to [outchan]. - [%]: take no argument and output one [%] character. - Refer to the C library [printf] function for the meaning of flags and field width specifiers. Warning: if too few arguments are provided, for instance because the [printf] function is partially applied, the format is immediately printed up to the conversion of the first missing argument; printing will then resume when the missing arguments are provided. For example, [List.iter (printf "x=%d y=%d " 1) [2;3]] prints [x=1 y=2 3] instead of the expected [x=1 y=2 x=1 y=3]. To get the expected behavior, do [List.iter (fun y -> printf "x=%d y=%d " 1 y) [2;3]]. *) val printf: (unit->unit) -> ('a, out_channel, unit) format -> 'a (* Same as [fprintf], but output on [stdout]. *) val eprintf: (unit->unit) -> ('a, out_channel, unit) format -> 'a (* Same as [fprintf], but output on [stderr]. *) unison-2.32.52/ubase/util.ml0000644000076500000000000003433011176730177015255 0ustar bcpiercewheel(* Unison file synchronizer: src/ubase/util.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) (*****************************************************************************) (* CASE INSENSITIVE COMPARISON *) (*****************************************************************************) let nocase_cmp a b = let alen = String.length a in let blen = String.length b in let minlen = if alen=minlen then compare alen blen else let c = compare (Char.lowercase(String.get a i)) (Char.lowercase(String.get b i)) in if c<>0 then c else loop (i+1) in loop 0 let nocase_eq a b = (0 = (nocase_cmp a b)) (*****************************************************************************) (* PRE-BUILT MAP AND SET MODULES *) (*****************************************************************************) module StringMap = Map.Make(struct type t = string let compare = compare end) module StringSet = Set.Make(struct type t = string let compare = compare end) let stringSetFromList l = Safelist.fold_right StringSet.add l StringSet.empty (*****************************************************************************) (* Debugging / error messages *) (*****************************************************************************) let infos = ref "" let clear_infos () = if !infos <> "" then begin print_string "\r"; print_string (String.make (String.length !infos) ' '); print_string "\r"; flush stdout end let show_infos () = if !infos <> "" then begin print_string !infos; flush stdout end let set_infos s = if s <> !infos then begin clear_infos (); infos := s; show_infos () end let msg f = clear_infos (); Uprintf.eprintf (fun () -> flush stderr; show_infos ()) f let msg : ('a, out_channel, unit) format -> 'a = msg (* ------------- Formatting stuff --------------- *) let curr_formatter = ref Format.std_formatter let format f = Format.fprintf (!curr_formatter) f let format : ('a, Format.formatter, unit) format -> 'a = format let format_to_string f = let old_formatter = !curr_formatter in curr_formatter := Format.str_formatter; f (); let s = Format.flush_str_formatter () in curr_formatter := old_formatter; s let flush () = Format.pp_print_flush (!curr_formatter) () (*****************************************************************************) (* GLOBAL DEBUGGING SWITCH *) (*****************************************************************************) let debugPrinter = ref None let debug s th = match !debugPrinter with None -> assert false | Some p -> p s th (* This should be set by the UI to a function that can be used to warn users *) let warnPrinter = ref None (* The rest of the program invokes this function to warn users. *) let warn message = match !warnPrinter with None -> () | Some p -> p message (*****************************************************************************) (* EXCEPTION HANDLING *) (*****************************************************************************) exception Fatal of string exception Transient of string let encodeException m kind e = let reraise s = match kind with `Fatal -> raise (Fatal s) | `Transient -> raise (Transient s) in let kindStr = match kind with `Fatal -> "Fatal" | `Transient -> "Transient" in match e with Unix.Unix_error(err,fnname,param) -> let s = "Error in " ^ m ^ ":\n" ^ (Unix.error_message err) ^ " [" ^ fnname ^ "(" ^ param ^ ")]" in debug "exn" (fun() -> msg "Converting a Unix error to %s:\n%s\n" kindStr s); reraise s | Transient(s) -> debug "exn" (fun() -> if kind = `Fatal then msg "In %s: Converting a Transient error to %s:\n%s\n" m kindStr s else msg "In %s: Propagating Transient error\n" m); reraise s | Not_found -> let s = "Not_found raised in " ^ m ^ " (this indicates a bug!)" in debug "exn" (fun() -> msg "Converting a Not_found to %s:\n%s\n" kindStr s); reraise s | Invalid_argument a -> let s = "Invalid_argument("^a^") raised in " ^ m ^ " (this indicates a bug!)" in debug "exn" (fun() -> msg "Converting an Invalid_argument to %s:\n%s\n" kindStr s); reraise s | Sys_error(s) -> let s = "Error in " ^ m ^ ":\n" ^ s in debug "exn" (fun() -> msg "Converting a Sys_error to %s:\n%s\n" kindStr s); reraise s | Sys_blocked_io -> let s = "Blocked IO error in " ^ m in debug "exn" (fun() -> msg "Converting a Sys_blocked_io to %s:\n%s\n" kindStr s); reraise s | _ -> raise e let convertUnixErrorsToExn m f n e = try f() with Unix.Unix_error(err,fnname,param) -> let s = "Error in " ^ m ^ ":\n" ^ (Unix.error_message err) ^ " [" ^ fnname ^ "(" ^ param ^ ")]" in debug "exn" (fun() -> msg "Converting a Unix error to %s:\n%s\n" n s); raise (e s) | Transient(s) -> debug "exn" (fun() -> if n="Fatal" then msg "In %s: Converting a Transient error to %s:\n%s\n" m n s else msg "In %s: Propagating Transient error\n" m); raise (e s) | Not_found -> let s = "Not_found raised in " ^ m ^ " (this indicates a bug!)" in debug "exn" (fun() -> msg "Converting a Not_found to %s:\n%s\n" n s); raise (e s) | End_of_file -> let s = "End_of_file exception raised in " ^ m ^ " (this indicates a bug!)" in debug "exn" (fun() -> msg "Converting an End_of_file to %s:\n%s\n" n s); raise (e s) | Sys_error(s) -> let s = "Error in " ^ m ^ ":\n" ^ s in debug "exn" (fun() -> msg "Converting a Sys_error to %s:\n%s\n" n s); raise (e s) | Sys_blocked_io -> let s = "Blocked IO error in " ^ m in debug "exn" (fun() -> msg "Converting a Sys_blocked_io to %s:\n%s\n" n s); raise (e s) let convertUnixErrorsToFatal m f = convertUnixErrorsToExn m f "Fatal" (fun str -> Fatal(str)) let convertUnixErrorsToTransient m f = convertUnixErrorsToExn m f "Transient" (fun str -> Transient(str)) let unwindProtect f cleanup = try f () with Transient _ as e -> debug "exn" (fun () -> msg "Exception caught by unwindProtect\n"); convertUnixErrorsToFatal "unwindProtect" (fun()-> cleanup e); raise e let finalize f cleanup = try let res = f () in cleanup (); res with Transient _ as e -> debug "exn" (fun () -> msg "Exception caught by finalize\n"); convertUnixErrorsToFatal "finalize" cleanup; raise e type confirmation = Succeeded | Failed of string let ignoreTransientErrors thunk = try thunk() with Transient(s) -> () let printException e = try raise e with Transient s -> s | Fatal s -> s | e -> Printexc.to_string e (* Safe version of Unix getenv -- raises a comprehensible error message if called with an env variable that doesn't exist *) let safeGetenv var = convertUnixErrorsToFatal "querying environment" (fun () -> try Unix.getenv var with Not_found -> raise (Fatal ("Environment variable " ^ var ^ " not found"))) let process_status_to_string = function Unix.WEXITED i -> Printf.sprintf "Exited with status %d" i | Unix.WSIGNALED i -> Printf.sprintf "Killed by signal %d" i | Unix.WSTOPPED i -> Printf.sprintf "Stopped by signal %d" i (*****************************************************************************) (* OS TYPE *) (*****************************************************************************) let osType = match Sys.os_type with "Win32" | "Cygwin" -> `Win32 | "Unix" -> `Unix | other -> raise (Fatal ("Unknown OS: " ^ other)) let isCygwin = (Sys.os_type = "Cygwin") (*****************************************************************************) (* MISCELLANEOUS *) (*****************************************************************************) let monthname n = Safelist.nth ["Jan";"Feb";"Mar";"Apr";"May";"Jun";"Jul";"Aug";"Sep";"Oct";"Nov";"Dec"] n let localtime f = convertUnixErrorsToTransient "localtime" (fun()-> Unix.localtime f) let time () = convertUnixErrorsToTransient "time" Unix.time let time2string timef = try let time = localtime timef in (* Old-style: Printf.sprintf "%2d:%.2d:%.2d on %2d %3s, %4d" time.Unix.tm_hour time.Unix.tm_min time.Unix.tm_sec time.Unix.tm_mday (monthname time.Unix.tm_mon) (time.Unix.tm_year + 1900) *) Printf.sprintf "%4d-%02d-%02d at %2d:%.2d:%.2d" (time.Unix.tm_year + 1900) (time.Unix.tm_mon + 1) time.Unix.tm_mday time.Unix.tm_hour time.Unix.tm_min time.Unix.tm_sec with Transient _ -> "(invalid date)" let percentageOfTotal current total = (int_of_float ((float current) *. 100.0 /. (float total))) let percent2string p = Printf.sprintf "%3d%%" (truncate (max 0. (min 100. p))) let extractValueFromOption = function None -> raise (Fatal "extractValueFromOption failed") | Some(v) -> v let option2string (prt: 'a -> string) = function Some x -> prt x | None -> "N.A." (*****************************************************************************) (* String utility functions *) (*****************************************************************************) let truncateString string length = let actualLength = String.length string in if actualLength <= length then string^(String.make (length - actualLength) ' ') else if actualLength < 3 then string else (String.sub string 0 (length - 3))^ "..." let findsubstring s1 s2 = let l1 = String.length s1 in let l2 = String.length s2 in let rec loop i = if i+l1 > l2 then None else if s1 = String.sub s2 i l1 then Some(i) else loop (i+1) in loop 0 let rec replacesubstring s fromstring tostring = match findsubstring fromstring s with None -> s | Some(i) -> let before = String.sub s 0 i in let afterpos = i + (String.length fromstring) in let after = String.sub s afterpos ((String.length s) - afterpos) in before ^ tostring ^ (replacesubstring after fromstring tostring) let replacesubstrings s pairs = Safelist.fold_left (fun s' (froms,tos) -> replacesubstring s' froms tos) s pairs let startswith s1 s2 = let l1 = String.length s1 in let l2 = String.length s2 in if l1 < l2 then false else let rec loop i = if i>=l2 then true else if s1.[i] <> s2.[i] then false else loop (i+1) in loop 0 let endswith s1 s2 = let l1 = String.length s1 in let l2 = String.length s2 in let offset = l1 - l2 in if l1 < l2 then false else let rec loop i = if i>=l2 then true else if s1.[i+offset] <> s2.[i] then false else loop (i+1) in loop 0 let concatmap sep f l = String.concat sep (Safelist.map f l) let rec trimWhitespace s = let l = String.length s in if l=0 then s else if s.[0]=' ' || s.[0]='\t' || s.[0]='\n' || s.[0]='\r' then trimWhitespace (String.sub s 1 (l-1)) else if s.[l-1]=' ' || s.[l-1]='\t' || s.[l-1]='\n' || s.[l-1]='\r' then trimWhitespace (String.sub s 0 (l-1)) else s let splitIntoWords (s:string) (c:char) = let rec inword acc start pos = if pos >= String.length(s) || s.[pos] = c then betweenwords ((String.sub s start (pos-start)) :: acc) pos else inword acc start (pos+1) and betweenwords acc pos = if pos >= (String.length s) then (Safelist.rev acc) else if s.[pos]=c then betweenwords acc (pos+1) else inword acc pos pos in betweenwords [] 0 let rec splitIntoWordsByString s sep = match findsubstring sep s with None -> [s] | Some(i) -> let before = String.sub s 0 i in let afterpos = i + (String.length sep) in let after = String.sub s afterpos ((String.length s) - afterpos) in before :: (splitIntoWordsByString after sep) let padto n s = s ^ (String.make (max 0 (n - String.length s)) ' ') (*****************************************************************************) (* Building pathnames in the user's home dir *) (*****************************************************************************) let fileInHomeDir n = if (osType = `Unix) || isCygwin then Filename.concat (safeGetenv "HOME") n else if osType = `Win32 then let dirString = try Unix.getenv "HOME" (* Windows 9x with Cygwin HOME set *) with Not_found -> try Unix.getenv "USERPROFILE" (* Windows NT/2K standard *) with Not_found -> try Unix.getenv "UNISON" (* Use UNISON dir if it is set *) with Not_found -> "c:/" (* Default *) in Filename.concat dirString n else assert false (* osType can't be anything else *) (*****************************************************************************) (* "Upcall" for building pathnames in the .unison dir *) (*****************************************************************************) let fileInUnisonDirFn = ref None let supplyFileInUnisonDirFn f = fileInUnisonDirFn := Some(f) let fileInUnisonDir n = match !fileInUnisonDirFn with None -> assert false | Some(f) -> f n unison-2.32.52/ubase/util.mli0000644000076500000000000001042311176730177015423 0ustar bcpiercewheel(* 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 unison-2.32.52/ui.mli0000644000076500000000000000044011176730177013762 0ustar bcpiercewheel(* 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 unison-2.32.52/uicommon.ml0000644000076500000000000006550311207454025015023 0ustar bcpiercewheel(* Unison file synchronizer: src/uicommon.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) open Common open Lwt (********************************************************************** UI selection **********************************************************************) type interface = Text | Graphic module type UI = sig val start : interface -> unit val defaultUi : interface end (********************************************************************** Preferences **********************************************************************) let auto = Prefs.createBool "auto" false "automatically accept default (nonconflicting) actions" ("When set to {\\tt true}, this flag causes the user " ^ "interface to skip asking for confirmations on " ^ "non-conflicting changes. (More precisely, when the user interface " ^ "is done setting the propagation direction for one entry and is about " ^ "to move to the next, it will skip over all non-conflicting entries " ^ "and go directly to the next conflict.)" ) (* This has to be here rather than in uigtk.ml, because it is part of what gets sent to the server at startup *) let mainWindowHeight = Prefs.createInt "height" 20 "!height (in lines) of main window in graphical interface" ("Used to set the height (in lines) of the main window in the graphical " ^ "user interface.") let reuseToplevelWindows = Prefs.createBool "reusewindows" false "*reuse top-level windows instead of making new ones" "" (* Not sure if this should actually be made available to users... ("When true, causes the graphical interface to re-use top-level windows " ^ "(e.g., the small window that says ``Connecting...'') rather than " ^ "destroying them and creating fresh ones. ") *) (* For convenience: *) let _ = Prefs.alias reuseToplevelWindows "rw" let expert = Prefs.createBool "expert" false "*Enable some developers-only functionality in the UI" "" let profileLabel = Prefs.createString "label" "" "!provide a descriptive string label for this profile" ("Used in a profile to provide a descriptive string documenting its " ^ "settings. (This is useful for users that switch between several " ^ "profiles, especially using the `fast switch' feature of the " ^ "graphical user interface.)") let profileKey = Prefs.createString "key" "" "!define a keyboard shortcut for this profile (in some UIs)" ("Used in a profile to define a numeric key (0-9) that can be used in " ^ "the graphical user interface to switch immediately to this profile.") (* This preference is not actually referred to in the code anywhere, since the keyboard shortcuts are constructed by a separate scan of the preference file in uigtk.ml, but it must be present to prevent the preferences module from complaining about 'key = n' lines in profiles. *) let contactquietly = Prefs.createBool "contactquietly" false "!suppress the 'contacting server' message during startup" ("If this flag is set, Unison will skip displaying the " ^ "`Contacting server' message (which some users find annoying) " ^ "during startup.") let contactingServerMsg () = Printf.sprintf "Contacting server..." let repeat = Prefs.createString "repeat" "" "!synchronize repeatedly (text interface only)" ("Setting this preference causes the text-mode interface to synchronize " ^ "repeatedly, rather than doing it just once and stopping. If the " ^ "argument is a number, Unison will pause for that many seconds before " ^ "beginning again.") (* ^ "If the argument is a path, Unison will wait for the " ^ "file at this path---called a {\\em changelog}---to " ^ "be modified (on either the client or the server " ^ "machine), read the contents of the changelog (which should be a newline-" ^ "separated list of paths) on both client and server, " ^ "combine the results, " ^ "and start again, using the list of paths read from the changelogs as the " ^ " '-path' preference for the new run. The idea is that an external " ^ "process will watch the filesystem and, when it thinks something may have " ^ "changed, write the changed pathname to its local changelog where Unison " ^ "will find it the next time it looks. If the changelogs have not been " ^ "modified, Unison will wait, checking them again every few seconds." *) let retry = Prefs.createInt "retry" 0 "!re-try failed synchronizations N times (text ui only)" ("Setting this preference causes the text-mode interface to try again " ^ "to synchronize " ^ "updated paths where synchronization fails. Each such path will be " ^ "tried N times." ) let confirmmerge = Prefs.createBool "confirmmerge" false "!ask for confirmation before commiting results of a merge" ("Setting this preference causes both the text and graphical interfaces" ^ " to ask the user if the results of a merge command may be commited " ^ " to the replica or not. Since the merge command works on temporary files," ^ " the user can then cancel all the effects of applying the merge if it" ^ " turns out that the result is not satisfactory. In " ^ " batch-mode, this preference has no effect. Default is false.") let runTestsPrefName = "selftest" let runtests = Prefs.createBool runTestsPrefName false "!run internal tests and exit" ("Run internal tests and exit. This option is mostly for developers and must be used " ^ "carefully: in particular, " ^ "it will delete the contents of both roots, so that it can install its own files " ^ "for testing. This flag only makes sense on the command line. When it is " ^ "provided, no preference file is read: all preferences must be specified on the" ^ "command line. Also, since the self-test procedure involves overwriting the roots " ^ "and backup directory, the names of the roots and of the backupdir preference " ^ "must include the string " ^ "\"test\" or else the tests will be aborted. (If these are not given " ^ "on the command line, dummy " ^ "subdirectories in the current directory will be created automatically.)") (* This ref is set to Test.test during initialization, avoiding a circular dependency *) let testFunction = ref (fun () -> assert false) (********************************************************************** Formatting functions **********************************************************************) (* When no archives were found, we omit 'new' in status descriptions, since *all* files would be marked new and this won't make sense to the user. *) let choose s1 s2 = if !Update.foundArchives then s1 else s2 let showprev = Prefs.createBool "showprev" false "*Show previous properties, if they differ from current" "" (* The next function produces nothing unless the "showprev" preference is set. This is because it tends to make the output trace too long and annoying. *) let prevProps newprops ui = if not (Prefs.read showprev) then "" else match ui with NoUpdates | Error _ -> "" | Updates (_, New) -> " (new)" | Updates (_, Previous(_,oldprops,_,_)) -> (* || Props.similar newprops oldprops *) " (was: "^(Props.toString oldprops)^")" let replicaContent2string rc sep = let (typ, status, desc, ui) = rc in let d s = s ^ sep ^ Props.toString desc ^ prevProps desc ui in match typ, status with `ABSENT, `Unchanged -> "absent" | _, `Unchanged -> "unchanged " ^(Util.truncateString (Fileinfo.type2string typ) 7) ^ sep ^(Props.toString desc) | `ABSENT, `Deleted -> "deleted" | `FILE, `Created -> d (choose "new file " "file ") | `FILE, `Modified -> d "changed file " | `FILE, `PropsChanged -> d "changed props " | `SYMLINK, `Created -> d (choose "new symlink " "symlink ") | `SYMLINK, `Modified -> d "changed symlink " | `DIRECTORY, `Created -> d (choose "new dir " "dir ") | `DIRECTORY, `Modified -> d "changed dir " | `DIRECTORY, `PropsChanged -> d "dir props changed" (* Some cases that can't happen... *) | `ABSENT, (`Created | `Modified | `PropsChanged) | `SYMLINK, `PropsChanged | (`FILE|`SYMLINK|`DIRECTORY), `Deleted -> assert false let replicaContent2shortString rc = let (typ, status, _, _) = rc in match typ, status with _, `Unchanged -> " " | `ABSENT, `Deleted -> "deleted " | `FILE, `Created -> choose "new file" "file " | `FILE, `Modified -> "changed " | `FILE, `PropsChanged -> "props " | `SYMLINK, `Created -> choose "new link" "link " | `SYMLINK, `Modified -> "chgd lnk" | `DIRECTORY, `Created -> choose "new dir " "dir " | `DIRECTORY, `Modified -> "chgd dir" | `DIRECTORY, `PropsChanged -> "props " (* Cases that can't happen... *) | `ABSENT, (`Created | `Modified | `PropsChanged) | `SYMLINK, `PropsChanged | (`FILE|`SYMLINK|`DIRECTORY), `Deleted -> assert false let roots2niceStrings length = function (Local,fspath1), (Local,fspath2) -> let name1, name2 = Fspath.differentSuffix fspath1 fspath2 in (Util.truncateString name1 length, Util.truncateString name2 length) | (Local,fspath1), (Remote host, fspath2) -> (Util.truncateString "local" length, Util.truncateString host length) | (Remote host, fspath1), (Local,fspath2) -> (Util.truncateString host length, Util.truncateString "local" length) | _ -> assert false (* BOGUS? *) let details2string theRi sep = match theRi.replicas with Problem s -> Printf.sprintf "Error: %s\n" s | Different(rc1, rc2, _, _) -> let root1str, root2str = roots2niceStrings 12 (Globals.roots()) in Printf.sprintf "%s : %s\n%s : %s" root1str (replicaContent2string rc1 sep) root2str (replicaContent2string rc2 sep) let displayPath previousPath path = let previousNames = Path.toNames previousPath in let names = Path.toNames path in if names = [] then "/" else (* Strip the greatest common prefix of previousNames and names from names. level is the number of names in the greatest common prefix. *) let rec loop level names1 names2 = match (names1,names2) with (hd1::tl1,hd2::tl2) -> if Name.compare hd1 hd2 = 0 then loop (level+1) tl1 tl2 else (level,names2) | _ -> (level,names2) in let (level,suffixNames) = loop 0 previousNames names in let suffixPath = Safelist.fold_left Path.child Path.empty suffixNames in let spaces = String.make (level*3) ' ' in spaces ^ (Path.toString suffixPath) let roots2string () = let replica1, replica2 = roots2niceStrings 12 (Globals.roots()) in (Printf.sprintf "%s %s " replica1 replica2) let direction2niceString = function Conflict -> "<-?->" | Replica1ToReplica2 -> "---->" | Replica2ToReplica1 -> "<----" | Merge -> "<-M->" let reconItem2string oldPath theRI status = let theLine = match theRI.replicas with Problem s -> " error " ^ status | Different(rc1, rc2, dir, _) -> let signs = Printf.sprintf "%s %s %s" (replicaContent2shortString rc1) (direction2niceString (!dir)) (replicaContent2shortString rc2) in Printf.sprintf "%s %s" signs status in Printf.sprintf "%s %s" theLine (displayPath oldPath theRI.path) let exn2string = function Sys.Break -> "Terminated!" | Util.Fatal(s) -> Printf.sprintf "Fatal error: %s" s | Util.Transient(s) -> Printf.sprintf "Error: %s" s | other -> Printf.sprintf "Uncaught exception %s" (Printexc.to_string other) (* precondition: uc = File (Updates(_, ..) on both sides *) let showDiffs ri printer errprinter id = let p = ri.path in match ri.replicas with Problem _ -> errprinter "Can't diff files: there was a problem during update detection" | Different((`FILE, _, _, ui1), (`FILE, _, _, ui2), _, _) -> let (root1,root2) = Globals.roots() in begin try Files.diff root1 p ui1 root2 p ui2 printer id with Util.Transient e -> errprinter e end | Different _ -> errprinter "Can't diff: path doesn't refer to a file in both replicas" exception Synch_props of Common.reconItem (********************************************************************** Common error messages **********************************************************************) let dangerousPathMsg dangerousPaths = if dangerousPaths = [Path.empty] then "The root of one of the replicas has been completely emptied.\n\ Unison may delete everything in the other replica. (Set the \n\ 'confirmbigdel' preference to false to disable this check.)" else Printf.sprintf "The following paths have been completely emptied in one replica:\n \ %s\n\ Unison may delete everything below these paths in the other replica.\n (Set the 'confirmbigdel' preference to false to disable this check.)" (String.concat "\n " (Safelist.map (fun p -> "'" ^ (Path.toString p) ^ "'") dangerousPaths)) (********************************************************************** Useful patterns for ignoring paths **********************************************************************) let quote s = let len = String.length s in let buf = String.create (2 * len) in let pos = ref 0 in for i = 0 to len - 1 do match s.[i] with '*' | '?' | '[' | '{' | '}' | ',' | '\\' as c -> buf.[!pos] <- '\\'; buf.[!pos + 1] <- c; pos := !pos + 2 | c -> buf.[!pos] <- c; pos := !pos + 1 done; "{" ^ String.sub buf 0 !pos ^ "}" let ignorePath path = "Path " ^ quote (Path.toString path) let ignoreName path = match Path.finalName path with Some name -> "Name " ^ quote (Name.toString name) | None -> assert false let ignoreExt path = match Path.finalName path with Some name -> let str = Name.toString name in begin try let pos = String.rindex str '.' in let ext = String.sub str pos (String.length str - pos) in "Name {,.}*" ^ quote ext with Not_found -> (* str does not contain '.' *) "Name " ^ quote str end | None -> assert false let addIgnorePattern theRegExp = if theRegExp = "Path " then raise (Util.Transient "Can't ignore the root path!"); Globals.addRegexpToIgnore theRegExp; let r = Prefs.add "ignore" theRegExp in Trace.status r; (* Make sure the server has the same ignored paths (in case, for example, we do a "rescan") *) Lwt_unix.run (Globals.propagatePrefs ()) (********************************************************************** Profile and command-line parsing **********************************************************************) let coreUsageMsg = "Usage: " ^ Uutil.myName ^ " [options]\n" ^ " or " ^ Uutil.myName ^ " root1 root2 [options]\n" ^ " or " ^ Uutil.myName ^ " profilename [options]\n" let shortUsageMsg = coreUsageMsg ^ "\n" ^ "For a list of options, type \"" ^ Uutil.myName ^ " -help\".\n" ^ "For a tutorial on basic usage, type \"" ^ Uutil.myName ^ " -doc tutorial\".\n" ^ "For other documentation, type \"" ^ Uutil.myName ^ " -doc topics\".\n" let usageMsg = coreUsageMsg let debug = Trace.debug "startup" (* ---- *) (* Determine the case sensitivity of a root (does filename FOO==foo?) *) let architecture = Remote.registerRootCmd "architecture" (fun (_,()) -> return (Util.osType = `Win32, Osx.isMacOSX)) (* During startup the client determines the case sensitivity of each root. If any root is case insensitive, all roots must know this -- it's propagated in a pref. *) (* FIX: this does more than check case sensitivity, it also detects HFS (needed for resource forks) and Windows (needed for permissions)... needs a new name *) let checkCaseSensitivity () = Globals.allRootsMap (fun r -> architecture r ()) >>= (fun archs -> let someHostIsRunningWindows = Safelist.exists (fun (isWin, _) -> isWin) archs in let allHostsAreRunningWindows = Safelist.for_all (fun (isWin, _) -> isWin) archs in let someHostRunningOsX = Safelist.exists (fun (_, isOSX) -> isOSX) archs in let someHostIsCaseInsensitive = someHostIsRunningWindows || someHostRunningOsX in Case.init someHostIsCaseInsensitive; Props.init someHostIsRunningWindows; Osx.init someHostRunningOsX; Prefs.set Globals.someHostIsRunningWindows someHostIsRunningWindows; Prefs.set Globals.allHostsAreRunningWindows allHostsAreRunningWindows; return ()) (* ---- *) let promptForRoots getFirstRoot getSecondRoot = (* Ask the user for the roots *) let r1 = match getFirstRoot() with None -> exit 0 | Some r -> r in let r2 = match getSecondRoot() with None -> exit 0 | Some r -> r in (* Remember them for this run, ordering them so that the first will come out on the left in the UI *) Globals.setRawRoots [r2;r1]; (* Save them in the current profile *) ignore (Prefs.add "root" r1); ignore (Prefs.add "root" r2) (* ---- *) (* The first time we load preferences, we also read the command line arguments; if we re-load prefs (because the user selected a new profile) we ignore the command line *) let firstTime = ref(true) (* BCP: WARNING: Some of the code from here is duplicated in uimacbridge...! *) let initPrefs ~profileName ~displayWaitMessage ~getFirstRoot ~getSecondRoot ~termInteract = (* Restore prefs to their default values, if necessary *) if not !firstTime then Prefs.resetToDefaults(); (* Tell the preferences module the name of the profile *) Prefs.profileName := Some(profileName); (* Check whether the -selftest flag is present on the command line *) let testFlagPresent = Util.StringMap.mem runTestsPrefName (Prefs.scanCmdLine usageMsg) in (* If the -selftest flag is present, then we skip loading the preference file. (This is prevents possible confusions where settings from a preference file could cause unit tests to fail.) *) if not testFlagPresent then begin (* If the profile does not exist, create an empty one (this should only happen if the profile is 'default', since otherwise we will already have checked that the named one exists). *) if not(Sys.file_exists (Prefs.profilePathname profileName)) then Prefs.addComment "Unison preferences file"; (* Load the profile *) (debug (fun() -> Util.msg "about to load prefs"); Prefs.loadTheFile()); (* Now check again that the -selftest flag has not been set, and barf otherwise *) if Prefs.read runtests then raise (Util.Fatal "The 'test' flag should only be given on the command line") end; (* Parse the command line. This will override settings from the profile. *) if !firstTime then begin debug (fun() -> Util.msg "about to parse command line"); Prefs.parseCmdLine usageMsg; end; (* Install dummy roots and backup directory if we are running self-tests *) if Prefs.read runtests then begin if Globals.rawRoots() = [] then Prefs.loadStrings ["root = test-a.tmp"; "root = test-b.tmp"]; if (Prefs.read Stasher.backupdir) = "" then Prefs.loadStrings ["backupdir = test-backup.tmp"]; end; (* Print the preference settings *) debug (fun() -> Prefs.dumpPrefsToStderr() ); (* If no roots are given either on the command line or in the profile, ask the user *) if Globals.rawRoots() = [] then begin promptForRoots getFirstRoot getSecondRoot; end; (* The following step contacts the server, so warn the user it could take some time *) if !firstTime && (not (Prefs.read contactquietly || Prefs.read Trace.terse)) then displayWaitMessage(); (* Canonize the names of the roots, sort them (with local roots first), and install them in Globals. *) Lwt_unix.run (Globals.installRoots termInteract); (* If both roots are local, disable the xferhint table to save time *) begin match Globals.roots() with ((Local,_),(Local,_)) -> Prefs.set Xferhint.xferbycopying false | _ -> () end; (* FIX: This should be before Globals.installRoots *) (* Check to be sure that there is at most one remote root *) let numRemote = Safelist.fold_left (fun n (w,_) -> match w with Local -> n | Remote _ -> n+1) 0 (Globals.rootsList()) in if numRemote > 1 then raise(Util.Fatal "cannot synchronize more than one remote root"); (* If no paths were specified, then synchronize the whole replicas *) if Prefs.read Globals.paths = [] then Prefs.set Globals.paths [Path.empty]; (* Expand any "wildcard" paths [with final component *] *) Globals.expandWildcardPaths(); Update.storeRootsName (); if not (Prefs.read contactquietly || Prefs.read Trace.terse) then Util.msg "Connected [%s]\n" (Util.replacesubstring (Update.getRootsName()) ", " " -> "); debug (fun() -> Printf.eprintf "Roots: \n"; Safelist.iter (fun clr -> Printf.eprintf " %s\n" clr) (Globals.rawRoots ()); Printf.eprintf " i.e. \n"; Safelist.iter (fun clr -> Printf.eprintf " %s\n" (Clroot.clroot2string (Clroot.parseRoot clr))) (Globals.rawRoots ()); Printf.eprintf " i.e. (in canonical order)\n"; Safelist.iter (fun r -> Printf.eprintf " %s\n" (root2string r)) (Globals.rootsInCanonicalOrder()); Printf.eprintf "\n"); Recon.checkThatPreferredRootIsValid(); Lwt_unix.run (checkCaseSensitivity () >>= Globals.propagatePrefs); (* Initializes some backups stuff according to the preferences just loaded from the profile. Important to do it here, after prefs are propagated, because the function will also be run on the server, if any. Also, this should be done each time a profile is reloaded on this side, that's why it's here. *) Stasher.initBackups (); firstTime := false (********************************************************************** Common startup sequence **********************************************************************) let anonymousArgs = Prefs.createStringList "rest" "*roots or profile name" "" let testServer = Prefs.createBool "testserver" false "exit immediately after the connection to the server" ("Setting this flag on the command line causes Unison to attempt to " ^ "connect to the remote server and, if successful, print a message " ^ "and immediately exit. Useful for debugging installation problems. " ^ "Should not be set in preference files.") (* For backward compatibility *) let _ = Prefs.alias testServer "testServer" (* ---- *) let uiInit ~(reportError : string -> unit) ~(tryAgainOrQuit : string -> bool) ~(displayWaitMessage : unit -> unit) ~(getProfile : unit -> string option) ~(getFirstRoot : unit -> string option) ~(getSecondRoot : unit -> string option) ~(termInteract : (string -> string -> string) option) = (* Make sure we have a directory for archives and profiles *) Os.createUnisonDir(); (* Extract any command line profile or roots *) let clprofile = ref None in begin try let args = Prefs.scanCmdLine usageMsg in match Util.StringMap.find "rest" args with [] -> () | [profile] -> clprofile := Some profile | [root1;root2] -> Globals.setRawRoots [root1;root2] | [root1;root2;profile] -> Globals.setRawRoots [root1;root2]; clprofile := Some profile | _ -> (reportError(Printf.sprintf "%s was invoked incorrectly (too many roots)" Uutil.myName); exit 1) with Not_found -> () end; (* Print header for debugging output *) debug (fun() -> Printf.eprintf "%s, version %s\n\n" Uutil.myName Uutil.myVersion); debug (fun() -> Util.msg "initializing UI"); debug (fun () -> (match !clprofile with None -> Util.msg "No profile given on command line" | Some s -> Printf.eprintf "Profile '%s' given on command line" s); (match Globals.rawRoots() with [] -> Util.msg "No roots given on command line" | [root1;root2] -> Printf.eprintf "Roots '%s' and '%s' given on command line" root1 root2 | _ -> assert false)); let profileName = begin match !clprofile with None -> let dirString = Fspath.toString Os.unisonDir in let profiles_exist = (Files.ls dirString "*.prf")<>[] in let clroots_given = (Globals.rawRoots() <> []) in let n = if profiles_exist && not(clroots_given) then begin (* Unison has been used before: at least one profile exists. Ask the user to choose a profile or create a new one. *) clprofile := getProfile(); match !clprofile with None -> exit 0 (* None means the user wants to quit *) | Some x -> x end else begin (* First time use, OR roots given on command line. In either case, the profile should be the default. *) clprofile := Some "default"; "default" end in n | Some n -> let f = Prefs.profilePathname n in if not(Sys.file_exists f) then (reportError (Printf.sprintf "Profile %s does not exist" f); exit 1); n end in (* Load the profile and command-line arguments *) initPrefs profileName displayWaitMessage getFirstRoot getSecondRoot termInteract; (* Turn on GC messages, if the '-debug gc' flag was provided *) if Trace.enabled "gc" then Gc.set {(Gc.get ()) with Gc.verbose = 0x3F}; if Prefs.read testServer then exit 0; (* BCPFIX: Should/can this be done earlier?? *) Files.processCommitLogs(); (* Run unit tests if requested *) if Prefs.read runtests then begin (!testFunction)(); exit 0 end (* Exit codes *) let perfectExit = 0 (* when everything's okay *) let skippyExit = 1 (* when some items were skipped, but no failure occurred *) let failedExit = 2 (* when there's some non-fatal failure *) let fatalExit = 3 (* when fatal failure occurred *) let exitCode = function (false, false) -> 0 | (true, false) -> 1 | _ -> 2 (* (anySkipped?, anyFailure?) -> exit code *) unison-2.32.52/uicommon.mli0000644000076500000000000000677311176730177015212 0ustar bcpiercewheel(* 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 unison-2.32.52/uigtk.ml0000644000076500000000000022554011176730177014331 0ustar bcpiercewheel(* $I1: Unison file synchronizer: src/uigtk.ml $ *) (* $I2: Last modified by vouillon on Thu, 09 Sep 2004 08:43:03 -0400 $ *) (* $I3: Copyright 1999-2004 (see COPYING for details) $ *) open Common open Lwt module Private = struct let debug = Trace.debug "ui" (********************************************************************** 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." Uutil.myName (* ---- *) 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)." Uutil.myName Uutil.myName Uutil.myName Uutil.myName Uutil.myName Uutil.myName Uutil.myName (********************************************************************** 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 fontMonospaceBold = if Util.osType = `Win32 then lazy (Gdk.Font.load "-*-Courier New-Bold-R-Normal--*-110-*-*-*-*-*-*") else lazy (Gdk.Font.load "-*-Courier-Bold-R-Normal--*-120-*-*-*-*-*-*") (********************************************************************* UI state variables *********************************************************************) type stateItem = { mutable ri : reconItem; mutable bytesTransferred : Uutil.Filesize.t; mutable whatHappened : Util.confirmation 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; 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 gtk_sync () = while Glib.Main.iteration false do () done (********************************************************************** USEFUL LOW-LEVEL WIDGETS **********************************************************************) class scrolled_text ?editable ?word_wrap ?width ?height ?packing ?show () = let sw = GBin.scrolled_window ?width ?height ?packing ~show:false ~hpolicy:`NEVER ~vpolicy:`AUTOMATIC () in let text = GEdit.text ?editable ?word_wrap ~packing:sw#add () in object inherit GObj.widget_full sw#as_widget method text = text method insert ?(font=fontMonospaceMedium) s = text#freeze (); text#delete_text ~start:0 ~stop:text#length; text#insert ~font:(Lazy.force font) s; text#thaw () method show () = sw#misc#show () initializer if show <> Some false then sw#misc#show () end (* ------ *) (* oneBox: Display a message in a window and wait for the user to hit the button. *) let oneBox ~title ~message ~label = let t = GWindow.dialog ~title ~wm_name:title ~modal:true ~position:`CENTER () in grabFocus t; let h = GPack.hbox ~packing:(t#vbox#pack ~expand:false ~padding:20) () in ignore(GMisc.label ~justify:`LEFT ~text:message ~packing:(h#pack ~expand:false ~padding:20) ()); let b = GButton.button ~label ~packing:t#action_area#add () in b#grab_default (); ignore (b#connect#clicked ~callback:(fun () -> t#destroy())); t#show (); (* Do nothing until user destroys window *) ignore (t#connect#destroy ~callback:GMain.Main.quit); GMain.Main.main (); releaseFocus () let okBox ~title ~message = oneBox ~title ~message ~label:"OK" (* ------ *) (* 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 ~alabel ~blabel = let result = ref false in let t = GWindow.dialog ~title ~wm_name:title ~modal:true ~position:`CENTER () in grabFocus t; let h = GPack.hbox ~packing:(t#vbox#pack ~expand:false ~padding:20) () in ignore(GMisc.label ~justify:`LEFT ~text:message ~packing:(h#pack ~expand:false ~padding:20) ()); (* ignore(GMisc.label ~text:message ~packing:(t#vbox#pack ~expand:false ~padding:4) ()); *) let yes = GButton.button ~label:alabel ~packing:t#action_area#add () and no = GButton.button ~label:blabel ~packing:t#action_area#add () in yes#grab_default (); ignore (yes#connect#clicked ~callback:(fun () -> t#destroy (); result := true)); ignore (no#connect#clicked ~callback:(fun () -> t#destroy (); result := false)); t#show (); (* Do nothing until user destroys window *) ignore (t#connect#destroy ~callback:GMain.Main.quit); GMain.Main.main (); releaseFocus (); !result (* ------ *) (* 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 ?" ~alabel:"Yes" ~blabel:"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 = if Prefs.read Globals.batch then begin (* In batch mode, just pop up a window and go ahead *) let t = GWindow.dialog ~title ~wm_name:title ~position:`CENTER () in let h = GPack.hbox ~packing:(t#vbox#pack ~expand:false ~padding:20) () in ignore(GMisc.label ~justify:`LEFT ~text:message ~packing:(h#pack ~expand:false ~padding:20) ()); let t_dismiss = GButton.button ~label:"Dismiss" ~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)); t#show () end else begin inExit := true; let ok = twoBox ~title ~message ~alabel:"OK" ~blabel:"Exit" in if not(ok) then doExit (); inExit := false end (********************************************************************** 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 transcode_rec 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; transcode_rec buf s (i + 1) l end let transcode s = if Util.osType = `Win32 then let buf = Buffer.create 32 in transcode_rec buf s 0 (String.length s); Buffer.contents buf else s (********************************************************************** 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 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 ~wm_name:title () in let t_dismiss = GButton.button ~label:"Dismiss" ~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 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#get_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 ((transcode message) ^ "\n"); oneBox ~title:(Printf.sprintf "%s: Fatal error" (String.capitalize Uutil.myName)) ~message ~label:"Quit" (* ------ *) let tryAgainOrQuit message = twoBox ~title:"Error" ~message ~alabel:"Try again" ~blabel:"Quit";; (* ------ *) let getFirstRoot() = let t = GWindow.dialog ~title:"Root selection" ~wm_name:"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 ~label:"Continue" ~packing:f3#add () in ignore (contButton#connect#clicked ~callback:contCommand); ignore (fileE#connect#activate ~callback:contCommand); contButton#grab_default (); let quitButton = GButton.button ~label:"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" ~wm_name:"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 ~label:"Help" ~packing:hb#add () in ignore (helpB#connect#clicked ~callback:(fun () -> okBox ~title:"Picking roots" ~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 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), Some portE#text, 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" ~message:"Please enter a port" else okBox ~title:"Error" ~message:"The port you specify must be an integer" | _ -> okBox ~title:"Error" ~message:"Something's wrong with the values you entered, try again" in let f3 = t#action_area in let contButton = GButton.button ~label:"Continue" ~packing:f3#add () in ignore (contButton#connect#clicked ~callback:contCommand); contButton#grab_default (); ignore (fileE#connect#activate ~callback:contCommand); let quitButton = GButton.button ~label:"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 (* ------ *) type profileInfo = {roots:string list; label:string option} (* ------ *) let termInteract() = (* if Util.isOSX then Some(fun s -> "") (*FIXTJ*) else *) None (* ------ *) 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" ~wm_name:"Profiles" ~width:400 () in let okCommand() = currentWindow := None; t#destroy () in let okButton = GButton.button ~label:"OK" ~packing:t#action_area#add () in ignore (okButton#connect#clicked ~callback:okCommand); okButton#misc#set_sensitive false; okButton#grab_default (); let cancelCommand() = t#destroy (); exit 0 in let cancelButton = GButton.button ~label:"Cancel" ~packing:t#action_area#add () in ignore (cancelButton#connect#clicked ~callback:cancelCommand); cancelButton#misc#set_can_default true; 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#add) ~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" ~wm_name:"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:(Uutil.myName ^ " error") ~message:("Profile \"" ^ 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 ~label:"OK" ~packing:f3#add () in ignore (okButton#connect#clicked ~callback:okCommand); okButton#grab_default (); let cancelButton = GButton.button ~label:"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 r1; root2#set_text 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); 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 ~wm_name:title () in let t_dismiss = GButton.button ~label:"Dismiss" ~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) = List.assoc sect Strings.docs 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 charW = Gdk.Font.char_width (Lazy.force fontMonospaceMedium) 'M' in let charH = 16 in let t_text = new scrolled_text ~editable:false ~width:(charW * 80) ~height:(charH * 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 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 ?(label = "Dismiss") ?(action = fun t -> t#destroy) ?(modal = false) message = let t = GWindow.dialog ~title ~wm_name:title ~modal ~position:`CENTER () in let t_dismiss = GButton.button ~label ~packing:t#action_area#add () in t_dismiss#grab_default (); ignore (t_dismiss#connect#clicked ~callback:(action t)); let charW = Gdk.Font.char_width (Lazy.force fontMonospaceMedium) 'M' in let charH = 16 in let t_text = new scrolled_text ~editable:false ~width:(charW * 80) ~height:(charH * 20) ~packing:t#vbox#add () in t_text#insert (transcode message); ignore (t#event#connect#delete ~callback:(fun _ -> action t (); true)); t#show (); if modal then begin grabFocus t; GMain.Main.main (); releaseFocus () end (********************************************************************** 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 ~wm_name:Uutil.myName () in myWindow := Some(w); w#set_border_width 4; w (* ------ *) let displayWaitMessage () = if not (Prefs.read Uicommon.contactquietly) then begin let w = getMyWindow() in ignore (GMisc.label ~text: (Uicommon.contactingServerMsg()) ~packing:(w#add) ()); w#set_border_width 20; w#show(); ignore (w#event#connect#delete ~callback:(fun _ -> exit 0)) end (* ------ *) let rec createToplevelWindow () = let toplevelWindow = getMyWindow() in let toplevelVBox = GPack.vbox ~packing:toplevelWindow#add () in (******************************************************************* Statistic window *******************************************************************) (* FIX: currently statistics window unavailable in the Cygwin version; enabling it causes core dump. *) let stat_win = (if Util.isCygwin then GWindow.dialog () else 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 = List.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 let s = if s="" then "" else "Profile: " ^ s in profileLabel#set_text 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 (********************************************************************* Create the main window *********************************************************************) let mainWindow = let sw = GBin.scrolled_window ~packing:(toplevelVBox#add) ~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 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) [| " " ^ String.sub s 0 12 ^ " "; " Action "; " " ^ String.sub s 15 12 ^ " "; " Status "; " Path" |]; let status_width = let font = mainWindow#misc#style#font in 4 + max (Gdk.Font.string_width font "working") (Gdk.Font.string_width font "skipped") in mainWindow#set_column ~justification:`CENTER 1; mainWindow#set_column ~justification:`CENTER ~auto_resize:false ~width:status_width 3 in setMainWindowColumnHeaders(); (********************************************************************* Create the details window *********************************************************************) let charW = Gdk.Font.char_width (Lazy.force fontMonospaceMedium) 'M' in let charH = if Util.osType = `Win32 then 20 else 16 in let detailsWindow = let sw = GBin.scrolled_window ~packing:(toplevelVBox#pack ~expand:false) ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in GEdit.text ~editable:false ~height:(3 * charH) ~width: (128 * charW) ~line_wrap:false ~packing:sw#add () in detailsWindow#misc#set_can_focus false; let style = detailsWindow#misc#style#copy in style#set_font (Lazy.force fontMonospaceMedium); detailsWindow#misc#set_style style; let updateButtons () = match !current with None -> grSet grAction false; grSet grDiff false | Some row -> let (activate1, activate2) = match !theState.(row).whatHappened, !theState.(row).ri.replicas with | None, Different((`FILE, _, _, _),(`FILE, _, _, _), _, _) -> (true, true) | Some _, Different((`FILE, _, _, _),(`FILE, _, _, _), _, _) -> (false, true) | Some _, _ -> (false, false) | None, _ -> (true, false) in grSet grAction activate1; grSet grDiff activate2 in let makeRowVisible row = if mainWindow#row_is_visible row <> `FULL then begin let adj = mainWindow#vadjustment in let current = adj#value and 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 () = detailsWindow#freeze (); detailsWindow#delete_text ~start:0 ~stop:detailsWindow#length; begin match !current with None -> () | 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)) -> s in detailsWindow#insert (transcode (Path.toString !theState.(row).ri.path)); detailsWindow#insert "\n"; detailsWindow#insert details end; (* Display text *) detailsWindow#thaw (); updateButtons () in (********************************************************************* Status window *********************************************************************) let statusHBox = GPack.hbox ~packing:(toplevelVBox#pack ~expand: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 (); ignore (statusContext#push 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#unselect_row ~callback: (fun ~row ~column ~event -> current := None; updateDetails ())); 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 ignore (mainWindow#prepend [ r1; ""; r2; status; transcode 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:(transcode path) i 4; if status = "failed" then begin mainWindow#set_cell ~text:(path ^ " [failed: click on this line for details]") i 4 end; mainWindow#thaw (); if !current = Some i then updateDetails (); updateButtons () in let globalProgressBar = GMisc.statusbar ~packing:(statusHBox#pack ~expand:false) () in let globalProgressContext = globalProgressBar#new_context ~name:"prog" in ignore (globalProgressContext#push ""); let totalBytesToTransfer = ref Uutil.Filesize.zero in let totalBytesTransferred = ref Uutil.Filesize.zero in let displayGlobalProgress s = globalProgressContext#pop (); ignore (globalProgressContext#push s); (* Force message to be displayed immediately *) gtk_sync () in let showGlobalProgress b = (* Concatenate the new message *) totalBytesTransferred := Uutil.Filesize.add !totalBytesTransferred b; let s = Util.percent2string (Uutil.Filesize.percentageOfTotalSize !totalBytesTransferred !totalBytesToTransfer) in displayGlobalProgress (s^" ") 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; let (r1,r2) = Globals.roots () in let t = Trace.startTimer "Checking for updates" in let findUpdates () = Trace.status "Looking for changes"; let updates = Update.findUpdates () in Trace.showTimer t; updates in let reconcile updates = let t = Trace.startTimer "Reconciling" in Recon.reconcileAll updates in let (reconItemList, thereAreEqualUpdates, dangerousPaths) = reconcile (findUpdates ()) in Trace.showTimer t; 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(); grSet grGo (Array.length !theState > 0); grSet grRestart true; if dangerousPaths <> [] then begin Prefs.set Globals.batch false; Util.warn (Uicommon.dangerousPathMsg dangerousPaths) 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 " "; 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 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 -> Trace.status (Printf.sprintf "\n%s\n\n%s\n\n" title text); 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; 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 ""; grSet grRestart true end in (********************************************************************* Action bar *********************************************************************) let actionBar = GButton.toolbar ~orientation:`HORIZONTAL ~tooltips:true ~space_size:10 ~packing:(toplevelVBox#pack ~expand:false) () in (********************************************************************* Quit button *********************************************************************) actionBar#insert_space (); ignore (actionBar#insert_button ~text:"Quit" ~callback:safeExit ()); (********************************************************************* Go button *********************************************************************) actionBar#insert_space (); grAdd grGo (actionBar#insert_button ~text:"Go" (* tooltip:"Go with displayed actions" *) ~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 ~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) ~callback:leftAction ()); actionBar#insert_space (); grAdd grAction (actionBar#insert_button ~icon:((GMisc.pixmap mergeLogoBlack())#coerce) ~callback:mergeAction ()); actionBar#insert_space (); grAdd grAction (actionBar#insert_button ~icon:((GMisc.pixmap rightArrowBlack ())#coerce) ~callback:rightAction ()); actionBar#insert_space (); grAdd grAction (actionBar#insert_button ~text:"Skip" ~callback:questionAction ()); (********************************************************************* Diff / merge buttons *********************************************************************) let diffCmd () = match !current with Some i -> getLock (fun () -> Uicommon.showDiffs !theState.(i).ri (fun title text -> messageBox ~title text) Trace.status (Uutil.File.ofLine i)) | None -> () in actionBar#insert_space (); grAdd grDiff (actionBar#insert_button ~text:"Diff" ~callback:diffCmd ()); (* let mergeCmd () = match !current with Some i -> getLock (fun () -> toplevelWindow#misc#set_sensitive false; begin try Uicommon.applyMerge !theState.(i).ri (Uutil.File.ofLine i) (fun title text -> Trace.status (Printf.sprintf "%s: %s" title text)) true; !theState.(i).whatHappened <- Some(Util.Succeeded); toplevelWindow#misc#set_sensitive true with Util.Transient(s) -> toplevelWindow#misc#set_sensitive true; oneBox "Merge failed" s "Continue" end; redisplay i; nextInteresting(); gtk_sync()) | None -> () in actionBar#insert_space (); grAdd grDiff (actionBar#insert_button ~text:"Merge" ~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_item ~key:GdkKeysyms._greater ~callback:rightAction ("Propagate this path " ^ descr) in grAdd grAction left; left#add_accelerator ~group:accel_group ~modi:[`SHIFT] GdkKeysyms._greater; let merge = actionsMenu#add_item ~key:GdkKeysyms._m ~callback:mergeAction "Merge the files" in grAdd grAction merge; merge#add_accelerator ~group:accel_group GdkKeysyms._m; let descl = if loc1 = loc2 then "right to left" else Printf.sprintf "from %s to %s" loc2 loc1 in let right = actionsMenu#add_item ~key:GdkKeysyms._less ~callback:leftAction ("Propagate this path " ^ descl) in grAdd grAction right; right#add_accelerator ~group:accel_group ~modi:[`SHIFT] GdkKeysyms._less; grAdd grAction (actionsMenu#add_item ~key:GdkKeysyms._slash ~callback:questionAction "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 `Older `Force) !theState; displayMain())) "Force older files to replace newer 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"); 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_item ~key:GdkKeysyms._d ~callback:diffCmd "Show diffs for selected path"); (* grAdd grDiff (actionsMenu#add_item ~key:GdkKeysyms._m ~callback:mergeCmd "Merge versions of 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_item ~key:GdkKeysyms._g ~callback:(fun () -> getLock synchronize) "Go"); grAdd grRestart (fileMenu#add_item ~key:GdkKeysyms._r ~callback:(fun () -> reloadProfile(); detectCmd()) 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 = List.map (fun i -> !theState.(i).ri.path) failedindices in debug (fun()-> Util.msg "Restarting with paths = %s\n" (String.concat ", " (List.map (fun p -> "'"^(Path.toString p)^"'") failedpaths))); Prefs.set Globals.paths failedpaths; detectCmd()) "Recheck unsynchronized items"); ignore (fileMenu#add_separator ()); grAdd grRestart (fileMenu#add_item ~key:GdkKeysyms._p ~callback:(fun _ -> match getProfile() with None -> () | Some(p) -> loadProfile p; detectCmd()) "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; if not Util.isCygwin then (ignore (fileMenu#add_separator ()); ignore (fileMenu#add_item ~callback:(fun _ -> stat_win#show ()) "Statistics")); ignore (fileMenu#add_separator ()); ignore (fileMenu#add_item ~key:GdkKeysyms._q ~callback:safeExit "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; detectCmd () (********************************************************************* STARTUP *********************************************************************) let start _ = begin try (* Initialize the GTK library *) ignore (GMain.Main.init ()); Util.warnPrinter := Some (warnBox "Warning"); (* Ask the Remote module to call us back at regular intervals during long network operations. *) let rec tick () = gtk_sync (); Lwt_unix.sleep 0.1 >>= 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 *) unison-2.32.52/uigtk.mli0000644000076500000000000000032511176730177014472 0ustar bcpiercewheel(* $I1: Unison file synchronizer: src/uigtk.mli $ *) (* $I2: Last modified by vouillon on Tue, 30 May 2000 18:27:30 -0400 $ *) (* $I3: Copyright 1999-2004 (see COPYING for details) $ *) module Body : Uicommon.UI unison-2.32.52/uigtk2.ml0000644000076500000000000025560711203037745014412 0ustar bcpiercewheel(* Unison file synchronizer: src/uigtk2.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) open Common open Lwt module Private = struct let debug = Trace.debug "ui" let myNameCapitalized = String.capitalize Uutil.myName (********************************************************************** LOW-LEVEL STUFF **********************************************************************) (********************************************************************** Some message strings (build them here because they look ugly in the middle of other code. **********************************************************************) let tryAgainMessage = Printf.sprintf "You can use %s to synchronize a local directory with another local directory, or with a remote directory. Please enter the first (local) directory that you want to synchronize." myNameCapitalized (* ---- *) let helpmessage = Printf.sprintf "%s can synchronize a local directory with another local directory, or with a directory on a remote machine. To synchronize with a local directory, just enter the file name. To synchronize with a remote directory, you must first choose a protocol that %s will use to connect to the remote machine. Each protocol has different requirements: 1) To synchronize using SSH, there must be an SSH client installed on this machine and an SSH server installed on the remote machine. You must enter the host to connect to, a user name (if different from your user name on this machine), and the directory on the remote machine (relative to your home directory on that machine). 2) To synchronize using RSH, there must be an RSH client installed on this machine and an RSH server installed on the remote machine. You must enter the host to connect to, a user name (if different from your user name on this machine), and the directory on the remote machine (relative to your home directory on that machine). 3) To synchronize using %s's socket protocol, there must be a %s server running on the remote machine, listening to the port that you specify here. (Use \"%s -socket xxx\" on the remote machine to start the %s server.) You must enter the host, port, and the directory on the remote machine (relative to the working directory of the %s server running on that machine)." myNameCapitalized myNameCapitalized myNameCapitalized myNameCapitalized myNameCapitalized myNameCapitalized myNameCapitalized (********************************************************************** Font preferences **********************************************************************) let fontMonospaceMedium = if Util.osType = `Win32 then lazy (Gdk.Font.load "-*-Courier New-Medium-R-Normal--*-110-*-*-*-*-*-*") else lazy (Gdk.Font.load "-*-Clean-Medium-R-Normal--*-130-*-*-*-*-*-*") let fontMonospaceMediumPango = lazy (Pango.Font.from_string "monospace") (********************************************************************** Unison icon **********************************************************************) (* This does not work with the current version of Lablgtk, due to a bug let icon = GdkPixbuf.from_data ~width:48 ~height:48 ~has_alpha:true (Gpointer.region_of_string Pixmaps.icon_data) *) let icon = let p = GdkPixbuf.create ~width:48 ~height:48 ~has_alpha:true () in Gpointer.blit (Gpointer.region_of_string Pixmaps.icon_data) (GdkPixbuf.get_pixels p); p (********************************************************************* UI state variables *********************************************************************) type stateItem = { mutable ri : reconItem; mutable bytesTransferred : Uutil.Filesize.t; mutable whatHappened : (Util.confirmation * string option) option} let theState = ref [||] let current = ref None (* ---- *) let currentWindow = ref None let grabFocus t = match !currentWindow with Some w -> t#set_transient_for (w#as_window); w#misc#set_sensitive false | None -> () let releaseFocus () = begin match !currentWindow with Some w -> w#misc#set_sensitive true | None -> () end (********************************************************************* Lock management *********************************************************************) let busy = ref false let getLock f = if !busy then Trace.status "Synchronizer is busy, please wait.." else begin busy := true; f (); busy := false end (********************************************************************** Miscellaneous **********************************************************************) let sync_action = ref None let gtk_sync () = begin match !sync_action with Some f -> f () | None -> () end; while Glib.Main.iteration false do () done (********************************************************************** CHARACTER SET TRANSCODING ***********************************************************************) (* Transcodage from Microsoft Windows Codepage 1252 to Unicode *) (* Unison currently uses the "ASCII" Windows filesystem API. With this API, filenames are encoded using a proprietary character encoding. This encoding depends on the Windows setup, but in Western Europe, the Windows Codepage 1252 is usually used. GTK, on the other hand, uses the UTF-8 encoding. This code perform the translation from Codepage 1252 to UTF-8. A call to [transcode] should be wrapped around every string below that might contain non-ASCII characters. *) let code = [| 0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15; 16; 17; 18; 19; 20; 21; 22; 23; 24; 25; 26; 27; 28; 29; 30; 31; 32; 33; 34; 35; 36; 37; 38; 39; 40; 41; 42; 43; 44; 45; 46; 47; 48; 49; 50; 51; 52; 53; 54; 55; 56; 57; 58; 59; 60; 61; 62; 63; 64; 65; 66; 67; 68; 69; 70; 71; 72; 73; 74; 75; 76; 77; 78; 79; 80; 81; 82; 83; 84; 85; 86; 87; 88; 89; 90; 91; 92; 93; 94; 95; 96; 97; 98; 99; 100; 101; 102; 103; 104; 105; 106; 107; 108; 109; 110; 111; 112; 113; 114; 115; 116; 117; 118; 119; 120; 121; 122; 123; 124; 125; 126; 127; 8364; 129; 8218; 131; 8222; 8230; 8224; 8225; 136; 8240; 352; 8249; 346; 356; 381; 377; 144; 8216; 8217; 8220; 8221; 8226; 8211; 8212; 152; 8482; 353; 8250; 347; 357; 382; 378; 160; 711; 728; 321; 164; 260; 166; 167; 168; 169; 350; 171; 172; 173; 174; 379; 176; 177; 731; 322; 180; 181; 182; 183; 184; 261; 351; 187; 376; 733; 317; 380; 340; 193; 194; 258; 196; 313; 262; 199; 268; 201; 280; 203; 282; 205; 206; 270; 272; 323; 327; 211; 212; 336; 214; 215; 344; 366; 218; 368; 220; 221; 354; 223; 341; 225; 226; 259; 228; 314; 263; 231; 269; 233; 281; 235; 283; 237; 238; 271; 273; 324; 328; 243; 244; 337; 246; 247; 345; 367; 250; 369; 252; 253; 355; 729 |] let rec transcodeRec buf s i l = if i < l then begin let c = code.(Char.code s.[i]) in if c < 0x80 then Buffer.add_char buf (Char.chr c) else if c < 0x800 then begin Buffer.add_char buf (Char.chr (c lsr 6 + 0xC0)); Buffer.add_char buf (Char.chr (c land 0x3f + 0x80)) end else if c < 0x10000 then begin Buffer.add_char buf (Char.chr (c lsr 12 + 0xE0)); Buffer.add_char buf (Char.chr ((c lsr 6) land 0x3f + 0x80)); Buffer.add_char buf (Char.chr (c land 0x3f + 0x80)) end; transcodeRec buf s (i + 1) l end let transcodeDoc s = let buf = Buffer.create 1024 in transcodeRec buf s 0 (String.length s); Buffer.contents buf (****) let wf_utf8 = [[('\x00', '\x7F')]; [('\xC2', '\xDF'); ('\x80', '\xBF')]; [('\xE0', '\xE0'); ('\xA0', '\xBF'); ('\x80', '\xBF')]; [('\xE1', '\xEC'); ('\x80', '\xBF'); ('\x80', '\xBF')]; [('\xED', '\xED'); ('\x80', '\x9F'); ('\x80', '\xBF')]; [('\xEE', '\xEF'); ('\x80', '\xBF'); ('\x80', '\xBF')]; [('\xF0', '\xF0'); ('\x90', '\xBF'); ('\x80', '\xBF'); ('\x80', '\xBF')]; [('\xF1', '\xF3'); ('\x80', '\xBF'); ('\x80', '\xBF'); ('\x80', '\xBF')]; [('\xF4', '\xF4'); ('\x80', '\x8F'); ('\x80', '\xBF'); ('\x80', '\xBF')]] let rec accept_seq l s i len = match l with [] -> Some i | (a, b) :: r -> if i = len || s.[i] < a || s.[i] > b then None else accept_seq r s (i + 1) len let rec accept_rec l s i len = match l with [] -> None | seq :: r -> match accept_seq seq s i len with None -> accept_rec r s i len | res -> res let accept = accept_rec wf_utf8 (***) let rec validate_rec s i len = i = len || match accept s i len with Some i -> validate_rec s i len | None -> false let expl f s = f s 0 (String.length s) let validate = expl validate_rec (****) let protect_char buf c = if c < '\x80' then Buffer.add_char buf c else let c = Char.code c in Buffer.add_char buf (Char.chr (c lsr 6 + 0xC0)); Buffer.add_char buf (Char.chr (c land 0x3f + 0x80)) let rec protect_rec buf s i len = if i = len then Buffer.contents buf else match accept s i len with Some i' -> Buffer.add_substring buf s i (i' - i); protect_rec buf s i' len | None -> protect_char buf s.[i]; protect_rec buf s (i + 1) len (* Convert a string to UTF8 by keeping all UTF8 characters unchanged and considering all other characters as ISO 8859-1 characters *) let protect s = let buf = Buffer.create (String.length s * 2) in expl (protect_rec buf) s (****) let escapeMarkup s = Glib.Markup.escape_text s let transcode s = try Glib.Convert.locale_to_utf8 s with Glib.Convert.Error _ -> protect s let transcodeFilename s = if Util.osType = `Win32 then transcode s else try Glib.Convert.filename_to_utf8 s with Glib.Convert.Error _ -> protect s (********************************************************************** USEFUL LOW-LEVEL WIDGETS **********************************************************************) class scrolled_text ?(font=fontMonospaceMediumPango) ?editable ?word_wrap ~width ~height ?packing ?show () = let sw = GBin.scrolled_window ?packing ~show:false ~hpolicy:`NEVER ~vpolicy:`AUTOMATIC () in let text = GText.view ?editable ?wrap_mode:(Some `WORD) ~packing:sw#add () in object inherit GObj.widget_full sw#as_widget method text = text method insert ?(font=fontMonospaceMediumPango) s = text#buffer#set_text s; method show () = sw#misc#show () initializer text#misc#modify_font (Lazy.force font); text#misc#set_size_chars ~height ~width (); if show <> Some false then sw#misc#show () end (* ------ *) (* Display a message in a window and wait for the user to hit the button. *) let okBox ~title ~typ ~message = let t = GWindow.message_dialog ~title ~message_type:typ ~message ~modal:true ~buttons:GWindow.Buttons.ok () in grabFocus t; ignore (t#run ()); t#destroy (); releaseFocus () (* ------ *) let primaryText msg = Printf.sprintf "%s" (escapeMarkup msg) (* twoBox: Display a message in a window and wait for the user to hit one of two buttons. Return true if the first button is chosen, false if the second button is chosen. *) let twoBox ~title ~message ~astock ~bstock = let t = GWindow.dialog ~border_width:6 ~modal:true ~no_separator:true ~allow_grow:false () in t#vbox#set_spacing 12; let h1 = GPack.hbox ~border_width:6 ~spacing:12 ~packing:t#vbox#pack () in ignore (GMisc.image ~stock:`DIALOG_WARNING ~icon_size:`DIALOG ~yalign:0. ~packing:h1#pack ()); let v1 = GPack.vbox ~spacing:12 ~packing:h1#pack () in ignore (GMisc.label ~markup:(primaryText title ^ "\n\n" ^ escapeMarkup message) ~selectable:true ~yalign:0. ~packing:v1#add ()); t#add_button_stock bstock `NO; t#add_button_stock astock `YES; t#set_default_response `NO; grabFocus t; t#show(); let res = t#run () in t#destroy (); releaseFocus (); res = `YES (* ------ *) (* Avoid recursive invocations of the function below (a window receives delete events even when it is not sensitive) *) let inExit = ref false let doExit () = Lwt_unix.run (Update.unlockArchives ()); exit 0 let safeExit () = if not !inExit then begin inExit := true; if not !busy then exit 0 else if twoBox ~title:"Premature exit" ~message:"Unison is working, exit anyway ?" ~astock:`YES ~bstock:`NO then exit 0; inExit := false end (* ------ *) (* warnBox: Display a warning message in a window and wait (unless we're in batch mode) for the user to hit "OK" or "Exit". *) let warnBox title message = let message = transcode message in if Prefs.read Globals.batch then begin (* In batch mode, just pop up a window and go ahead *) let t = GWindow.dialog ~border_width:6 ~modal:true ~no_separator:true ~allow_grow:false () in t#vbox#set_spacing 12; let h1 = GPack.hbox ~border_width:6 ~spacing:12 ~packing:t#vbox#pack () in ignore (GMisc.image ~stock:`DIALOG_INFO ~icon_size:`DIALOG ~yalign:0. ~packing:h1#pack ()); let v1 = GPack.vbox ~spacing:12 ~packing:h1#pack () in ignore (GMisc.label ~markup:(primaryText title ^ "\n\n" ^ escapeMarkup message) ~selectable:true ~yalign:0. ~packing:v1#add ()); t#add_button_stock `CLOSE `CLOSE; t#set_default_response `CLOSE; ignore (t#connect#response ~callback:(fun _ -> t#destroy ())); t#show () end else begin inExit := true; let ok = twoBox ~title ~message ~astock:`OK ~bstock:`QUIT in if not(ok) then doExit (); inExit := false end (********************************************************************** HIGHER-LEVEL WIDGETS ***********************************************************************) (* XXX * Accurate write accounting: - Local copies on the remote side are ignored - What about failures? *) class stats width height = let pixmap = GDraw.pixmap ~width ~height () in let area = pixmap#set_foreground `WHITE; pixmap#rectangle ~filled:true ~x:0 ~y:0 ~width ~height (); GMisc.pixmap pixmap ~width ~height ~xpad:4 ~ypad:8 () in object (self) inherit GObj.widget_full area#as_widget val mutable maxim = ref 0. val mutable scale = ref 1. val mutable min_scale = 1. val values = Array.make width 0. val mutable active = false method activate a = active <- a method scale h = truncate ((float height) *. h /. !scale) method private rect i v' v = let h = self#scale v in let h' = self#scale v' in let h1 = min h' h in let h2 = max h' h in pixmap#set_foreground `BLACK; pixmap#rectangle ~filled:true ~x:i ~y:(height - h1) ~width:1 ~height:h1 (); for h = h1 + 1 to h2 do let v = truncate (65535. *. (float (h - h1) /. float (h2 - h1))) in let v = (v / 4096) * 4096 in (* Only use 16 gray levels *) pixmap#set_foreground (`RGB (v, v, v)); pixmap#rectangle ~filled:true ~x:i ~y:(height - h) ~width:1 ~height:1 (); done method push v = let need_max = values.(0) = !maxim in for i = 0 to width - 2 do values.(i) <- values.(i + 1) done; values.(width - 1) <- v; if need_max then begin maxim := 0.; for i = 0 to width - 1 do maxim := max !maxim values.(i) done end else maxim := max !maxim v; if active then begin let need_resize = !maxim > !scale || (!maxim > min_scale && !maxim < !scale /. 1.5) in if need_resize then begin scale := min_scale; while !maxim > !scale do scale := !scale *. 1.5 done; pixmap#set_foreground `WHITE; pixmap#rectangle ~filled:true ~x:0 ~y:0 ~width ~height (); pixmap#set_foreground `BLACK; for i = 0 to width - 1 do self#rect i values.(max 0 (i - 1)) values.(i) done end else begin pixmap#put_pixmap ~x:0 ~y:0 ~xsrc:1 (pixmap#pixmap); pixmap#set_foreground `WHITE; pixmap#rectangle ~filled:true ~x:(width - 1) ~y:0 ~width:1 ~height (); self#rect (width - 1) values.(width - 2) values.(width - 1) end; area#misc#draw None end end let clientWritten = ref 0. let serverWritten = ref 0. let statistics () = let title = "Statistics" in let t = GWindow.dialog ~title () in let t_dismiss = GButton.button ~stock:`CLOSE ~packing:t#action_area#add () in t_dismiss#grab_default (); let dismiss () = t#misc#hide () in ignore (t_dismiss#connect#clicked ~callback:dismiss); ignore (t#event#connect#delete ~callback:(fun _ -> dismiss (); true)); let emission = new stats 320 50 in t#vbox#pack ~expand:false ~padding:4 (emission :> GObj.widget); let reception = new stats 320 50 in t#vbox#pack ~expand:false ~padding:4 (reception :> GObj.widget); let lst = GList.clist ~packing:(t#vbox#add) ~titles_active:false ~titles:[""; "Client"; "Server"; "Total"] () in lst#set_column ~auto_resize:true 0; lst#set_column ~auto_resize:true ~justification:`RIGHT 1; lst#set_column ~auto_resize:true ~justification:`RIGHT 2; lst#set_column ~auto_resize:true ~justification:`RIGHT 3; ignore (lst#append ["Reception rate"]); ignore (lst#append ["Data received"]); ignore (lst#append ["File data written"]); let style = lst#misc#style#copy in (* BCP: Removed this on 6/13/2006 as a workaround for a bug reported by Norman Ramsey. Apparently, lablgtl2 uses Gdk.Font, which is deprecated; its associated operations don't work in recent versions of gtk2. *) (* style#set_font (Lazy.force fontMonospaceMedium); *) for r = 0 to 2 do lst#set_row ~selectable:false r; for c = 1 to 3 do lst#set_cell ~style r c done done; ignore (t#event#connect#map (fun _ -> emission#activate true; reception#activate true; false)); ignore (t#event#connect#unmap (fun _ -> emission#activate false; reception#activate false; false)); let delay = 0.5 in let a = 0.5 in let b = 0.8 in let emittedBytes = ref 0. in let emitRate = ref 0. in let emitRate2 = ref 0. in let receivedBytes = ref 0. in let receiveRate = ref 0. in let receiveRate2 = ref 0. in let timeout _ = emitRate := a *. !emitRate +. (1. -. a) *. (!Remote.emittedBytes -. !emittedBytes) /. delay; emitRate2 := b *. !emitRate2 +. (1. -. b) *. (!Remote.emittedBytes -. !emittedBytes) /. delay; emission#push !emitRate; receiveRate := a *. !receiveRate +. (1. -. a) *. (!Remote.receivedBytes -. !receivedBytes) /. delay; receiveRate2 := b *. !receiveRate2 +. (1. -. b) *. (!Remote.receivedBytes -. !receivedBytes) /. delay; reception#push !receiveRate; emittedBytes := !Remote.emittedBytes; receivedBytes := !Remote.receivedBytes; let kib2str v = Format.sprintf "%.0f B" v in let rate2str v = if v > 9.9e3 then begin if v > 9.9e6 then Format.sprintf "%4.0f MiB/s" (v /. 1e6) else if v > 999e3 then Format.sprintf "%4.1f MiB/s" (v /. 1e6) else Format.sprintf "%4.0f KiB/s" (v /. 1e3) end else begin if v > 990. then Format.sprintf "%4.1f KiB/s" (v /. 1e3) else if v > 99. then Format.sprintf "%4.2f KiB/s" (v /. 1e3) else " " end in lst#set_cell ~text:(rate2str !receiveRate2) 0 1; lst#set_cell ~text:(rate2str !emitRate2) 0 2; lst#set_cell ~text: (rate2str (!receiveRate2 +. !emitRate2)) 0 3; lst#set_cell ~text:(kib2str !receivedBytes) 1 1; lst#set_cell ~text:(kib2str !emittedBytes) 1 2; lst#set_cell ~text: (kib2str (!receivedBytes +. !emittedBytes)) 1 3; lst#set_cell ~text:(kib2str !clientWritten) 2 1; lst#set_cell ~text:(kib2str !serverWritten) 2 2; lst#set_cell ~text: (kib2str (!clientWritten +. !serverWritten)) 2 3; true in ignore (GMain.Timeout.add ~ms:(truncate (delay *. 1000.)) ~callback:timeout); t (****) (* Standard file dialog *) let file_dialog ~title ~callback ?filename () = let sel = GWindow.file_selection ~title ~modal:true ?filename () in grabFocus sel; ignore (sel#cancel_button#connect#clicked ~callback:sel#destroy); ignore (sel#ok_button#connect#clicked ~callback: (fun () -> let name = sel#filename in sel#destroy (); callback name)); sel#show (); ignore (sel#connect#destroy ~callback:GMain.Main.quit); GMain.Main.main (); releaseFocus () (* ------ *) let fatalError message = Trace.log (message ^ "\n"); let title = "Fatal error" in let t = GWindow.dialog ~border_width:6 ~modal:true ~no_separator:true ~allow_grow:false () in t#vbox#set_spacing 12; let h1 = GPack.hbox ~border_width:6 ~spacing:12 ~packing:t#vbox#pack () in ignore (GMisc.image ~stock:`DIALOG_ERROR ~icon_size:`DIALOG ~yalign:0. ~packing:h1#pack ()); let v1 = GPack.vbox ~spacing:12 ~packing:h1#pack () in ignore (GMisc.label ~markup:(primaryText title ^ "\n\n" ^ escapeMarkup (transcode message)) ~selectable:true ~yalign:0. ~packing:v1#add ()); t#add_button_stock `QUIT `QUIT; t#set_default_response `QUIT; grabFocus t; t#show(); ignore (t#run ()); t#destroy (); releaseFocus (); exit 1 (* ------ *) let tryAgainOrQuit = fatalError (* ------ *) let getFirstRoot() = let t = GWindow.dialog ~title:"Root selection" ~modal:true ~allow_grow:true () in t#misc#grab_focus (); let hb = GPack.hbox ~packing:(t#vbox#pack ~expand:false ~padding:15) () in ignore(GMisc.label ~text:tryAgainMessage ~justify:`LEFT ~packing:(hb#pack ~expand:false ~padding:15) ()); let f1 = GPack.hbox ~spacing:4 ~packing:(t#vbox#pack ~expand:true ~padding:4) () in ignore (GMisc.label ~text:"Dir:" ~packing:(f1#pack ~expand:false) ()); let fileE = GEdit.entry ~packing:f1#add () in fileE#misc#grab_focus (); let browseCommand() = file_dialog ~title:"Select a local directory" ~callback:fileE#set_text ~filename:fileE#text () in let b = GButton.button ~label:"Browse" ~packing:(f1#pack ~expand:false) () in ignore (b#connect#clicked ~callback:browseCommand); let f3 = t#action_area in let result = ref None in let contCommand() = result := Some(fileE#text); t#destroy () in let contButton = GButton.button ~stock:`OK ~packing:f3#add () in ignore (contButton#connect#clicked ~callback:contCommand); ignore (fileE#connect#activate ~callback:contCommand); contButton#grab_default (); let quitButton = GButton.button ~stock:`QUIT ~packing:f3#add () in ignore (quitButton#connect#clicked ~callback:(fun () -> result := None; t#destroy())); t#show (); ignore (t#connect#destroy ~callback:GMain.Main.quit); GMain.Main.main (); match !result with None -> None | Some file -> Some(Clroot.clroot2string(Clroot.ConnectLocal(Some file))) (* ------ *) let getSecondRoot () = let t = GWindow.dialog ~title:"Root selection" ~modal:true ~allow_grow:true () in t#misc#grab_focus (); let message = "Please enter the second directory you want to synchronize." in let vb = t#vbox in let hb = GPack.hbox ~packing:(vb#pack ~expand:false ~padding:15) () in ignore(GMisc.label ~text:message ~justify:`LEFT ~packing:(hb#pack ~expand:false ~padding:15) ()); let helpB = GButton.button ~stock:`HELP ~packing:hb#add () in ignore (helpB#connect#clicked ~callback:(fun () -> okBox ~title:"Picking roots" ~typ:`INFO ~message:helpmessage)); let result = ref None in let f = GPack.vbox ~packing:(vb#pack ~expand:false) () in let f1 = GPack.hbox ~spacing:4 ~packing:f#add () in ignore (GMisc.label ~text:"Directory:" ~packing:(f1#pack ~expand:false) ()); let fileE = GEdit.entry ~packing:f1#add () in fileE#misc#grab_focus (); let browseCommand() = file_dialog ~title:"Select a local directory" ~callback:fileE#set_text ~filename:fileE#text () in let b = GButton.button ~label:"Browse" ~packing:(f1#pack ~expand:false) () in ignore (b#connect#clicked ~callback:browseCommand); let f0 = GPack.hbox ~spacing:4 ~packing:f#add () in let localB = GButton.radio_button ~packing:(f0#pack ~expand:false) ~label:"Local" () in let sshB = GButton.radio_button ~group:localB#group ~packing:(f0#pack ~expand:false) ~label:"SSH" () in let rshB = GButton.radio_button ~group:localB#group ~packing:(f0#pack ~expand:false) ~label:"RSH" () in let socketB = GButton.radio_button ~group:sshB#group ~packing:(f0#pack ~expand:false) ~label:"Socket" () in let f2 = GPack.hbox ~spacing:4 ~packing:f#add () in ignore (GMisc.label ~text:"Host:" ~packing:(f2#pack ~expand:false) ()); let hostE = GEdit.entry ~packing:f2#add () in ignore (GMisc.label ~text:"(Optional) User:" ~packing:(f2#pack ~expand:false) ()); let userE = GEdit.entry ~packing:f2#add () in ignore (GMisc.label ~text:"Port:" ~packing:(f2#pack ~expand:false) ()); let portE = GEdit.entry ~packing:f2#add () in let varLocalRemote = ref (`Local : [`Local|`SSH|`RSH|`SOCKET]) in let localState() = varLocalRemote := `Local; hostE#misc#set_sensitive false; userE#misc#set_sensitive false; portE#misc#set_sensitive false; b#misc#set_sensitive true in let remoteState() = hostE#misc#set_sensitive true; b#misc#set_sensitive false; match !varLocalRemote with `SOCKET -> (portE#misc#set_sensitive true; userE#misc#set_sensitive false) | _ -> (portE#misc#set_sensitive false; userE#misc#set_sensitive true) in let protoState x = varLocalRemote := x; remoteState() in ignore (localB#connect#clicked ~callback:localState); ignore (sshB#connect#clicked ~callback:(fun () -> protoState(`SSH))); ignore (rshB#connect#clicked ~callback:(fun () -> protoState(`RSH))); ignore (socketB#connect#clicked ~callback:(fun () -> protoState(`SOCKET))); localState(); let getRoot() = let file = fileE#text in let user = userE#text in let host = hostE#text in let port = portE#text in match !varLocalRemote with `Local -> Clroot.clroot2string(Clroot.ConnectLocal(Some file)) | `SSH | `RSH -> Clroot.clroot2string( Clroot.ConnectByShell((if !varLocalRemote=`SSH then "ssh" else "rsh"), host, (if user="" then None else Some user), (if port="" then None else Some port), Some file)) | `SOCKET -> Clroot.clroot2string( (* FIX: report an error if the port entry is not well formed *) Clroot.ConnectBySocket(host, portE#text, Some file)) in let contCommand() = try let root = getRoot() in result := Some root; t#destroy () with Failure "int_of_string" -> if portE#text="" then okBox ~title:"Error" ~typ:`ERROR ~message:"Please enter a port" else okBox ~title:"Error" ~typ:`ERROR ~message:"The port you specify must be an integer" | _ -> okBox ~title:"Error" ~typ:`ERROR ~message:"Something's wrong with the values you entered, try again" in let f3 = t#action_area in let contButton = GButton.button ~stock:`OK ~packing:f3#add () in ignore (contButton#connect#clicked ~callback:contCommand); contButton#grab_default (); ignore (fileE#connect#activate ~callback:contCommand); let quitButton = GButton.button ~stock:`QUIT ~packing:f3#add () in ignore (quitButton#connect#clicked ~callback:safeExit); t#show (); ignore (t#connect#destroy ~callback:GMain.Main.quit); GMain.Main.main (); !result (* ------ *) let getPassword rootName msg = let t = GWindow.dialog ~title:"Unison: SSH connection" ~position:`CENTER ~no_separator:true ~modal:true ~allow_grow:false ~border_width:6 () in t#misc#grab_focus (); t#vbox#set_spacing 12; let header = primaryText (Format.sprintf "Connecting to '%s'..." (protect rootName)) in let h1 = GPack.hbox ~border_width:6 ~spacing:12 ~packing:t#vbox#pack () in (* FIX: DIALOG_AUTHENTICATION is way better but is not available in the current release of LablGTK2... *) ignore (GMisc.image ~stock:(*`DIALOG_AUTHENTICATION*)`DIALOG_QUESTION ~icon_size:`DIALOG ~yalign:0. ~packing:h1#pack ()); let v1 = GPack.vbox ~spacing:12 ~packing:h1#pack () in ignore(GMisc.label ~markup:(header ^ "\n\n" ^ escapeMarkup (protect msg)) ~selectable:true ~yalign:0. ~packing:v1#pack ()); let passwordE = GEdit.entry ~packing:v1#pack ~visibility:false () in passwordE#misc#grab_focus (); t#add_button_stock `QUIT `QUIT; t#add_button_stock `OK `OK; t#set_default_response `OK; ignore (passwordE#connect#activate ~callback:(fun _ -> t#response `OK)); grabFocus t; t#show(); let res = t#run () in let pwd = passwordE#text in t#destroy (); releaseFocus (); gtk_sync (); begin match res with `DELETE_EVENT | `QUIT -> safeExit (); "" | `OK -> pwd end let termInteract = Some getPassword (* ------ *) type profileInfo = {roots:string list; label:string option} (* ------ *) let profileKeymap = Array.create 10 None let provideProfileKey filename k profile info = try let i = int_of_string k in if 0<=i && i<=9 then match profileKeymap.(i) with None -> profileKeymap.(i) <- Some(profile,info) | Some(otherProfile,_) -> raise (Util.Fatal ("Error scanning profile "^filename^":\n" ^ "shortcut key "^k^" is already bound to profile " ^ otherProfile)) else raise (Util.Fatal ("Error scanning profile "^filename^":\n" ^ "Value of 'key' preference must be a single digit (0-9), " ^ "not " ^ k)) with int_of_string -> raise (Util.Fatal ("Error scanning profile "^filename^":\n" ^ "Value of 'key' preference must be a single digit (0-9), " ^ "not " ^ k)) (* ------ *) let profilesAndRoots = ref [] let scanProfiles () = Array.iteri (fun i _ -> profileKeymap.(i) <- None) profileKeymap; profilesAndRoots := (Safelist.map (fun f -> let f = Filename.chop_suffix f ".prf" in let filename = Prefs.profilePathname f in let fileContents = Safelist.map (fun (_, _, n, v) -> (n, v)) (Prefs.readAFile f) in let roots = Safelist.map snd (Safelist.filter (fun (n, _) -> n = "root") fileContents) in let label = try Some(Safelist.assoc "label" fileContents) with Not_found -> None in let info = {roots=roots; label=label} in (* If this profile has a 'key' binding, put it in the keymap *) (try let k = Safelist.assoc "key" fileContents in provideProfileKey filename k f info with Not_found -> ()); (f, info)) (Safelist.filter (fun name -> not ( Util.startswith name ".#" || Util.startswith name Os.tempFilePrefix)) (Files.ls (Fspath.toString Os.unisonDir) "*.prf"))) let getProfile () = (* The selected profile *) let result = ref None in (* Build the dialog *) let t = GWindow.dialog ~title:"Profiles" ~width:400 () in let cancelCommand _ = t#destroy (); exit 0 in let cancelButton = GButton.button ~stock:`CANCEL ~packing:t#action_area#add () in ignore (cancelButton#connect#clicked ~callback:cancelCommand); ignore (t#event#connect#delete ~callback:cancelCommand); cancelButton#misc#set_can_default true; let okCommand() = currentWindow := None; t#destroy () in let okButton = GButton.button ~stock:`OK ~packing:t#action_area#add () in ignore (okButton#connect#clicked ~callback:okCommand); okButton#misc#set_sensitive false; okButton#grab_default (); let vb = t#vbox in ignore (GMisc.label ~text:"Select an existing profile or create a new one" ~xpad:2 ~ypad:5 ~packing:(vb#pack ~expand:false) ()); let sw = GBin.scrolled_window ~packing:(vb#pack ~expand:true) ~height:200 ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in let lst = GList.clist_poly ~selection_mode:`BROWSE ~packing:(sw#add) () in let selRow = ref 0 in let fillLst default = scanProfiles(); lst#freeze (); lst#clear (); let i = ref 0 in (* FIX: Work around a lablgtk bug *) Safelist.iter (fun (profile, info) -> let labeltext = match info.label with None -> "" | Some(l) -> " ("^l^")" in let s = profile ^ labeltext in ignore (lst#append [s]); if profile = default then selRow := !i; lst#set_row_data !i (profile, info); incr i) (Safelist.sort (fun (p, _) (p', _) -> compare p p') !profilesAndRoots); let r = lst#rows in let p = if r < 2 then 0. else float !selRow /. float (r - 1) in lst#scroll_vertical `JUMP p; lst#thaw () in let tbl = GPack.table ~rows:2 ~columns:2 ~packing:(vb#pack ~expand:true) () in tbl#misc#set_sensitive false; ignore (GMisc.label ~text:"Root 1:" ~xpad:2 ~packing:(tbl#attach ~left:0 ~top:0 ~expand:`NONE) ()); ignore (GMisc.label ~text:"Root 2:" ~xpad:2 ~packing:(tbl#attach ~left:0 ~top:1 ~expand:`NONE) ()); let root1 = GEdit.entry ~packing:(tbl#attach ~left:1 ~top:0 ~expand:`X) ~editable:false () in let root2 = GEdit.entry ~packing:(tbl#attach ~left:1 ~top:1 ~expand:`X) ~editable:false () in root1#misc#set_can_focus false; root2#misc#set_can_focus false; let hb = GPack.hbox ~border_width:2 ~spacing:2 ~packing:(vb#pack ~expand:false) () in let nw = GButton.button ~label:"Create new profile" ~packing:(hb#pack ~expand:false) () in ignore (nw#connect#clicked ~callback:(fun () -> let t = GWindow.dialog ~title:"New profile" ~modal:true () in let vb = GPack.vbox ~border_width:4 ~packing:t#vbox#add () in let f = GPack.vbox ~packing:(vb#pack ~expand:true ~padding:4) () in let f0 = GPack.hbox ~spacing:4 ~packing:f#add () in ignore (GMisc.label ~text:"Profile name:" ~packing:(f0#pack ~expand:false) ()); let prof = GEdit.entry ~packing:f0#add () in prof#misc#grab_focus (); let exit () = t#destroy (); GMain.Main.quit () in ignore (t#event#connect#delete ~callback:(fun _ -> exit (); true)); let f3 = t#action_area in let okCommand () = let profile = prof#text in if profile <> "" then let filename = Prefs.profilePathname profile in if Sys.file_exists filename then okBox ~title:"Error" ~typ:`ERROR ~message:("Profile \"" ^ (transcodeFilename profile) ^ "\" already exists!\nPlease select another name.") else (* Make an empty file *) let ch = open_out_gen [Open_wronly; Open_creat; Open_trunc] 0o600 filename in close_out ch; fillLst profile; exit () in let okButton = GButton.button ~stock:`OK ~packing:f3#add () in ignore (okButton#connect#clicked ~callback:okCommand); okButton#grab_default (); let cancelButton = GButton.button ~stock:`CANCEL ~packing:f3#add () in ignore (cancelButton#connect#clicked ~callback:exit); t#show (); grabFocus t; GMain.Main.main (); releaseFocus ())); ignore (lst#connect#unselect_row ~callback:(fun ~row:_ ~column:_ ~event:_ -> root1#set_text ""; root2#set_text ""; result := None; tbl#misc#set_sensitive false; okButton#misc#set_sensitive false)); let select_row i = (* Inserting the first row triggers the signal, even before the row data is set. So, we need to catch the corresponding exception *) (try let (profile, info) = lst#get_row_data i in result := Some profile; begin match info.roots with [r1; r2] -> root1#set_text (protect r1); root2#set_text (protect r2); tbl#misc#set_sensitive true | _ -> root1#set_text ""; root2#set_text ""; tbl#misc#set_sensitive false end; okButton#misc#set_sensitive true with Gpointer.Null -> ()) in ignore (lst#connect#select_row ~callback:(fun ~row:i ~column:_ ~event:_ -> select_row i)); ignore (lst#event#connect#button_press ~callback:(fun ev -> match GdkEvent.get_type ev with `TWO_BUTTON_PRESS -> okCommand (); true | _ -> false)); fillLst "default"; select_row !selRow; lst#misc#grab_focus (); currentWindow := Some (t :> GWindow.window_skel); ignore (t#connect#destroy ~callback:GMain.Main.quit); t#show (); GMain.Main.main (); !result (* ------ *) let documentation sect = let title = "Documentation" in let t = GWindow.dialog ~title () in let t_dismiss = GButton.button ~stock:`CLOSE ~packing:t#action_area#add () in t_dismiss#grab_default (); let dismiss () = t#destroy () in ignore (t_dismiss#connect#clicked ~callback:dismiss); ignore (t#event#connect#delete ~callback:(fun _ -> dismiss (); true)); let (name, docstr) = Safelist.assoc sect Strings.docs in let docstr = transcodeDoc docstr in let hb = GPack.hbox ~packing:(t#vbox#pack ~expand:false ~padding:2) () in let optionmenu = GMenu.option_menu ~packing:(hb#pack ~expand:true ~fill:false) () in let t_text = new scrolled_text ~editable:false ~width:80 ~height:20 ~packing:t#vbox#add () in t_text#insert docstr; let sect_idx = ref 0 in let idx = ref 0 in let menu = GMenu.menu () in let addDocSection (shortname, (name, docstr)) = if shortname <> "" && name <> "" then begin if shortname = sect then sect_idx := !idx; incr idx; let item = GMenu.menu_item ~label:name ~packing:menu#append () in let docstr = transcodeDoc docstr in ignore (item#connect#activate ~callback:(fun () -> t_text#insert docstr)) end in Safelist.iter addDocSection Strings.docs; optionmenu#set_menu menu; optionmenu#set_history !sect_idx; t#show () (* ------ *) let messageBox ~title ?(action = fun t -> t#destroy) ?(modal = false) message = let utitle = transcode title in let t = GWindow.dialog ~title:utitle ~modal ~position:`CENTER () in let t_dismiss = GButton.button ~stock:`CLOSE ~packing:t#action_area#add () in t_dismiss#grab_default (); ignore (t_dismiss#connect#clicked ~callback:(action t)); let t_text = new scrolled_text ~editable:false ~width:80 ~height:20 ~packing:t#vbox#add () in t_text#insert message; ignore (t#event#connect#delete ~callback:(fun _ -> action t (); true)); t#show (); if modal then begin grabFocus t; GMain.Main.main (); releaseFocus () end (* twoBoxAdvanced: Display a message in a window and wait for the user to hit one of two buttons. Return true if the first button is chosen, false if the second button is chosen. Also has a button for showing more details to the user in a messageBox dialog *) let twoBoxAdvanced ~title ~message ~longtext ~advLabel ~astock ~bstock = let t = GWindow.dialog ~border_width:6 ~modal:false ~no_separator:true ~allow_grow:false () in t#vbox#set_spacing 12; let h1 = GPack.hbox ~border_width:6 ~spacing:12 ~packing:t#vbox#pack () in ignore (GMisc.image ~stock:`DIALOG_WARNING ~icon_size:`DIALOG ~yalign:0. ~packing:h1#pack ()); let v1 = GPack.vbox ~spacing:12 ~packing:h1#pack () in ignore (GMisc.label ~markup:(primaryText title ^ "\n\n" ^ escapeMarkup message) ~selectable:true ~yalign:0. ~packing:v1#add ()); t#add_button_stock `CANCEL `NO; let cmd () = messageBox ~title:"Details" ~modal:false longtext in t#add_button advLabel `HELP; t#add_button_stock `APPLY `YES; t#set_default_response `NO; let res = ref false in let setRes signal = match signal with `YES -> res := true; t#destroy () | `NO -> res := false; t#destroy () | `HELP -> cmd () | _ -> () in ignore (t#connect#response ~callback:setRes); ignore (t#connect#destroy ~callback:GMain.Main.quit); grabFocus t; t#show(); GMain.Main.main(); releaseFocus (); !res (********************************************************************** TOP-LEVEL WINDOW **********************************************************************) let myWindow = ref None let getMyWindow () = if not (Prefs.read Uicommon.reuseToplevelWindows) then begin (match !myWindow with Some(w) -> w#destroy() | None -> ()); myWindow := None; end; let w = match !myWindow with Some(w) -> Safelist.iter w#remove w#children; w | None -> (* Used to be ~position:`CENTER -- maybe that was better... *) GWindow.window ~kind:`TOPLEVEL ~position:`CENTER ~title:myNameCapitalized () in myWindow := Some(w); w#set_allow_grow true; w (* ------ *) let displayWaitMessage () = if not (Prefs.read Uicommon.contactquietly) then begin (* FIX: should use a dialog *) let w = getMyWindow() in w#set_allow_grow false; currentWindow := Some (w :> GWindow.window_skel); let v = GPack.vbox ~packing:(w#add) ~border_width:2 () in let bb = GPack.button_box `HORIZONTAL ~layout:`END ~spacing:10 ~border_width:5 ~packing:(v#pack ~fill:true ~from:`END) () in let h1 = GPack.hbox ~border_width:12 ~spacing:12 ~packing:v#pack () in ignore (GMisc.image ~stock:`DIALOG_INFO ~icon_size:`DIALOG ~yalign:0. ~packing:h1#pack ()); let m = GMisc.label ~markup:(primaryText (Uicommon.contactingServerMsg())) ~yalign:0. ~selectable:true ~packing:h1#add () in m#misc#set_can_focus false; let quit = GButton.button ~stock:`QUIT ~packing:bb#pack () in quit#grab_default (); ignore (quit#connect#clicked ~callback:safeExit); ignore (w#event#connect#delete ~callback:(fun _ -> safeExit (); true)); w#show() end (* ------ *) let rec createToplevelWindow () = let toplevelWindow = getMyWindow() in (* There is already a default icon under Windows, and transparent icons are not supported by all version of Windows *) if Util.osType <> `Win32 then toplevelWindow#set_icon (Some icon); let toplevelVBox = GPack.vbox ~packing:toplevelWindow#add () in (******************************************************************* Statistic window *******************************************************************) let stat_win = statistics () in (******************************************************************* Groups of things that are sensitive to interaction at the same time *******************************************************************) let grAction = ref [] in let grDiff = ref [] in let grGo = ref [] in let grRestart = ref [] in let grAdd gr w = gr := w#misc::!gr in let grSet gr st = Safelist.iter (fun x -> x#set_sensitive st) !gr in (********************************************************************* Create the menu bar *********************************************************************) let topHBox = GPack.hbox ~packing:(toplevelVBox#pack ~expand:false) () in let menuBar = GMenu.menu_bar ~border_width:0 ~packing:(topHBox#pack ~expand:true) () in let menus = new GMenu.factory ~accel_modi:[] menuBar in let accel_group = menus#accel_group in toplevelWindow#add_accel_group accel_group; let add_submenu ?(modi=[]) ~label () = new GMenu.factory ~accel_group ~accel_modi:modi (menus#add_submenu label) in let profileLabel = GMisc.label ~text:"" ~packing:(topHBox#pack ~expand:false ~padding:2) () in let displayNewProfileLabel p = let label = Prefs.read Uicommon.profileLabel in let s = if p="" then "" else if p="default" then label else if label="" then p else p ^ " (" ^ label ^ ")" in toplevelWindow#set_title (if s = "" then myNameCapitalized else Format.sprintf "%s [%s]" myNameCapitalized s); let s = if s="" then "" else "Profile: " ^ s in profileLabel#set_text (transcodeFilename s) in begin match !Prefs.profileName with None -> () | Some(p) -> displayNewProfileLabel p end; (********************************************************************* Create the menus *********************************************************************) let fileMenu = add_submenu ~label:"Synchronization" () and actionsMenu = add_submenu ~label:"Actions" () and ignoreMenu = add_submenu ~modi:[`SHIFT] ~label:"Ignore" () and sortMenu = add_submenu ~label:"Sort" () and helpMenu = add_submenu ~label:"Help" () in (********************************************************************* Action bar *********************************************************************) let actionBar = let hb = GBin.handle_box ~packing:(toplevelVBox#pack ~expand:false) () in GButton.toolbar ~style:`BOTH (* 2003-0519 (stse): how to set space size in gtk 2.0? *) (* Answer from Jacques Garrigue: this can only be done in the user's.gtkrc, not programmatically *) ~orientation:`HORIZONTAL ~tooltips:true (* ~space_size:10 *) ~packing:(hb#add) () in (********************************************************************* Create the main window *********************************************************************) let mainWindow = let sw = GBin.scrolled_window ~packing:(toplevelVBox#pack ~expand:true) ~height:(Prefs.read Uicommon.mainWindowHeight * 12) ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in GList.clist ~columns:5 ~titles_show:true ~selection_mode:`BROWSE ~packing:sw#add () in mainWindow#misc#grab_focus (); (* let cols = new GTree.column_list in let c_replica1 = cols#add Gobject.Data.string in let c_action = cols#add Gobject.Data.gobject in let c_replica2 = cols#add Gobject.Data.string in let c_status = cols#add Gobject.Data.string in let c_path = cols#add Gobject.Data.string in let lst_store = GTree.list_store cols in let lst = GTree.view ~model:lst_store ~packing:(toplevelVBox#add) ~headers_clickable:false () in let s = Uicommon.roots2string () in ignore (lst#append_column (GTree.view_column ~title:(" " ^ protect (String.sub s 0 12) ^ " ") ~renderer:(GTree.cell_renderer_text [], ["text", c_replica1]) ())); ignore (lst#append_column (GTree.view_column ~title:" Action " ~renderer:(GTree.cell_renderer_pixbuf [], ["pixbuf", c_action]) ())); ignore (lst#append_column (GTree.view_column ~title:(" " ^ protect (String.sub s 15 12) ^ " ") ~renderer:(GTree.cell_renderer_text [], ["text", c_replica2]) ())); ignore (lst#append_column (GTree.view_column ~title:" Status " ())); ignore (lst#append_column (GTree.view_column ~title:" Path " ~renderer:(GTree.cell_renderer_text [], ["text", c_path]) ())); *) (* let status_width = let font = mainWindow#misc#style#font in 4 + max (max (Gdk.Font.string_width font "working") (Gdk.Font.string_width font "skipped")) (Gdk.Font.string_width font " Action ") in *) mainWindow#set_column ~justification:`CENTER 1; mainWindow#set_column ~justification:`CENTER (*~auto_resize:false ~width:status_width*) 3; let setMainWindowColumnHeaders () = (* FIX: roots2string should return a pair *) let s = Uicommon.roots2string () in Array.iteri (fun i data -> mainWindow#set_column ~title_active:false ~auto_resize:true ~title:data i) [| " " ^ protect (String.sub s 0 12) ^ " "; " Action "; " " ^ protect (String.sub s 15 12) ^ " "; " Status "; " Path" |] in setMainWindowColumnHeaders(); (********************************************************************* Create the details window *********************************************************************) let (showDetailsButton, detailsWindow) = let sw = GBin.frame ~packing:(toplevelVBox#pack ~expand:false) ~shadow_type:`IN (*~hpolicy:`AUTOMATIC ~vpolicy:`NEVER*) () in let hb =GPack.hbox ~packing:sw#add () in (GButton.button ~label:"View details..." ~show:false ~packing:(hb#pack ~expand:false) (), GText.view ~editable:false ~wrap_mode:`NONE ~packing:hb#add ()) in detailsWindow#misc#modify_font (Lazy.force fontMonospaceMediumPango); detailsWindow#misc#set_size_chars ~height:3 ~width:112 (); detailsWindow#misc#set_can_focus false; let showDetCommand () = let details = match !current with None -> "[No details available]" | Some row -> (match !theState.(row).whatHappened with Some (Util.Failed _, Some det) -> det | _ -> "[No details available]") in messageBox ~title:"Merge execution details" details in ignore (showDetailsButton#connect#clicked ~callback:showDetCommand); let updateButtons () = match !current with None -> grSet grAction false; grSet grDiff false; showDetailsButton#misc#hide () | Some row -> let (details, activate1, activate2) = match !theState.(row).whatHappened, !theState.(row).ri.replicas with | None, Different((`FILE, _, _, _),(`FILE, _, _, _), _, _) -> (false, true, true) | Some res, Different((`FILE, _, _, _),(`FILE, _, _, _), _, _) -> (match res with Util.Succeeded, _ -> (false, false, true) | Util.Failed s, None -> (false, false, true) | Util.Failed s, Some dText -> (true, false, false) ) | Some res, _ -> (match res with Util.Succeeded, _ -> (false, false, false) | Util.Failed s, None -> (false, false, false) | Util.Failed s, Some dText -> (true, false, false) ) | None, _ -> (false, true, false) in if not !busy then begin grSet grAction activate1; grSet grDiff activate2 end; 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 *) unison-2.32.52/uigtk2.mli0000644000076500000000000000022211176730177014550 0ustar bcpiercewheel(* Unison file synchronizer: src/uigtk2.mli *) (* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) module Body : Uicommon.UI unison-2.32.52/uimac/0000755000076500000000000000000011222164527013732 5ustar bcpiercewheelunison-2.32.52/uimac/cltool.c0000644000076500000000000000407111176730177015404 0ustar bcpiercewheel/* cltool.c This is a command-line tool for Mac OS X that looks up the unison application, where ever it has been installed, and runs it. This is intended to be installed in a standard place (e.g., /usr/bin/unison) to make it easy to invoke unison as a server, or to use unison from the command line when it has been installed with a GUI. */ #import #import #include #define BUFSIZE 1024 #define EXECPATH "/Contents/MacOS/Unison" int main(int argc, char **argv) { /* Look up the application by its bundle identifier, which is given in the Info.plist file. This will continue to work even if the user changes the name of the application, unlike fullPathForApplication. */ FSRef fsref; OSStatus status; int len; char buf[BUFSIZE]; status = LSFindApplicationForInfo(kLSUnknownCreator,CFSTR("edu.upenn.cis.Unison"),NULL,&fsref,NULL); if (status) { if (status == kLSApplicationNotFoundErr) { fprintf(stderr,"Error: can't find the Unison application using the Launch Services database.\n"); fprintf(stderr,"Try launching Unison from the Finder, and then try this again.\n",status); } else fprintf(stderr,"Error: can't find Unison application (%d).\n",status); exit(1); } status = FSRefMakePath(&fsref,buf,BUFSIZE); if (status) { fprintf(stderr,"Error: problem building path to Unison application (%d).\n",status); exit(1); } len = strlen(buf); if (len + strlen(EXECPATH) + 1 > BUFSIZE) { fprintf(stderr,"Error: path to Unison application exceeds internal buffer size (%d).\n",BUFSIZE); exit(1); } strcat(buf,EXECPATH); /* It's important to pass the absolute path on to the GUI, that's how it knows where to find the bundle, e.g., the Info.plist file. */ argv[0] = buf; // printf("The Unison executable is at %s\n",argv[0]); // printf("Running...\n"); execv(argv[0],argv); /* If we get here the execv has failed; print an error message to stderr */ perror("unison"); exit(1); } unison-2.32.52/uimac/English.lproj/0000755000076500000000000000000011222164527016450 5ustar bcpiercewheelunison-2.32.52/uimac/English.lproj/InfoPlist.strings0000644000076500000000000000102211176730177021775 0ustar bcpiercewheel/* Localized versions of Info.plist keys */ CFBundleName = "Unison"; CFBundleShortVersionString = "Unison"; CFBundleGetInfoString = "Unison, Copyright 1999-2004, licensed under GNU GPL."; NSHumanReadableCopyright = "Copyright 1999-2004, licensed under GNU GPL."; unison-2.32.52/uimac/English.lproj/MainMenu.nib/0000755000076500000000000000000011222164527020730 5ustar bcpiercewheelunison-2.32.52/uimac/English.lproj/MainMenu.nib/classes.nib0000644000076500000000000000670611176730177023100 0ustar bcpiercewheel{ IBClasses = ( { ACTIONS = { copyLR = id; copyRL = id; forceNewer = id; forceOlder = id; ignoreExt = id; ignoreName = id; ignorePath = id; leaveAlone = id; merge = id; revert = id; selectConflicts = id; }; CLASS = FirstResponder; LANGUAGE = ObjC; SUPERCLASS = NSObject; }, { ACTIONS = { cancelProfileButton = id; createButton = id; endPasswordWindow = id; installCommandLineTool = id; onlineHelp = id; openButton = id; raiseAboutWindow = id; restartButton = id; saveProfileButton = id; syncButton = id; }; CLASS = MyController; LANGUAGE = ObjC; OUTLETS = { ConnectingView = NSView; aboutWindow = NSWindow; chooseProfileView = NSView; detailsTextView = NSTextView; mainWindow = NSWindow; passwordCancelButton = NSButton; passwordText = NSTextField; passwordWindow = NSWindow; preferencesController = PreferencesController; preferencesView = NSView; profileController = ProfileController; statusText = NSTextField; tableView = ReconTableView; updatesText = NSTextField; updatesView = NSView; versionText = NSTextField; }; SUPERCLASS = NSObject; }, { ACTIONS = {anyEnter = id; localClick = id; remoteClick = id; }; CLASS = PreferencesController; LANGUAGE = ObjC; OUTLETS = { cancelButton = NSButton; firstRootText = NSTextField; localButtonCell = NSButtonCell; profileNameText = NSTextField; remoteButtonCell = NSButtonCell; saveButton = NSButton; secondRootHost = NSTextField; secondRootText = NSTextField; secondRootUser = NSTextField; }; SUPERCLASS = NSObject; }, { CLASS = ProfileController; LANGUAGE = ObjC; OUTLETS = {tableView = NSTableView; }; SUPERCLASS = NSObject; }, { CLASS = ProfileTableView; LANGUAGE = ObjC; OUTLETS = {myController = MyController; }; SUPERCLASS = NSTableView; }, {CLASS = ReconItem; LANGUAGE = ObjC; SUPERCLASS = NSObject; }, { ACTIONS = { copyLR = id; copyRL = id; forceNewer = id; forceOlder = id; ignoreExt = id; ignoreName = id; ignorePath = id; leaveAlone = id; merge = id; revert = id; selectConflicts = id; }; CLASS = ReconTableView; LANGUAGE = ObjC; SUPERCLASS = NSTableView; } ); IBVersion = 1; }unison-2.32.52/uimac/English.lproj/MainMenu.nib/info.nib0000644000076500000000000000175011176730177022370 0ustar bcpiercewheel IBDocumentLocation 318 45 509 310 0 0 1280 832 IBEditorPositions 197 450 391 383 326 0 0 1280 832 198 307 297 669 515 0 0 1280 832 29 72 209 280 44 0 0 1280 832 307 392 388 499 332 0 0 1280 832 423 450 391 383 326 0 0 1280 832 IBFramework Version 364.0 IBOpenObjects 423 198 29 402 234 21 307 197 IBSystem Version 7U16 unison-2.32.52/uimac/English.lproj/MainMenu.nib/objects.nib0000644000076500000000000003776311176730177023103 0ustar bcpiercewheel typedstream@NSIBObjectDataNSObjectNSCustomObject)@@NSMutableStringNSString+ NSApplicationif NSTableColumn)@fff@@ccprofilesCB=s脄NSTableHeaderCellNSTextFieldCell> NSActionCellNSCellAii@@@@ProfilesNSFont$[36c]LucidaGrandef c i:c@@NSColorff>@@@SystemheaderTextColor1@$LucidaGrande NSClassSwapper*@#ProfileTableView NSTableView= NSControl)NSView) NSResponder NSClipView: NSScrollViewⲒ NSCustomView) @@@@ffffffffNSMutableArrayNSArray NSTextField #܁#,#,icc@@?Welcome to Unison! Please choose a profile or create a new one  controlColor?*controlTextColor:NSButton! T T  NSButtonCell?8OpenƄ ssii@@@@@@[28c]Helvetica ǒT T ɡ8Quitν@ͅǒ! C C ɡ8Newӽ@ͅkkNSView NSResponder NSScrollerӱ3ff:?4 _doScroller:ܒqq?}NSTableHeaderViewޚ22ޒ22@@ccccontrolBackgroundColorÆ _NSCornerView3<CCےݒޒffffi 2222 @@@ff@@f::i䄻 gridColor?@Ćǒ횂 gg풅@Let's update some stuff! Ć횂ReconTableViewPPƄᒄPP򒅒PPQ򒅒left___Left>1@Ć direction222Action1@Ćright___Right headerColor膧1@$LucidaGrande Ćprogress<<<Progress 1@ĆpathC)ȁ脞Path 1@ĆZ@PP򒅒ܒQ򒅒?wqܒPP򒅒?{]saa풅 쒄횂NSTextTemplateƄNSViewTemplate. NSMutableSetNSSetI Apple PDF pasteboard typeApple PICT pasteboard typeNSStringPboardType*NeXT Rich Text Format v1.0 pasteboard type1NeXT Encapsulated PostScript v1.2 pasteboard typeApple HTML pasteboard typeNSFilenamesPboardTypeNeXT TIFF v4.0 pasteboard typeNSColor pasteboard typeNeXT RTFD pasteboard type#CorePasteboardFlavorType 0x6D6F6F76_-_-NSText textColorHelvetica 誁-__-_- 脄NSCursorNSImage.sNSBitmapImageRep NSImageRep„[1218c]MM* (R ' 'ܒDDܒWW?rC<a/a/풅=> ǒ횂 U U 풅ɡ8Restart?@ͅ횂 풅@Status DĆْNSView NSResponder u u 풅ɡ8 Synchronize콁@ͅ햄 NSMenuItemNSMenu̔i@@@Unison NO i@@IIi@@@@:i@ About UnisonNSCustomResource)NSImageNSMenuCheckmarkWXNSMenuMixedStateNOՂUUVZNOPreferences...,VZNOInstall command-line toolUVZNOՂUUVZNO Hide UnisonhVZNO Hide OthershVZMNOՂUUVZNO Quit UnisonqVZ _NSAppleMenuShow AllUVZO MyControllerǒNSBox*r tw w@File: yĆw.wwwqA@U|textBackgroundColor233tGGrff@@ccc First root~ĆwurNSMatrix> 'F&F&#iiii:::ffffi@@@@@FD(ɡRemoteHVZNPropagate Right to Left<VZΒNPropagate Older to NewerUVZN Leave Alone/VZN!Revert to Unison's RecommendationUVZNMergeUVZNՂ@UUVZNRestartrVZNSynchronize allgVZPropagate Newer to OlderUVZϖ]OjO?햄PMainMenuNQUVZsubmenuAction:ONEditUVZPEditNCutxVZNCopycVZNPastevVZN Select AllaVZNSelect ConflictsUVZNUVZφNIgnoreUVZPN Ignore PathiVZNIgnore ExtensioneVZN Ignore NamenVZNHelpUVZPNUnison Online Help?VZ _NSMainMenuNSWindowTemplate iiffffi@@@@@cp  pxUNSWindowView@@Unison,[44c]$LucidaGrande-Bold~244@X© Copyright 1999-2005. This software is licensed under the GNU General Public License.$LucidaGrande   ~2 NSImageView$Apple PDF pasteboard typeNeXT TIFF v4.0 pasteboard type1NeXT Encapsulated PostScript v1.2 pasteboard typeNSFilenamesPboardTypeApple PICT pasteboard type@@ NSImageCell)WXUnisoniiie@@Sync you very much!$Optima-Italic 0~2@@?.?.?$LucidaGrande 4~2   ffff@Ձ hhhpxUnisonNSWindowView8@ՁRpxPasswordWindowNSWindowView@Ձ؁ϖ`OwtθPreferencesController0햁ȁƖ$݁ϖbOځϖProfileControllerϖ閁 r ρcO:ywiOr ߁ϖ閁ҁϖ햁>D햁O얁fOϖ4ƸSO햁閁ՁϖrϚDNSButton NSTableView NSTextField1j1111턙 updatesView>PasswordWindow NSTableColumnrPreferencesView NSTextField214 NSTextField3 NSMenuItem1 NSButtonCell1chooseProfileViewNSView NSMenuItem9DE1NSTableColumn1 AboutWindow NSTextFieldƄConnectingViewȄ NSTextField]121 NSTextFieldwNSView NSButtonCell| NSTextField򄙙 NSScrollView1 NSTextField2򄙙 NSMenuItem3NSMenu NSMenuItem10 NSMatrix1 NSScrollView1섙 NSButton1 NSTableView NSTextField4 NSTextField2 NSTextField1 NSTextField22:Window NSScrollView2tNSBox2? NSButton21q NSButton1 NSTextField23 NSTextField2NSButton鄘MainMenuƄNSButton턙 NSMenuItemNSBox1΄ NSButton1D NSTextField1 File's Ownery NSTextField2 NSButton1ӄ NSButton2 NSTextView NSTextField3BC NSTextField NSTextField2 NSTableColumn0 NSTextField2op$:JNSNibControlConnectorτNSNibConnectorj terminate:fhideOtherApplications:chide:MunhideAllApplications:򅄘cut:paste: selectAll:copy:NSNibOutletConnectorρo턙 updatesViewochooseProfileViewo createButton:o openButton:?orestartButton:o: mainWindowD tableViewD dataSourceo updatesTextoDprofileControllero tableViewo dataSourceo syncButton:oendPasswordWindow:o>passwordWindowo passwordTextoendPasswordWindow:o detailsTextViewodelegate ignorePath: ignoreExt: ignoreName:҅copyLR:ՅcopyRL:selectConflicts:݅revert:΅ forceNewer:؅ forceOlder:څ leaveAlone:oD statusTextBprofileNameTextBq cancelButtonB saveButtonoBpreferencesControllerorpreferencesViewB| firstRootTextBsecondRootUserBsecondRootHostBsecondRootTextBremoteButtonCellBlocalButtonCell| nextKeyView|B remoteClick:B localClick:ƁƭosaveProfileButton:qocancelProfileButton:opasswordCancelButtonodelegateo myControllero aboutWindowo4 versionTextSoraiseAboutWindow:o onlineHelp:o syncButton:߅merge:oƄConnectingView`oinstallCommandLineTool:o restartButton@irCځQj皁x`ρ΁lDI΁Dj܁R罁tBKy oЁ04Gf Ɓށ^m\?yjā݁ zs縁ҁ綁J ҁ΁fionƁp{8bԁ  uwB]ӁȁƁ|ց2qH筁tA}>qoMvO9~ȁʁ߁$c؁Lr3 :ځD0g؁ |kwS8́Ձ 皁IBCocoaFrameworkunison-2.32.52/uimac/Info.plist0000644000076500000000000000000011176730177015700 0ustar bcpiercewheelunison-2.32.52/uimac/Info.plist.template0000644000076500000000000000211711176730177017525 0ustar bcpiercewheel CFBundleName Unison CFBundleDevelopmentRegion English CFBundleExecutable Unison CFBundleIconFile Unison.icns CFBundleIdentifier edu.upenn.cis.Unison CFBundleInfoDictionaryVersion 6.0 CFBundlePackageType APPL CFBundleSignature ???? CFBundleVersion @@VERSION@@ CFBundleShortVersionString @@VERSION@@ CFBundleGetInfoString @@VERSION@@. ©1999-2007, licensed under GNU GPL. NSHumanReadableCopyright ©1999-2006, licensed under GNU GPL. NSMainNibFile MainMenu NSPrincipalClass NSApplication unison-2.32.52/uimac/main.m0000644000076500000000000000573711176730177015060 0ustar bcpiercewheel// // main.m // uimac // // Created by Trevor Jim on Sun Aug 17 2003. // Copyright (c) 2003, see file COPYING for details. // #import #define CAML_NAME_SPACE #include void reportExn(value e) { value *f = caml_named_value("unisonExnInfo"); char *m = String_val(caml_callback(*f,Extract_exception(e))); NSString *s = [NSString stringWithFormat:@"Uncaught exception: %s", m]; NSLog(@"%@",s); NSRunAlertPanel(@"Fatal error",s,@"Exit",nil,nil); } value Callback_checkexn(value c,value v) { value e = caml_callback_exn(c,v); if (!Is_exception_result(e)) return e; reportExn(e); exit(1); } value Callback2_checkexn(value c,value v1,value v2) { value e = caml_callback2_exn(c,v1,v2); if (!Is_exception_result(e)) return e; reportExn(e); exit(1); } value Callback3_checkexn(value c,value v1,value v2,value v3) { value e = caml_callback3_exn(c,v1,v2,v3); if (!Is_exception_result(e)) return e; reportExn(e); exit(1); } int main(int argc, const char *argv[]) { int i; /* When you click-start or use the open command, the program is invoked with a command-line arg of the form -psn_XXXXXXXXX. The XXXXXXXX is a "process serial number" and it seems to be important for Carbon programs. We need to get rid of it if it's there so the ocaml code won't exit. Note, the extra arg is not added if the binary is invoked directly from the command line without using the open command. */ if (argc == 2 && strncmp(argv[1],"-psn_",5) == 0) { argc--; argv[1] = NULL; } /* Initialize ocaml gc, etc. */ caml_startup((char **)argv); // cast to avoid warning, caml_startup assumes non-const, // NSApplicationMain assumes const /* Check for invocations that don't start up the gui */ for (i=1; i #define CAML_NAME_SPACE #include #import "ProfileController.h" #import "PreferencesController.h" #import "ReconTableView.h" @interface MyController : NSObject { IBOutlet NSWindow *mainWindow; IBOutlet ProfileController *profileController; IBOutlet NSView *chooseProfileView; NSSize chooseProfileSize; IBOutlet PreferencesController *preferencesController; IBOutlet NSView *preferencesView; NSSize preferencesSize; IBOutlet NSView *updatesView; NSSize updatesSize; IBOutlet NSView *ConnectingView; NSSize ConnectingSize; IBOutlet ReconTableView *tableView; IBOutlet NSTextField *updatesText; IBOutlet NSWindow *passwordWindow; IBOutlet NSTextField *passwordText; IBOutlet NSTextView *detailsTextView; IBOutlet NSTextField *statusText; IBOutlet NSButton *passwordCancelButton; IBOutlet NSWindow *aboutWindow; IBOutlet NSTextField *versionText; NSView *blankView; value caml_reconItems; NSMutableArray *reconItems; value preconn; NSString *pName; } - (IBAction)createButton:(id)sender; - (IBAction)saveProfileButton:(id)sender; - (IBAction)cancelProfileButton:(id)sender; - (IBAction)openButton:(id)sender; - (IBAction)restartButton:(id)sender; - (IBAction)syncButton:(id)sender; - (IBAction)onlineHelp:(id)sender; - (int)numberOfRowsInTableView:(NSTableView *)aTableView; - (id)tableView:(NSTableView *)aTableView objectValueForTableColumn:(NSTableColumn *)aTableColumn row:(int)rowIndex; - (void)raisePasswordWindow:(NSString *)prompt; - (IBAction)raiseAboutWindow:(id)sender; - (void)controlTextDidEndEditing:(NSNotification *)notification; - (IBAction)endPasswordWindow:(id)sender; - (NSMutableArray *)reconItems; - (int)updateForIgnore:(int)i; - (void)displayDetails:(int)i; - (IBAction)installCommandLineTool:(id)sender; @end unison-2.32.52/uimac/MyController.m0000644000076500000000000003750611176730177016564 0ustar bcpiercewheel/* Copyright (c) 2003, see file COPYING for details. */ #import "MyController.h" #import "ReconItem.h" #include #include #include #include extern value Callback_checkexn(value,value); extern value Callback2_checkexn(value,value,value); @implementation MyController static MyController *me; // needed by reloadTable and displayStatus, below - (void)resizeWindowToSize:(NSSize)newSize { NSRect aFrame; float newHeight = newSize.height; float newWidth = newSize.width; aFrame = [NSWindow contentRectForFrameRect:[mainWindow frame] styleMask:[mainWindow styleMask]]; aFrame.origin.y += aFrame.size.height; aFrame.origin.y -= newHeight; aFrame.size.height = newHeight; aFrame.size.width = newWidth; aFrame = [NSWindow frameRectForContentRect:aFrame styleMask:[mainWindow styleMask]]; [mainWindow setFrame:aFrame display:YES animate:YES]; } - (void)chooseProfiles { [mainWindow setContentView:blankView]; [self resizeWindowToSize:chooseProfileSize]; [mainWindow setContentView:chooseProfileView]; [mainWindow makeFirstResponder:[profileController tableView]]; // profiles get keyboard input } - (IBAction)createButton:(id)sender { [preferencesController reset]; [mainWindow setContentView:blankView]; [self resizeWindowToSize:preferencesSize]; [mainWindow setContentView:preferencesView]; } - (IBAction)saveProfileButton:(id)sender { if ([preferencesController validatePrefs]) { [profileController initProfiles]; // so the list contains the new profile [self chooseProfiles]; } } - (IBAction)cancelProfileButton:(id)sender { [self chooseProfiles]; } - (void)updateReconItems { [reconItems release]; reconItems = [[NSMutableArray alloc] init]; int j = 0; int n = Wosize_val(caml_reconItems); for (; j= 0 && i < [reconItems count]) [detailsTextView setString:[[reconItems objectAtIndex:i] details]]; } - (void)clearDetails { [detailsTextView setString:@""]; } - (void)doUpdateThread:(id)whatever { NSAutoreleasePool *pool = [[NSAutoreleasePool alloc] init]; preconn = Val_unit; // so old preconn can be garbage collected value *f = caml_named_value("unisonInit2"); caml_reconItems = Callback_checkexn(*f, Val_unit); [pool release]; } - (void)afterUpdate:(NSNotification *)notification { [[NSNotificationCenter defaultCenter] removeObserver:self name:NSThreadWillExitNotification object:nil]; [self updateReconItems]; if ([reconItems count] > 0) [tableView selectRow:0 byExtendingSelection:NO]; // label the left and right columns with the roots NSTableHeaderCell *left = [[[tableView tableColumns] objectAtIndex:0] headerCell]; value *f = caml_named_value("unisonFirstRootString"); [left setObjectValue:[NSString stringWithCString:String_val(Callback_checkexn(*f, Val_unit))]]; NSTableHeaderCell *right = [[[tableView tableColumns] objectAtIndex:2] headerCell]; f = caml_named_value("unisonSecondRootString"); [right setObjectValue:[NSString stringWithCString:String_val(Callback_checkexn(*f, Val_unit))]]; // cause scrollbar to display if necessary [tableView reloadData]; // activate menu items [tableView setEditable:YES]; } - (void)afterOpen { NSLog(@"Connected."); // move to updates window after clearing it [self clearDetails]; [reconItems release]; reconItems = nil; [mainWindow setContentView:blankView]; [self resizeWindowToSize:updatesSize]; [mainWindow setContentView:updatesView]; // reconItems table gets keyboard input [mainWindow makeFirstResponder:tableView]; [[NSNotificationCenter defaultCenter] addObserver:self selector:@selector(afterUpdate:) name:NSThreadWillExitNotification object:nil]; [NSThread detachNewThreadSelector:@selector(doUpdateThread:) toTarget:self withObject:nil]; } - (void)connect:(value)profileName { // contact server, propagate prefs NSLog(@"Connecting..."); // Switch to ConnectingView [mainWindow setContentView:blankView]; [self resizeWindowToSize:ConnectingSize]; [mainWindow setContentView:ConnectingView]; [ConnectingView setNeedsDisplay:YES]; // FIX: this doesn't seem to work fast enough // possibly slow -- need another thread? Print "contacting server" value *f = NULL; f = caml_named_value("unisonInit1"); preconn = Callback_checkexn(*f, profileName); if (preconn == Val_unit) { [self afterOpen]; // no prompting required return; } // prompting required preconn = Field(preconn,0); // value of Some f = caml_named_value("openConnectionPrompt"); value prompt = Callback_checkexn(*f, preconn); if (prompt == Val_unit) { // turns out, no prompt needed, but must finish opening connection f = caml_named_value("openConnectionEnd"); Callback_checkexn(*f, preconn); [self afterOpen]; return; } [self raisePasswordWindow:[NSString stringWithCString:String_val(Field(prompt,0))]]; } - (IBAction)openButton:(id)sender { NSString *profile = [profileController selected]; [updatesText setStringValue:[NSString stringWithFormat:@"Synchronizing profile '%@'", profile]]; const char *s = [profile cString]; value caml_s = caml_copy_string(s); [self connect:caml_s]; return; } - (IBAction)restartButton:(id)sender { [tableView setEditable:NO]; [self chooseProfiles]; } - (void)doSyncThread:(id)whatever { NSAutoreleasePool *pool = [[NSAutoreleasePool alloc] init]; value *f = caml_named_value("unisonSynchronize"); Callback_checkexn(*f, Val_unit); [pool release]; } - (void)afterSync:(NSNotification *)notification { [[NSNotificationCenter defaultCenter] removeObserver:self name:NSThreadWillExitNotification object:nil]; int i; for (i = 0; i < [reconItems count]; i++) { [[reconItems objectAtIndex:i] resetProgress]; } [tableView reloadData]; } - (IBAction)syncButton:(id)sender { [tableView setEditable:NO]; [[NSNotificationCenter defaultCenter] addObserver:self selector:@selector(afterSync:) name:NSThreadWillExitNotification object:nil]; [NSThread detachNewThreadSelector:@selector(doSyncThread:) toTarget:self withObject:nil]; } - (void)updateTableView:(int)i { [[reconItems objectAtIndex:i] resetProgress]; [tableView reloadData]; // FIX: can we redisplay just row i? } // A function called from ocaml CAMLprim value reloadTable(value row) { int i = Int_val(row); [me updateTableView:i]; // we need 'me' to access its instance variables return Val_unit; } - (int)numberOfRowsInTableView:(NSTableView *)aTableView { if (!reconItems) return 0; else return [reconItems count]; } - (id)tableView:(NSTableView *)aTableView objectValueForTableColumn:(NSTableColumn *)aTableColumn row:(int)rowIndex { if (!reconItems) { return @"[internal error]"; } if (rowIndex >= 0 && rowIndex < [reconItems count]) { NSString *identifier = [aTableColumn identifier]; ReconItem *ri = [reconItems objectAtIndex:rowIndex]; NSString *s = [ri valueForKey:identifier]; return s; } else return @"[internal error!]"; } - (void)tableViewSelectionDidChange:(NSNotification *)note { int n = [tableView numberOfSelectedRows]; if (n == 1) [self displayDetails:[tableView selectedRow]]; else [self clearDetails]; } - (void)raisePasswordWindow:(NSString *)prompt { // FIX: some prompts don't ask for password, need to look at it NSLog(@"Got the prompt: '%@'",prompt); value *f = caml_named_value("unisonPasswordMsg"); value v = Callback_checkexn(*f, caml_copy_string([prompt cString])); if (v == Val_true) { [NSApp beginSheet:passwordWindow modalForWindow:mainWindow modalDelegate:nil didEndSelector:nil contextInfo:nil]; return; } f = caml_named_value("unisonAuthenticityMsg"); v = Callback_checkexn(*f, caml_copy_string([prompt cString])); if (v == Val_true) { int i = NSRunAlertPanel(@"New host",prompt,@"Yes",@"No",nil); if (i == NSAlertDefaultReturn) { f = caml_named_value("openConnectionReply"); Callback2_checkexn(*f, preconn, caml_copy_string("yes")); f = caml_named_value("openConnectionPrompt"); value prompt = Callback_checkexn(*f, preconn); if (prompt == Val_unit) { // all done with prompts, finish opening connection f = caml_named_value("openConnectionEnd"); Callback_checkexn(*f, preconn); [self afterOpen]; return; } else { [self raisePasswordWindow:[NSString stringWithCString:String_val(Field(prompt,0))]]; return; } } if (i == NSAlertAlternateReturn) { f = caml_named_value("openConnectionCancel"); Callback_checkexn(*f, preconn); return; } else { NSLog(@"Unrecognized response '%d' from NSRunAlertPanel",i); f = caml_named_value("openConnectionCancel"); Callback_checkexn(*f, preconn); return; } } NSLog(@"Unrecognized message from ssh: %@",prompt); f = caml_named_value("openConnectionCancel"); Callback_checkexn(*f, preconn); } // The password window will invoke this when Enter occurs, b/c we // are the delegate. - (void)controlTextDidEndEditing:(NSNotification *)notification { NSNumber *reason = [[notification userInfo] objectForKey:@"NSTextMovement"]; int code = [reason intValue]; if (code == NSReturnTextMovement) [self endPasswordWindow:self]; } // Or, the Continue button will invoke this when clicked - (IBAction)endPasswordWindow:(id)sender { [passwordWindow orderOut:self]; [NSApp endSheet:passwordWindow]; if ([sender isEqualTo:passwordCancelButton]) { value *f = caml_named_value("openConnectionCancel"); Callback_checkexn(*f, preconn); [self chooseProfiles]; return; } NSString *password = [passwordText stringValue]; value *f = NULL; const char *s = [password cString]; value caml_s = caml_copy_string(s); f = caml_named_value("openConnectionReply"); Callback2_checkexn(*f, preconn, caml_s); f = caml_named_value("openConnectionPrompt"); value prompt = Callback_checkexn(*f, preconn); if (prompt == Val_unit) { // all done with prompts, finish opening connection f = caml_named_value("openConnectionEnd"); Callback_checkexn(*f, preconn); [self afterOpen]; } else [self raisePasswordWindow:[NSString stringWithCString:String_val(Field(prompt,0))]]; } - (IBAction)raiseAboutWindow:(id)sender { [aboutWindow makeKeyAndOrderFront:nil]; } - (IBAction)onlineHelp:(id)sender { [[NSWorkspace sharedWorkspace] openURL:[NSURL URLWithString:@"http://www.cis.upenn.edu/~bcpierce/unison/docs.html"]]; } - (NSMutableArray *)reconItems // used in ReconTableView only { return reconItems; } - (int)updateForIgnore:(int)i { value *f = caml_named_value("unisonUpdateForIgnore"); int j = Int_val(Callback_checkexn(*f,Val_int(i))); f = caml_named_value("unisonState"); caml_reconItems = Callback_checkexn(*f, Val_unit); [self updateReconItems]; return j; } - (void)statusTextSet:(NSString *)s { [statusText setStringValue:s]; } // A function called from ocaml CAMLprim value displayStatus(value s) { [me statusTextSet:[NSString stringWithCString:String_val(s)]]; // NSLog(@"dS: %s",String_val(s)); return Val_unit; } - (void)awakeFromNib { /**** Initialize locals ****/ me = self; chooseProfileSize = [chooseProfileView frame].size; updatesSize = [updatesView frame].size; preferencesSize = [preferencesView frame].size; ConnectingSize = [ConnectingView frame].size; blankView = [[NSView alloc] init]; /* Double clicking in the profile list will open the profile */ [[profileController tableView] setTarget:self]; [[profileController tableView] setDoubleAction:@selector(openButton:)]; /* Set up the version string in the about box. We use a custom about box just because PRCS doesn't seem capable of getting the version into the InfoPlist.strings file; otherwise we'd use the standard about box. */ value *f = NULL; f = caml_named_value("unisonGetVersion"); [versionText setStringValue: [NSString stringWithCString: String_val(Callback_checkexn(*f, Val_unit))]]; /* Ocaml initialization */ // FIX: Does this occur before ProfileController awakeFromNib? caml_reconItems = preconn = Val_int(0); caml_register_global_root(&caml_reconItems); caml_register_global_root(&preconn); /* Command-line processing */ f = caml_named_value("unisonInit0"); value clprofile = Callback_checkexn(*f, Val_unit); /* Set up the first window the user will see */ if (Is_block(clprofile)) { /* A profile name was given on the command line */ value caml_profile = Field(clprofile,0); NSString *profile = [NSString stringWithCString:String_val(caml_profile)]; [updatesText setStringValue:[NSString stringWithFormat:@"Synchronizing profile '%@'", profile]]; /* If invoked from terminal we need to bring the app to the front */ [NSApp activateIgnoringOtherApps:YES]; /* Start the connection */ [self connect:caml_profile]; } else { /* If invoked from terminal we need to bring the app to the front */ [NSApp activateIgnoringOtherApps:YES]; /* Bring up the dialog to choose a profile */ [self chooseProfiles]; } } /* from http://developer.apple.com/documentation/Security/Conceptual/authorization_concepts/index.html */ #include #include - (IBAction)installCommandLineTool:(id)sender { /* Install the command-line tool in /usr/bin/unison. Requires root privilege, so we ask for it and pass the task off to /bin/sh. */ OSStatus myStatus; AuthorizationFlags myFlags = kAuthorizationFlagDefaults; AuthorizationRef myAuthorizationRef; myStatus = AuthorizationCreate(NULL, kAuthorizationEmptyEnvironment, myFlags, &myAuthorizationRef); if (myStatus != errAuthorizationSuccess) return; { AuthorizationItem myItems = {kAuthorizationRightExecute, 0, NULL, 0}; AuthorizationRights myRights = {1, &myItems}; myFlags = kAuthorizationFlagDefaults | kAuthorizationFlagInteractionAllowed | kAuthorizationFlagPreAuthorize | kAuthorizationFlagExtendRights; myStatus = AuthorizationCopyRights(myAuthorizationRef,&myRights,NULL,myFlags,NULL); } if (myStatus == errAuthorizationSuccess) { NSBundle *bundle = [NSBundle mainBundle]; NSString *bundle_path = [bundle bundlePath]; NSString *exec_path = [bundle_path stringByAppendingString:@"/Contents/MacOS/cltool"]; // Not sure why but this doesn't work: // [bundle pathForResource:@"cltool" ofType:nil]; if (exec_path == nil) return; char *args[] = { "-f", (char *)[exec_path cString], "/usr/bin/unison", NULL }; myFlags = kAuthorizationFlagDefaults; myStatus = AuthorizationExecuteWithPrivileges (myAuthorizationRef, "/bin/cp", myFlags, args, NULL); } AuthorizationFree (myAuthorizationRef, kAuthorizationFlagDefaults); /* if (myStatus == errAuthorizationCanceled) NSLog(@"The attempt was canceled\n"); else if (myStatus) NSLog(@"There was an authorization error: %ld\n", myStatus); */ } @end unison-2.32.52/uimac/PreferencesController.h0000644000076500000000000000115411176730177020421 0ustar bcpiercewheel/* PreferencesController */ #import @interface PreferencesController : NSObject { IBOutlet NSButton *cancelButton; IBOutlet NSTextField *firstRootText; IBOutlet NSButtonCell *localButtonCell; IBOutlet NSTextField *profileNameText; IBOutlet NSButtonCell *remoteButtonCell; IBOutlet NSButton *saveButton; IBOutlet NSTextField *secondRootHost; IBOutlet NSTextField *secondRootText; IBOutlet NSTextField *secondRootUser; } - (IBAction)anyEnter:(id)sender; - (IBAction)localClick:(id)sender; - (IBAction)remoteClick:(id)sender; - (BOOL)validatePrefs; - (void)reset; @end unison-2.32.52/uimac/PreferencesController.m0000644000076500000000000000607311176730177020433 0ustar bcpiercewheel#import "PreferencesController.h" #define CAML_NAME_SPACE #include #include extern value Callback3_checkexn(value,value,value,value); @implementation PreferencesController - (void)reset { [profileNameText setStringValue:@""]; [firstRootText setStringValue:@""]; [secondRootUser setStringValue:@""]; [secondRootHost setStringValue:@""]; [secondRootText setStringValue:@""]; [remoteButtonCell setState:NSOnState]; [localButtonCell setState:NSOffState]; [secondRootUser setSelectable:YES]; [secondRootUser setEditable:YES]; [secondRootHost setSelectable:YES]; [secondRootHost setEditable:YES]; } - (BOOL)validatePrefs { NSString *profileName = [profileNameText stringValue]; if (profileName == nil | [profileName isEqualTo:@""]) { // FIX: should check for already existing names too NSRunAlertPanel(@"Error",@"You must enter a profile name",@"OK",nil,nil); return NO; } NSString *firstRoot = [firstRootText stringValue]; if (firstRoot == nil | [firstRoot isEqualTo:@""]) { NSRunAlertPanel(@"Error",@"You must enter a first root",@"OK",nil,nil); return NO; } NSString *secondRoot; if ([remoteButtonCell state] == NSOnState) { NSString *user = [secondRootUser stringValue]; if (user == nil | [user isEqualTo:@""]) { NSRunAlertPanel(@"Error",@"You must enter a user",@"OK",nil,nil); return NO; } NSString *host = [secondRootHost stringValue]; if (host == nil | [host isEqualTo:@""]) { NSRunAlertPanel(@"Error",@"You must enter a host",@"OK",nil,nil); return NO; } NSString *file = [secondRootText stringValue]; // OK for empty file, e.g., ssh://foo@bar/ secondRoot = [NSString stringWithFormat:@"ssh://%@@%@/%@",user,host,file]; } else { secondRoot = [secondRootText stringValue]; if (secondRoot == nil | [secondRoot isEqualTo:@""]) { NSRunAlertPanel(@"Error",@"You must enter a second root file",@"OK",nil,nil); return NO; } } value *f = caml_named_value("unisonProfileInit"); Callback3_checkexn(*f, caml_copy_string([profileName cString]), caml_copy_string([firstRoot cString]), caml_copy_string([secondRoot cString])); return YES; } /* The target when enter is pressed in any of the text fields */ // FIX: this is broken, it takes tab, mouse clicks, etc. - (IBAction)anyEnter:(id)sender { NSLog(@"enter"); [self validatePrefs]; } - (IBAction)localClick:(id)sender { NSLog(@"local"); [secondRootUser setStringValue:@""]; [secondRootHost setStringValue:@""]; [secondRootUser setSelectable:NO]; [secondRootUser setEditable:NO]; [secondRootHost setSelectable:NO]; [secondRootHost setEditable:NO]; } - (IBAction)remoteClick:(id)sender { NSLog(@"remote"); [secondRootUser setSelectable:YES]; [secondRootUser setEditable:YES]; [secondRootHost setSelectable:YES]; [secondRootHost setEditable:YES]; } @end unison-2.32.52/uimac/ProfileController.h0000644000076500000000000000114311176730177017556 0ustar bcpiercewheel/* ProfileController */ /* Copyright (c) 2003, see file COPYING for details. */ #import @interface ProfileController : NSObject { IBOutlet NSTableView *tableView; NSMutableArray *profiles; int defaultIndex; // -1 if no default, else the index in profiles of @"default" } - (void)initProfiles; - (int)numberOfRowsInTableView:(NSTableView *)aTableView; - (id)tableView:(NSTableView *)aTableView objectValueForTableColumn:(NSTableColumn *)aTableColumn row:(int)rowIndex; - (NSString *)selected; - (NSTableView *)tableView; // allows MyController to set up firstResponder @end unison-2.32.52/uimac/ProfileController.m0000644000076500000000000000437611176730177017576 0ustar bcpiercewheel/* Copyright (c) 2003, see file COPYING for details. */ #import "ProfileController.h" #define CAML_NAME_SPACE #include #include extern value Callback_checkexn(value,value); @implementation ProfileController NSString *unisonDirectory() { static value *f = NULL; if (f == NULL) f = caml_named_value("unisonDirectory"); return [NSString stringWithCString:String_val(Callback_checkexn(*f, Val_unit))]; } - (void)initProfiles { NSString *directory = unisonDirectory(); NSArray *files = [[NSFileManager defaultManager] directoryContentsAtPath:directory]; unsigned int count = [files count]; unsigned int i,j; [profiles release]; profiles = [[NSMutableArray alloc] init]; defaultIndex = -1; for (i = j = 0; i < count; i++) { NSString *file = [files objectAtIndex:i]; if ([[file pathExtension] isEqualTo:@"prf"]) { NSString *withoutExtension = [file stringByDeletingPathExtension]; [profiles insertObject:withoutExtension atIndex:j]; if ([@"default" isEqualTo:withoutExtension]) defaultIndex = j; j++; } } if (j > 0) [tableView selectRow:0 byExtendingSelection:NO]; } - (void)awakeFromNib { // start with the default profile selected [self initProfiles]; if (defaultIndex >= 0) [tableView selectRow:defaultIndex byExtendingSelection:NO]; // on awake the scroll bar is inactive, but after adding profiles we might need it; // reloadData makes it happen. Q: is setNeedsDisplay more efficient? [tableView reloadData]; } - (int)numberOfRowsInTableView:(NSTableView *)aTableView { if (!profiles) return 0; else return [profiles count]; } - (id)tableView:(NSTableView *)aTableView objectValueForTableColumn:(NSTableColumn *)aTableColumn row:(int)rowIndex { if (rowIndex >= 0 && rowIndex < [profiles count]) return [profiles objectAtIndex:rowIndex]; else return @"[internal error!]"; } - (NSString *)selected { int rowIndex = [tableView selectedRow]; if (rowIndex >= 0 && rowIndex < [profiles count]) return [profiles objectAtIndex:rowIndex]; else return @"[internal error!]"; } - (NSTableView *)tableView { return tableView; } @end unison-2.32.52/uimac/ProfileTableView.h0000644000076500000000000000024611176730177017320 0ustar bcpiercewheel/* ProfileTableView */ #import #import "MyController.h" @interface ProfileTableView : NSTableView { IBOutlet MyController *myController; } @end unison-2.32.52/uimac/ProfileTableView.m0000644000076500000000000000047411176730177017330 0ustar bcpiercewheel#import "ProfileTableView.h" @implementation ProfileTableView - (void)keyDown:(NSEvent *)event { unichar c = [[event characters] characterAtIndex:0]; switch (c) { case '\r': [myController openButton:self]; break; default: [super keyDown:event]; break; } } @end unison-2.32.52/uimac/ReconItem.h0000644000076500000000000000114411176730177016000 0ustar bcpiercewheel/* ReconItem */ #import #define CAML_NAME_SPACE #include @interface ReconItem : NSObject { NSString *path; NSString *left; NSString *right; NSString *direction; NSString *progress; NSString *details; value ri; // an ocaml Common.reconItem } + initWithRi:(value)ri; - (NSString *) path; - (NSString *) left; - (NSString *) right; - (NSString *) direction; - (void) doAction:(unichar)action; - (void) doIgnore:(unichar)action; - (NSString *) progress; - (void)resetProgress; - (NSString *) details; - (BOOL)isConflict; - (void)revertDirection; @end unison-2.32.52/uimac/ReconItem.m0000644000076500000000000000724211176730177016012 0ustar bcpiercewheel#import "ReconItem.h" #include #include extern value Callback_checkexn(value,value); @implementation ReconItem -(void)dealloc { ri = Val_unit; caml_remove_global_root(&ri); [super dealloc]; } - (void)setRi:(value)v { caml_register_global_root(&ri); // needed in case of ocaml garbage collection ri = v; } + (id)initWithRi:(value)v { ReconItem *r = [[ReconItem alloc] init]; [r setRi:v]; return r; } - (NSString *)path { if (path) return path; value *f = caml_named_value("unisonRiToPath"); [path release]; path = [NSString stringWithCString:String_val(Callback_checkexn(*f, ri))]; [path retain]; return path; } - (NSString *)left { if (left) return left; value *f = caml_named_value("unisonRiToLeft"); [left release]; left = [NSString stringWithCString:String_val(Callback_checkexn(*f, ri))]; [left retain]; return left; } - (NSString *)right { if (right) return right; value *f = caml_named_value("unisonRiToRight"); [right release]; right = [NSString stringWithCString:String_val(Callback_checkexn(*f, ri))]; [right retain]; return right; } - (NSString *)direction { if (direction) return direction; value *f = caml_named_value("unisonRiToDirection"); value v = Callback_checkexn(*f, ri); char *s = String_val(v); [direction release]; direction = [NSString stringWithCString:s]; [direction retain]; return direction; } - (void)setDirection:(char *)d { [direction release]; direction = nil; value *f = caml_named_value(d); Callback_checkexn(*f, ri); } - (void)doAction:(unichar)action { switch (action) { case '>': [self setDirection:"unisonRiSetRight"]; break; case '<': [self setDirection:"unisonRiSetLeft"]; break; case '/': [self setDirection:"unisonRiSetConflict"]; break; case '-': [self setDirection:"unisonRiForceOlder"]; break; case '+': [self setDirection:"unisonRiForceNewer"]; break; case 'm': [self setDirection:"unisonRiSetMerge"]; break; default: NSLog(@"ReconItem.doAction : unknown action"); break; } } - (void)doIgnore:(unichar)action { value *f; switch (action) { case 'I': f = caml_named_value("unisonIgnorePath"); Callback_checkexn(*f, ri); break; case 'E': f = caml_named_value("unisonIgnoreExt"); Callback_checkexn(*f, ri); break; case 'N': f = caml_named_value("unisonIgnoreName"); Callback_checkexn(*f, ri); break; default: NSLog(@"ReconItem.doIgnore : unknown ignore"); break; } } - (NSString *)progress { if (progress) return progress; value *f = caml_named_value("unisonRiToProgress"); progress = [NSString stringWithCString:String_val(Callback_checkexn(*f, ri))]; [progress retain]; return progress; } - (void)resetProgress { // Get rid of the memoized progress because we expect it to change [progress release]; progress = nil; } - (NSString *)details { if (details) return details; value *f = caml_named_value("unisonRiToDetails"); details = [NSString stringWithCString:String_val(Callback_checkexn(*f, ri))]; [details retain]; return details; } - (BOOL)isConflict { value *f = caml_named_value("unisonRiIsConflict"); if (Callback_checkexn(*f, ri) == Val_true) return YES; else return NO; } - (void)revertDirection { value *f = caml_named_value("unisonRiRevert"); Callback_checkexn(*f, ri); [direction release]; direction = nil; } @end unison-2.32.52/uimac/ReconTableView.h0000644000076500000000000000146011176730177016765 0ustar bcpiercewheel// // ReconTableView.h // // NSTableView extended to handle additional keyboard events for the reconcile window. // The keyDown: method is redefined. // // Created by Trevor Jim on Wed Aug 27 2003. // Copyright (c) 2003, licensed under GNU GPL. // #import @interface ReconTableView : NSTableView { BOOL editable; } - (BOOL)editable; - (void)setEditable:(BOOL)x; - (IBAction)ignorePath:(id)sender; - (IBAction)ignoreExt:(id)sender; - (IBAction)ignoreName:(id)sender; - (IBAction)copyLR:(id)sender; - (IBAction)copyRL:(id)sender; - (IBAction)leaveAlone:(id)sender; - (IBAction)forceOlder:(id)sender; - (IBAction)forceNewer:(id)sender; - (IBAction)selectConflicts:(id)sender; - (IBAction)revert:(id)sender; - (IBAction)merge:(id)sender; - (BOOL)validateMenuItem:(NSMenuItem *)item; @end unison-2.32.52/uimac/ReconTableView.m0000644000076500000000000001002111176730177016763 0ustar bcpiercewheel// // ReconTableView.m // Unison // // Created by Trevor Jim on Wed Aug 27 2003. // Copyright (c) 2003. See file COPYING for details. // #import "ReconTableView.h" #import "ReconItem.h" #import "MyController.h" @implementation ReconTableView - (BOOL)editable { return editable; } - (void)setEditable:(BOOL)x { editable = x; } - (void)awakeFromNib { editable = NO; } - (BOOL)validateMenuItem:(NSMenuItem *)menuItem { if ([menuItem action] == @selector(selectAll:) || [menuItem action] == @selector(selectConflicts:) || [menuItem action] == @selector(copyLR:) || [menuItem action] == @selector(copyRL:) || [menuItem action] == @selector(leaveAlone:) || [menuItem action] == @selector(forceNewer:) || [menuItem action] == @selector(forceOlder:) || [menuItem action] == @selector(revert:) || [menuItem action] == @selector(merge:) || [menuItem action] == @selector(ignorePath:) || [menuItem action] == @selector(ignoreExt:) || [menuItem action] == @selector(ignoreName:)) return editable; else return YES; } - (void)doIgnore:(unichar)c { NSMutableArray *reconItems = [[self dataSource] reconItems]; NSEnumerator *e = [self selectedRowEnumerator]; NSNumber *n = [e nextObject]; int i = -1; for (; n != nil; n = [e nextObject]) { i = [n intValue]; [[reconItems objectAtIndex:i] doIgnore:c]; } if (i>=0) { // something was selected i = [[self dataSource] updateForIgnore:i]; [self selectRow:i byExtendingSelection:NO]; [self reloadData]; } } - (IBAction)ignorePath:(id)sender { [self doIgnore:'I']; } - (IBAction)ignoreExt:(id)sender { [self doIgnore:'E']; } - (IBAction)ignoreName:(id)sender { [self doIgnore:'N']; } - (void)doAction:(unichar)c { NSEnumerator *e = [self selectedRowEnumerator]; NSNumber *n = [e nextObject]; int numSelected = 0; int i = -1; for (; n != nil; n = [e nextObject]) { numSelected++; i = [n intValue]; NSMutableArray *reconItems = [[self dataSource] reconItems]; [[reconItems objectAtIndex:i] doAction:c]; } if (numSelected>0) { if (numSelected == 1 && [self numberOfRows] > i+1) { // Move to next row, unless already at last row, or if more than one row selected [self selectRow:i+1 byExtendingSelection:NO]; [self scrollRowToVisible:i+1]; } else [self reloadData]; } } - (IBAction)copyLR:(id)sender { [self doAction:'>']; } - (IBAction)copyRL:(id)sender { [self doAction:'<']; } - (IBAction)leaveAlone:(id)sender { [self doAction:'/']; } - (IBAction)forceOlder:(id)sender { [self doAction:'-']; } - (IBAction)forceNewer:(id)sender { [self doAction:'+']; } - (IBAction)selectConflicts:(id)sender { [self deselectAll:self]; NSMutableArray *reconItems = [[self dataSource] reconItems]; int i = 0; for (; i < [reconItems count]; i++) { if ([[reconItems objectAtIndex:i] isConflict]) [self selectRow:i byExtendingSelection:YES]; } } - (IBAction)revert:(id)sender { NSMutableArray *reconItems = [[self dataSource] reconItems]; NSEnumerator *e = [self selectedRowEnumerator]; NSNumber *n = [e nextObject]; int i; for (; n != nil; n = [e nextObject]) { i = [n intValue]; [[reconItems objectAtIndex:i] revertDirection]; } [self reloadData]; } - (IBAction)merge:(id)sender { [self doAction:'m']; } /* There are menu commands for these, but we add some shortcuts so you don't have to press the Command key */ - (void)keyDown:(NSEvent *)event { unichar c = [[event characters] characterAtIndex:0]; switch (c) { case '>': case NSRightArrowFunctionKey: [self doAction:'>']; break; case '<': case NSLeftArrowFunctionKey: [self doAction:'<']; break; case '?': case '/': [self doAction:'/']; break; default: [super keyDown:event]; break; } } @end unison-2.32.52/uimac/TrevorsUnison.icns0000644000076500000000000005774411176730177017501 0ustar bcpiercewheelicns_it32!!!!####!##!!##!#11##11#!##!!##!#11##11#!##!!##! #11# #11#!##!!##!#11##11#!##!!##!#11##11#!##!!##!#11##11#"##!!##!#11##11#"##""##"#11##11#"##""##"#11##11#"##""##"#11##11#"##""##"#11##11#"##""##"#11##11#"##""##"#11##11#"##""##"#11##11#"##""##"#11##11#"##""##"#11##11#"##""##"#11##11#"##""##"#11##11#"##""##"#11##11#"#1ZւZ1#""#1ZZ1#"######################################################################################################################################################################################################################################################################################################################################################################################J##J##"#c##c#"!##!!##!!#####ד#!!#c#!!#c#!#V####V##0c#!!#p0#"#ʔ0#!!#0#"!#0#!!#0ʕ#!#V0#!!#0V###0##!!##0ʖ##!#c#!!#c#!#Ic#cI###֖c=#=c֚##!#pp#!####!#cc#!####!#II#!"##"##Ȼ##!#<<#!"#bb#"##||######!####!!####!!##||##!!##bb##!##<ȩ<##"####"!##<<##!"##VԟV##"!#bb#!!#II#!!"#VǏǕV#"!!#0VV0#!!"#"!!#!,,,,,,,, ,, ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,ޙ,,ޙ,+כ++כ++ҝ++ҝ+}}}}+̟++̟+*MM**MՃM*҆҇}}{{yywwttrrppnnlljjggeeccaa_++_M]22]MKZDDZKCXQQX?;W00W;,TGGT,"R/2R"GPM""MPG9NE""EN9*L;""@L*GJA""AJG8HE,,EH8&F<++|>||||||| 8>|>|||||||is32Ӏ Q]sؒc҉S`S^V_V_Z_Z\U)j h't܀ӟ Zq QrCf\lUkot]jbsWxcx^фhԅbǿjoqwusu,{zGYUeGggm0WX: QzN+ XyV@y Cuspqs\fdi_ 5Lx7S h(Mc!V Z 3P 0~Jq FAq CCq BCq BCq BKs A 7U <A$)s m  ; g'D yVKKJi̚s8mkC4B2eYf:Nl[>On\>On\>On\>Nl]< L% w  !"ICN#??????il32 `NUU<lx>jk 7^oCWrsq OW?L:MmnFWs6M)_}M<_~M3_~M3_~M3aM3aM3aM3aM3aM3aM3aL3_wZ"WہU݀Jڀ㱋ikwހۄF|߁؀fOՀJnԈfUI{چcFJwրڼ[UJWνzOKKRh|vfJ;9HKJIHDkjglmklprqjlndzxk deggy~lxnoo#kxwp?hinqqi?blhhaniYhhH]muih]wxUil^~mUip^fUjs^fUjۻw`֔WUlʺ|aʀ˛WUmcPUmcPUnfHUn~fHUpmppifvopnHUpV[[V}rXZ[YrDk>EEDLw-?EECXb<%(($O)())&M]X$Kkka6|f4_%f^}z`^.Aq3U_mSSNNPUVf^_hbQ Q\_`^^[*KB{EoP 9p#0nT D!'uN 8k#0mm _63_|cT{tmq~om{8-za{:*Uyc{;*Uyc{;*Uyc{;*Uyc{;*Uyc{;)Uyc{;)Uyc{;)Uyc{;)Uyc{;)Uyf{;)Uynt!&y+b|O 3XwxmM_~g##|_}3N{u0}}p ,~r{r4yq|O)2c}x{kjkljcms~~l8mk$&UU%OS%TU)NVC'v6u%p"q#q#q#q#q#q#q#q#q#s#< y^_bsR~C N8cV ich#H0x????0x????ih32)]NffbqlvS[ifۀK [k bQ \j b~U\icK`k?d~U_ej~W?Py߅XF^z:LMQsLNP`~KKLZoKO`CZw3MgDYw3MgBYw.MgBYw.MgBYw.MgBYw.MgBYw.MgBYw.MgBYw.MgBYw.MgBYw.MgBYy.LgBYy.LgBYy.LgBYy.LgBYy.MgBYx.LhBW3QdIUށL'fXAO܂}4VށHUKۂچ]KHKHUjۂ-Kl܃ƣuLUօׄZGLtՄփՅ~KUӑUGM^ӐcMPgԍk:NQgӊhEUMQ\ـԂՀ\E OMSo ۲vOAMMOTdȺhPI5UOMLMPTVVWZYTMKIBBILMKMNNLLK.vupwnq?sqtwiqr?wnqly wfkr? ti|ky xflr? ti{kw xflr? ti{kywgns_ti{kwzljvvl|owfdq|kp\mj~mufailjh_eonjii_lm_hpn]in3fvpZiofeypXiqEe}pXiqEcpXisEcpXitEcpXiނvEcށݡpXi׵wEbԂrXi͂ͶyEb̓rXiĶzEb‚rXi|EarXi}EarXjEarXjEarXjEarXj~xywE`vyxtXjqklkhE`glkruXjf\^XfdtZ^\erZf_MPJ}]:uTOPM_kWbd;A@BFg~9AMw:;JՊ*Etj6 it32.pibkkfOhljij?lkihhu|gj$$njgik Ulgp~elUlftej mhoՀck?kdyqgj Ukgo~fk? Ule{oejjho{ekU ifxogjhfoekUiczofjlgq|elEUlfzphijgoҀclUUkcynejUlgq~flEkf{pejkho~clUjdxohjkgoek$kc{ofkjho}dkUfifxphijgocjlczneijgq~fkUif{qeikhnejffleyohjkfq}ekUUld|qdifjksЄjlXUjfyqjj?gkkjkb$liokhU`mzllgimj[FJPbfsc`IRhnpif JNPNPahvfXG KNNTgjye^ DNPPNPafteYID UNPPNVgn܇g^G :NPPNPaeweYJ LNPPNXglg`I ?NPPNQeml`G JNPPM]dkcL?NPcqn`HNPNWfi\=MPPcqmiKNNXfiiBOPcqmhNLXfikMPcqmhIJXfihKPcqmhLJXfihMPcqmhKJXeihMPcqmhKJXeihMPcqmhKJXeihMPcqmhKJXeihMPcqmhKJXfihMPcqmhKJXfihMPcqmhKJXfihMPcqmhKJXfihMPcqmhKJXfihMPcqmhKJXfihMPcqmhKJXfihMPcqmhKJXfihMPcqmhKJXfihMPcqmhKJXfihMPcqmhKJXfihMPdqmhKJXfihMPdqmhKJXfihMPdqmhKJXfihMPdqmhKJXfihMPdqmhKJXfihMPdqmhKJXfihMPdqmhKJXfihMPdqmhKJXfihMPdqmhKJXfihMPdqmhKJXfihMPdqmhKJXfihMPdqmhKJXfihMPdqmhKJXfihMPdqmhKJXfihMPdqmhKJXfihMPdqmhKJXfihMPdqmhKJXfihMPdqmhKJXfihMPcqmhKJXfihMPcqmhKJXfihMPcqmhKJXfihMPcqmhKJXfijMPcqmhKJXgijMPcqmhKJXgijMPcqmhKJXgijMPcqmhKJXgijMPcqmhKJXgijMPcqlhKJYgijMObqngKJ[iiiMNaq{gUKKakߏihMNamߎdhIOfpߏfhNN_kގikHVhfgNN]iݏwgiKdhݐefLNZg܎flZjw܏fENNWg܎fjfji܏tgJNTgvۏofjglfڐmiFMNbmُqfifjidّhhDNN]iڏ wfjjc Uhjijڒfh :NNWgڐ jfgjjhkhkjgftڑzhUMNRevؑ Õwjgfg ffmْjjKPNakג 㺟 הdfGNNWgٔ הtgNOPdmՔהhk MPN[h֕րՃ֗|gb LNNQfrԿgi NPN^iԾ|gbKPNRflhj :OPLZhؾrhXJPPOcjfk DMPNUgplc JPPL\i|޺reU MPPOaiڸhZ LNPNQejڶh_A LPPNSgiڴidJ MPPNVhmݲieN 5OPPNUhjiePD HNPPNUgjج߆ieQE LNPPNTehݪ{hbOG MNPPNQbir٦ pi^MHMNPPNN\hmڢ ƈkfYLHGMP NVehrڝ ޜngaSIPDMP NP[fjyՖԝwieYNKE.ONPPNNS_fhu֌Śuge]QLM:MNPNNR\ehpśohd\RNLMANNPNNR[`dgpͺpgd_YQNMM=KNNPN RZacegkpuy}}wqlhebaZRNNMNJILOPONRUX[^_`babfgeecba`_\YUQNOMKINPNPONOPQTUTUTQPPNPNNMG:GLMNPOPNPPOPPNH/UIJMNNMNPMNLID3EJKKNLJMONMLHBDintuf_suw?tuutwwvwsHHtwwux UuwxicvwtUuwvnwus uwxiQObwws?twwcOiwws UtwwiNQcwwu? UuwvcVgSiwustwwiKvNbvwtU swwcKzLjwwstwwhL{LbwwvUuwwcN{KiwvsuwwjMwNavwt\UuwveLwMixwsuwxiJ{LbwwtUUtwwbLzIjwvsUuwxiNyNbwwt\twwdMzNjwvstwwiJzMbwwtUtwwcLxJjxwstwwhLzLbwwtHtxwdLxLixuttwwjLxObwwtU3uwwdLvLjxwtuwxiK{LbwxwuwwcLyJiwvttwxjLwOawxtUswwdLwMjwuutwwiKwMbwws33uwwcLyJjxwstwwiLxNawwvUUtwvcLzMhxvtftwwjQzWbuwtcUtwwdNyMjwws?pwxkNlnLlwvoHvxwdT}Oiwwsemyua\TgwwprysUXOjxvd ^_boyw^TKhxwl]ftyqUoOiwvm \bcbcoyxbWRjxwgY ^abetyqTqWdxwiWacoywd[ Ukzwh^U UaccbfuyqU`bxxkWNacnwybueixvi`U [bccbgvyqWr`wxl^ U`ccbcsxjymnym] ^accajww]]qxq` Q`cbbpyl}opxmU `bcbgwwbdtwj Qabcqyotrwt ^bbhvxehuvrU`cqyputws``hvyhkwvt`cqysyuws]`hvzlnxvs^cqyu{wws]`hv{mqzvs_cqywzws[`hu|qt{vs_cqyx؂{ws[`hu|tx|vs_cpy{څ}ws[`hu}w{~us_cpy}ڈws[`hu{~us_cpyڋws[`ht~ȁus_cpyڍws[`htȄus_cpyܐws[`htɇus_cpyܓws[`htʋus_cpyڕws[`htʍus_cpyڙws[`htʒus_cpyڛws[`htʕts_cpy؞ws[`htʖts_cpyաws[`htəts_cpyԢws[`hsɜts_cpyҦws[`hsȟts_coyލЧws[`hsߏƢts_coyڍΩws[`hs܏Ŧts_coy׍̭ws[`hs؏ũts_coyӍʯws[`hrӏëts_coyύȱws[`hrЏ®ts_coyˍųws[`hȑts_coyŏôws[`hrɿts_coyčws[`hrďĽts_coyws[`hrts_coyws[`hrts_coyws[`hrts_coyws[`hrts_coyws[`hr ts_coy§ws[`hröġts_coyéws[`hrƵƢss_coyŪws[`hqɴɣss_coy ƫws[`hq˴ˤss_coyÜɭws[`hqͳ̥ss_coyĘˮws[`hqϲϦss_coyē˯ws[`hqѰѧss_coyŏ̰ws[`hqկӨss_coyŋαws[`hq׮֩sq_coyƆ~|ϲws[`hpج|z֩sq_coyƂw|vгws[`hp۫w{|u٩sq_coy}rvpѵws[`hpݪquvo۫sq_coywmqlҶws[`hpߨlpqjݬsq_coyrhmf~Ӷwq[`hpglmdެsq_coynbg`wҷvs[`ip`fg_sq_cnzl]b]m˿xr[`jrZbZstacmzmW]Z`Ԃqa[`mt~T]TrracmvjQXWQnrZcqyjQXOps`blunJRH|rt]frڹTPRIoqabksvCNGZ~qi]qqDMNLFpw`bjqpuhs`>HFDڄp\`bgq9@C9Vڈpslrr9@C7<;,wypuswpG2<1UҹvrZacmvV(6 7/2zpumrsnb(6%krsYbbkrr. !3~ptso Upsrsl,.-or Nabgq#' (7Бtpqtssru rrutpp{k!('.؁qU`cdp}7&귔tpqpwT[tt ^cbmta Nֱ Ӆ&npXabgq J֨p7(}rUacbovLC\monpm[9irtacbirڂpj]aceqz?hqsUacblr߂pj^ccdpuTyrt N`cbir={qc`cbcosqq Ubcbfqxguo ]ccbjrKd{p` acbcms.Tԅsg [acbdqt1KߌsjW `ccbers/Rrna accbfqvC]spb P`ccbgqs\wےrpcU ]bccbfqt퇭!̉spcU ]bccbfqqCVrnbY ^accbdnrz (xrka_]bccbbkrvq -tpha]_`ccbbfor{y- 7͙wqne`dYac bcjptڤj* 4mŚ~roib_UE`acbekpr}ؤvN,,Qyߺ}qpkc`aN]acbbejprxƵߺxqojeb`]Zabcbdimnqx߃IJxqnmhdbaaQ[`bc bbejlnoqux}~zuronliebbaa\\`bcbbdfhjkllmppoonmmlkjifdbbcb_]]acbcefeccbaa`]N_`bbcbcbba[?UZ^``aabac`abab`^]U3U\^]`_`a`ab`_][[Uxnvvf_su|}w?uwutpgvHHx~zx UuuewUvc=q~suw eu?vkuuUtv gv?Uvivuxv$hwUum!vstvevUujv~uuu"hu\Uvj usuwevUUvk!x}uUuufv\vi!u~stv fwUvm"wutvfvHviw~txv&gxUful%utuxewvkx~txu$fxUui!t~uvxevffvk!wuttfvUUvhutwv|s"a}wcUvk#t}u?pz|&*~xoHv~cv|suy|Yk{uxP$yzduy{{atswyz}@vzmvzz{z{cqxt?xz{z};mvowz{{`szwfUyzz{z}{1^yukz{{cpzzUuyzz{z~|'Ryvjxz{}|!}|ywyzz{zO}|wmxz{{|wxzUuyz{zL/y?fy{z|wyxvy{zL+}wgzz|wyyvyzL+}vxz|wyyuyzL+}wxz|wyywyzL*}wwz|wyyuyzM+}wwz|wyyuyzM+}wwz|wyyuyzM+}wwz|wyyuyzM+}wwz|w yyuyzN*}wwz|w yyuyzN*}wwz|w ywuyzN*}wwz|w ywuyzN*}wwz|w ywuyzN*}wwz|w ywuyzN*}wwz|wywuyzO*}wwz|wywuyzO*}wwz|wywuyzO*}wwz|wywuyzO*}wwz|wywuyzO*}wwz|wywuyzO)}wwz|wywuyzO*}wwz|wywuyzO)}wwz|wywuyzP*|wwz|wywuyzO)|wwz|wywuyzP*|wwz|wywuyzP)|wwz|wywuyzP)|wwz|wywuyzP*|wwz|wywuyzP)|wwz|wywuyzP)|wwz|wywuyzP)|wwz|wywuyzP)|wwz|wywuyzP)|wwz|wywuyzP)|wwz|wywuyzP)|wwz|wywuyzP)|wwz|w ywuyzP)|wwz{wywuyzP)|wwz{w ywuyzP(|wwz{w ywuyzP(|wwz{w ywuyzP(|uwz{w ywuyz~Q(|uwz{w ywuyz~Q(|uwz{wywuyz~Q(|uwz{wywuyz~Q(|uwz{wywuyz~Q(|uwz{wzwuyz~S(|uw{|wwyuyz~M#|vwz|wl|auy{}6;}uwz{{X}rpy{xQ~sx{{}--~wux~kW|qw{z}@p|xxzH`}wx{{~PDxv~pj{\v{z~`eury~.rzw{{}qv}usxXyvuyz{{vumrz]=~vnz{z~GpyuoUpv~}XX|rby{{bY||wwsrurruy|s5m{Uwz{|sXp|~~zjJ(|wtz{{}4%LV[`XIZ~ppx{{~br{Ux{z9}xwz{z\k|jwyzz|v8~wUwz{{~Zk|jvzz{>}wbxz{zguzcvz{{z~H[tfzz{z|y/|z?vzz{z~lw|s?xz{|z`jxsyz{~O^xmxzz{{|~GW{w?yzz{z|{EX~zw]xzz{z|~LX{yfryzz{z{}[e{xsuz{gmzyt vxzz{{z~v6Fy~{zuuyzz{}{^d}|zzu syzz{{z|wIQy{{yxnyz{zz|}pJOq~|z{xs\xxz{}sRSu}z{zybuyz{z|yiQ Rky}z{{zujyz {{z{~~xl]G+ #FZlx~}{z{{yyfuxyz{|~|xtpkjk lj[WZjlqw{~|z{yxvswyz{z{z{{||}~} ~~~}||{{z{zzxxuwyxz{z{z{z{zz{zz{z{yxxtbsxz{zzyzyu_Uwuxwyzxzxyywxxvuffssuxvuvwxwxusft8mk@", Iow nus ls ju n sr mt ou t u;'IN=ABZ#:9lt) =2a>JTmrr4s ()); Main.nonGuiStartup() (* If this returns the GUI should be started *) end;; Callback.register "unisonNonGuiStartup" unisonNonGuiStartup;; type stateItem = { mutable ri : reconItem; mutable bytesTransferred : Uutil.Filesize.t; mutable whatHappened : Util.confirmation option; mutable statusMessage : string option };; let theState = ref [| |];; let unisonDirectory() = Fspath.toString Os.unisonDir ;; Callback.register "unisonDirectory" unisonDirectory;; (* Defined in MyController.m, used to redisplay the table when the status for a row changes *) external displayStatus : string -> unit = "displayStatus";; (* Defined in MyController.m, used to redisplay the table when the status for a row changes *) external reloadTable : int -> unit = "reloadTable";; (* from uigtk2 *) let showProgress i bytes dbg = (* Trace.status "showProgress"; *) (* 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 item.statusMessage <- Some newstatus; (* FIX: No status window in Mac version, see GTK version for how to do it *) reloadTable i;; let unisonGetVersion() = Uutil.myVersion ;; Callback.register "unisonGetVersion" unisonGetVersion;; (* snippets from Uicommon, duplicated for now *) (* BCP: Duplicating this is a bad idea!!! *) (* First initialization sequence *) (* Returns a string option: command line profile, if any *) let unisonInit0() = ignore (Gc.set {(Gc.get ()) with Gc.max_overhead = 150}); (* 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))); (* Display status in GUI instead of on stderr *) let formatStatus major minor = (Util.padto 30 (major ^ " ")) ^ minor in Trace.messageDisplayer := displayStatus; Trace.statusFormatter := formatStatus; Trace.sendLogMsgsToStderr := false; (* Display progress in GUI *) Uutil.setProgressPrinter showProgress; (* 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 Uicommon.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 | _ -> (Printf.eprintf "%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)); begin match !clprofile with None -> () | Some n -> let f = Prefs.profilePathname n in if not(Sys.file_exists f) then (Printf.eprintf "Profile %s does not exist" f; exit 1) end; !clprofile ;; Callback.register "unisonInit0" unisonInit0;; (* 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) (* After figuring out the profile name *) let unisonInit1 profileName = (* Load the profile and command-line arguments *) (* 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); (* 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 *) (Trace.debug "" (fun() -> Util.msg "about to load prefs"); Prefs.loadTheFile()); (* Parse the command line. This will temporarily override settings from the profile. *) if !firstTime then begin Trace.debug "" (fun() -> Util.msg "about to parse command line"); Prefs.parseCmdLine Uicommon.usageMsg; end; firstTime := false; (* Print the preference settings *) Trace.debug "" (fun() -> Prefs.dumpPrefsToStderr() ); (* FIX: if no roots, ask the user *) let localRoots,remoteRoots = Safelist.partition (function Clroot.ConnectLocal _ -> true | _ -> false) (Safelist.map Clroot.parseRoot (Globals.rawRoots())) in match remoteRoots with [r] -> (* FIX: tell the user the next step (contacting server) might take a while *) Remote.openConnectionStart r | _::_::_ -> raise(Util.Fatal "cannot synchronize more than one remote root"); | _ -> None ;; Callback.register "unisonInit1" unisonInit1;; Callback.register "openConnectionPrompt" Remote.openConnectionPrompt;; Callback.register "openConnectionReply" Remote.openConnectionReply;; Callback.register "openConnectionEnd" Remote.openConnectionEnd;; Callback.register "openConnectionCancel" Remote.openConnectionCancel;; let unisonInit2 () = (* Canonize the names of the roots and install them in Globals. *) Globals.installRoots2(); (* 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; (* 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 (); Trace.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 (Uicommon.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 (); (* Turn on GC messages, if the '-debug gc' flag was provided *) if Trace.enabled "gc" then Gc.set {(Gc.get ()) with Gc.verbose = 0x3F}; (* BCPFIX: Should/can this be done earlier?? *) Files.processCommitLogs(); (* from Uigtk2 *) (* detect updates and reconcile *) let _ = Globals.roots () in let t = Trace.startTimer "Checking for updates" in let findUpdates () = Trace.status "Looking for changes"; let updates = Update.findUpdates () in Trace.showTimer t; updates in let reconcile updates = Recon.reconcileAll updates 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"; Trace.status (Printf.sprintf "There are %d reconitems" (Safelist.length reconItemList)); let stateItemList = Safelist.map (fun ri -> { ri = ri; bytesTransferred = Uutil.Filesize.zero; whatHappened = None; statusMessage = None }) reconItemList in theState := Array.of_list stateItemList; if dangerousPaths <> [] then begin Prefs.set Globals.batch false; Util.warn (Uicommon.dangerousPathMsg dangerousPaths) end; !theState ;; Callback.register "unisonInit2" unisonInit2;; let unisonRiToDetails ri = match ri.whatHappened with Some (Util.Failed s) -> (Path.toString ri.ri.path) ^ "\n" ^ s | _ -> (Path.toString ri.ri.path) ^ "\n" ^ (Uicommon.details2string ri.ri " ");; Callback.register "unisonRiToDetails" unisonRiToDetails;; let unisonRiToPath ri = Path.toString ri.ri.path;; Callback.register "unisonRiToPath" unisonRiToPath;; let rcToString (_,status,_,_) = match status with `Deleted -> "Deleted" | `Modified -> "Modified" | `PropsChanged -> "PropsChanged" | `Created -> "Created" | `Unchanged -> "";; let unisonRiToLeft ri = match ri.ri.replicas with Problem _ -> "" | Different(rc,_,_,_) -> rcToString rc;; Callback.register "unisonRiToLeft" unisonRiToLeft;; let unisonRiToRight ri = match ri.ri.replicas with Problem _ -> "" | Different(_,rc,_,_) -> rcToString rc;; Callback.register "unisonRiToRight" unisonRiToRight;; let direction2niceString = function (* from Uicommon where it's not exported *) Conflict -> "<-?->" | Replica1ToReplica2 -> "---->" | Replica2ToReplica1 -> "<----" | Merge -> "<-M->" let unisonRiToDirection ri = match ri.ri.replicas with Problem _ -> "XXXXX" | Different(_,_,d,_) -> direction2niceString !d;; Callback.register "unisonRiToDirection" unisonRiToDirection;; let unisonRiSetLeft ri = match ri.ri.replicas with Problem _ -> () | Different(_,_,d,_) -> d := Replica2ToReplica1;; Callback.register "unisonRiSetLeft" unisonRiSetLeft;; let unisonRiSetRight ri = match ri.ri.replicas with Problem _ -> () | Different(_,_,d,_) -> d := Replica1ToReplica2;; Callback.register "unisonRiSetRight" unisonRiSetRight;; let unisonRiSetConflict ri = match ri.ri.replicas with Problem _ -> () | Different(_,_,d,_) -> d := Conflict;; Callback.register "unisonRiSetConflict" unisonRiSetConflict;; let unisonRiSetMerge ri = match ri.ri.replicas with Problem _ -> () | Different(_,_,d,_) -> d := Merge;; Callback.register "unisonRiSetMerge" unisonRiSetMerge;; let unisonRiForceOlder ri = Recon.setDirection ri.ri `Older `Force;; Callback.register "unisonRiForceOlder" unisonRiForceOlder;; let unisonRiForceNewer ri = Recon.setDirection ri.ri `Newer `Force;; Callback.register "unisonRiForceNewer" unisonRiForceNewer;; let unisonRiToProgress ri = match (ri.statusMessage, ri.whatHappened,ri.ri.replicas) with (None,None,_) -> "" | (Some s,None,_) -> s | (_,_,Different(_,_,{contents=Conflict},_)) -> "" | (_,_,Problem _) -> "" | (_,Some Util.Succeeded,_) -> "done" | (_,Some (Util.Failed s),_) -> "FAILED";; Callback.register "unisonRiToProgress" unisonRiToProgress;; let unisonSynchronize () = if Array.length !theState = 0 then Trace.status "Nothing to synchronize" else begin Trace.status "Propagating changes"; Transport.logStart (); 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 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 -> Trace.status (Printf.sprintf "MERGE %s: %s" title text); 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; 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); end;; Callback.register "unisonSynchronize" unisonSynchronize;; let unisonIgnorePath si = Uicommon.addIgnorePattern (Uicommon.ignorePath si.ri.path);; let unisonIgnoreExt si = Uicommon.addIgnorePattern (Uicommon.ignoreExt si.ri.path);; let unisonIgnoreName si = Uicommon.addIgnorePattern (Uicommon.ignoreName si.ri.path);; Callback.register "unisonIgnorePath" unisonIgnorePath;; Callback.register "unisonIgnoreExt" unisonIgnoreExt;; Callback.register "unisonIgnoreName" unisonIgnoreName;; (* Update the state to take into account ignore patterns. Return the new index of the first state item that is not ignored starting at old index i. *) let unisonUpdateForIgnore i = let l = ref [] in let num = ref(-1) in let newI = ref None in (* FIX: we should actually test whether any prefix is now ignored *) let keep s = not (Globals.shouldIgnore s.ri.path) in for j = 0 to (Array.length !theState - 1) do let s = !theState.(j) in if keep s then begin l := s :: !l; num := !num + 1; if (j>=i && !newI=None) then newI := Some !num end done; theState := Array.of_list (Safelist.rev !l); match !newI with None -> (Array.length !theState - 1) | Some i' -> i';; Callback.register "unisonUpdateForIgnore" unisonUpdateForIgnore;; let unisonState () = !theState;; Callback.register "unisonState" unisonState;; (* from Uicommon *) 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 unisonFirstRootString() = let replica1, replica2 = roots2niceStrings 32 (Globals.roots()) in replica1;; let unisonSecondRootString() = let replica1, replica2 = roots2niceStrings 32 (Globals.roots()) in replica2;; Callback.register "unisonFirstRootString" unisonFirstRootString;; Callback.register "unisonSecondRootString" unisonSecondRootString;; (* Note, this returns whether the files conflict, NOT whether the current setting is Conflict *) let unisonRiIsConflict ri = match ri.ri.replicas with | Different(_,_,_,Conflict) -> true | _ -> false;; Callback.register "unisonRiIsConflict" unisonRiIsConflict;; let unisonRiRevert ri = match ri.ri.replicas with | Different(_,_,d,d0) -> d := d0 | _ -> ();; Callback.register "unisonRiRevert" unisonRiRevert;; let unisonProfileInit (profileName:string) (r1:string) (r2:string) = Prefs.resetToDefaults(); Prefs.profileName := Some(profileName); Prefs.addComment "Unison preferences file"; (* Creates the file, assumes it doesn't exist *) ignore (Prefs.add "root" r1); ignore (Prefs.add "root" r2);; Callback.register "unisonProfileInit" unisonProfileInit;; Callback.register "unisonPasswordMsg" Terminal.password;; Callback.register "unisonAuthenticityMsg" Terminal.authenticity;; let unisonExnInfo e = match e with Util.Fatal s -> Printf.sprintf "Fatal error: %s" s | Invalid_argument s -> Printf.sprintf "Invalid argument: %s" s | Unix.Unix_error(ue,s1,s2) -> Printf.sprintf "Unix error(%s,%s,%s)" (Unix.error_message ue) s1 s2 | _ -> Printexc.to_string e;; Callback.register "unisonExnInfo" unisonExnInfo;; unison-2.32.52/uimacbridgenew.ml0000644000076500000000000005676011176730177016201 0ustar bcpiercewheel(* ML side of a bridge to C for the Mac GUI *) open Common;; open Lwt;; let debug = Trace.debug "startup" let unisonNonGuiStartup() = begin (* If there's no GUI, don't print progress in the GUI *) Uutil.setProgressPrinter (fun _ _ _ -> ()); Main.nonGuiStartup() (* If this returns the GUI should be started *) end;; Callback.register "unisonNonGuiStartup" unisonNonGuiStartup;; type stateItem = { mutable ri : reconItem; mutable bytesTransferred : Uutil.Filesize.t; mutable whatHappened : Util.confirmation option; mutable statusMessage : string option };; let theState = ref [| |];; let unisonDirectory() = Fspath.toString Os.unisonDir ;; Callback.register "unisonDirectory" unisonDirectory;; (* Global progress indicator, similar to uigtk2.m; *) external displayGlobalProgress : float -> unit = "displayGlobalProgress";; let totalBytesToTransfer = ref Uutil.Filesize.zero;; let totalBytesTransferred = ref Uutil.Filesize.zero;; let showGlobalProgress b = (* Concatenate the new message *) totalBytesTransferred := Uutil.Filesize.add !totalBytesTransferred b; let v = if !totalBytesToTransfer = Uutil.Filesize.dummy then 0. else if !totalBytesToTransfer = Uutil.Filesize.zero then 100. else (Uutil.Filesize.percentageOfTotalSize !totalBytesTransferred !totalBytesToTransfer) in displayGlobalProgress v;; let initGlobalProgress b = totalBytesToTransfer := b; totalBytesTransferred := Uutil.Filesize.zero; showGlobalProgress Uutil.Filesize.zero;; (* Defined in Bridge.m, used to redisplay the table when the status for a row changes *) external bridgeThreadWait : int -> unit = "bridgeThreadWait";; (* Defined in MyController.m, used to redisplay the table when the status for a row changes *) external displayStatus : string -> unit = "displayStatus";; (* Called to create callback threads which wait on the C side for callbacks. (We create three just for good measure...) FIXME: the thread created by Thread.create doesn't run even if we yield -- we have to join. At that point we actually do get a different pthread, but we've caused the calling thread to block (forever). As a result, this call never returns. *) let callbackThreadCreate() = let tCode () = bridgeThreadWait 1; in Thread.create tCode (); Thread.create tCode (); let tid = Thread.create tCode () in Thread.join tid; ;; Callback.register "callbackThreadCreate" callbackThreadCreate;; (* Defined in MyController.m, used to redisplay the table when the status for a row changes *) external reloadTable : int -> unit = "reloadTable";; (* from uigtk2 *) let showProgress i bytes dbg = (* Trace.status "showProgress"; *) (* 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 item.statusMessage <- Some newstatus; showGlobalProgress bytes; (* FIX: No status window in Mac version, see GTK version for how to do it *) reloadTable i;; let unisonGetVersion() = Uutil.myVersion ;; Callback.register "unisonGetVersion" unisonGetVersion;; (* snippets from Uicommon, duplicated for now *) (* BCP: Duplicating this is a really bad idea!!! *) (* First initialization sequence *) (* Returns a string option: command line profile, if any *) let unisonInit0() = ignore (Gc.set {(Gc.get ()) with Gc.max_overhead = 150}); (* 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))); (* Display status in GUI instead of on stderr *) let formatStatus major minor = (Util.padto 30 (major ^ " ")) ^ minor in Trace.messageDisplayer := displayStatus; Trace.statusFormatter := formatStatus; Trace.sendLogMsgsToStderr := false; (* Display progress in GUI *) Uutil.setProgressPrinter showProgress; (* Initialise global progress so progress bar is not updated *) initGlobalProgress Uutil.Filesize.dummy; (* 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 Uicommon.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 | _ -> (Printf.eprintf "%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)); begin match !clprofile with None -> () | Some n -> let f = Prefs.profilePathname n in if not(Sys.file_exists f) then (Printf.eprintf "Profile %s does not exist" f; exit 1) end; !clprofile ;; Callback.register "unisonInit0" unisonInit0;; (* 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) (* After figuring out the profile name *) let do_unisonInit1 profileName = (* Load the profile and command-line arguments *) (* 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); (* 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 *) (Trace.debug "" (fun() -> Util.msg "about to load prefs"); Prefs.loadTheFile()); (* Parse the command line. This will temporarily override settings from the profile. *) if !firstTime then begin Trace.debug "" (fun() -> Util.msg "about to parse command line"); Prefs.parseCmdLine Uicommon.usageMsg; end; firstTime := false; (* Print the preference settings *) Trace.debug "" (fun() -> Prefs.dumpPrefsToStderr() ); (* FIX: if no roots, ask the user *) let localRoots,remoteRoots = Safelist.partition (function Clroot.ConnectLocal _ -> true | _ -> false) (Safelist.map Clroot.parseRoot (Globals.rawRoots())) in match remoteRoots with [r] -> (* FIX: tell the user the next step (contacting server) might take a while *) Remote.openConnectionStart r | _::_::_ -> raise(Util.Fatal "cannot synchronize more than one remote root"); | _ -> None ;; external unisonInit1Complete : Remote.preconnection option -> unit = "unisonInit1Complete";; (* Do this in another thread and return immedidately to free up main thread in cocoa *) let unisonInit1 profileName = let doIt () = let r = do_unisonInit1 profileName in unisonInit1Complete r; in Thread.create doIt(); ;; Callback.register "unisonInit1" unisonInit1;; Callback.register "openConnectionPrompt" Remote.openConnectionPrompt;; Callback.register "openConnectionReply" Remote.openConnectionReply;; Callback.register "openConnectionEnd" Remote.openConnectionEnd;; Callback.register "openConnectionCancel" Remote.openConnectionCancel;; let do_unisonInit2 () = (* Canonize the names of the roots and install them in Globals. *) Globals.installRoots2(); (* 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; (* 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 (); Trace.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 (Uicommon.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 (); (* Turn on GC messages, if the '-debug gc' flag was provided *) if Trace.enabled "gc" then Gc.set {(Gc.get ()) with Gc.verbose = 0x3F}; (* BCPFIX: Should/can this be done earlier?? *) Files.processCommitLogs(); (* from Uigtk2 *) (* detect updates and reconcile *) let _ = Globals.roots () in let t = Trace.startTimer "Checking for updates" in let findUpdates () = Trace.status "Looking for changes"; let updates = Update.findUpdates () in Trace.showTimer t; updates in let reconcile updates = Recon.reconcileAll updates 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"; Trace.status (Printf.sprintf "There are %d reconitems" (Safelist.length reconItemList)); let stateItemList = Safelist.map (fun ri -> { ri = ri; bytesTransferred = Uutil.Filesize.zero; whatHappened = None; statusMessage = None }) reconItemList in theState := Array.of_list stateItemList; if dangerousPaths <> [] then begin Prefs.set Globals.batch false; Util.warn (Uicommon.dangerousPathMsg dangerousPaths) end; !theState ;; external unisonInit2Complete : stateItem array -> unit = "unisonInit2Complete";; (* Do this in another thread and return immedidately to free up main thread in cocoa *) let unisonInit2 () = let doIt () = let r = do_unisonInit2 () in unisonInit2Complete r; in Thread.create doIt(); ;; Callback.register "unisonInit2" unisonInit2;; let unisonRiToDetails ri = match ri.whatHappened with Some (Util.Failed s) -> (Path.toString ri.ri.path) ^ "\n" ^ s | _ -> (Path.toString ri.ri.path) ^ "\n" ^ (Uicommon.details2string ri.ri " ");; Callback.register "unisonRiToDetails" unisonRiToDetails;; let unisonRiToPath ri = Path.toString ri.ri.path;; Callback.register "unisonRiToPath" unisonRiToPath;; let rcToString (_,status,_,_) = match status with `Deleted -> "Deleted" | `Modified -> "Modified" | `PropsChanged -> "PropsChanged" | `Created -> "Created" | `Unchanged -> "";; let unisonRiToLeft ri = match ri.ri.replicas with Problem _ -> "" | Different(rc,_,_,_) -> rcToString rc;; Callback.register "unisonRiToLeft" unisonRiToLeft;; let unisonRiToRight ri = match ri.ri.replicas with Problem _ -> "" | Different(_,rc,_,_) -> rcToString rc;; Callback.register "unisonRiToRight" unisonRiToRight;; let unisonRiToFileSize ri = Uutil.Filesize.toInt (riLength ri.ri);; Callback.register "unisonRiToFileSize" unisonRiToFileSize;; let unisonRiToFileType ri = riFileType ri.ri;; Callback.register "unisonRiToFileType" unisonRiToFileType;; let direction2niceString = function (* from Uicommon where it's not exported *) Conflict -> "<-?->" | Replica1ToReplica2 -> "---->" | Replica2ToReplica1 -> "<----" | Merge -> "<-M->" let unisonRiToDirection ri = match ri.ri.replicas with Problem _ -> "XXXXX" | Different(_,_,d,_) -> direction2niceString !d;; Callback.register "unisonRiToDirection" unisonRiToDirection;; let unisonRiSetLeft ri = match ri.ri.replicas with Problem _ -> () | Different(_,_,d,_) -> d := Replica2ToReplica1;; Callback.register "unisonRiSetLeft" unisonRiSetLeft;; let unisonRiSetRight ri = match ri.ri.replicas with Problem _ -> () | Different(_,_,d,_) -> d := Replica1ToReplica2;; Callback.register "unisonRiSetRight" unisonRiSetRight;; let unisonRiSetConflict ri = match ri.ri.replicas with Problem _ -> () | Different(_,_,d,_) -> d := Conflict;; Callback.register "unisonRiSetConflict" unisonRiSetConflict;; let unisonRiSetMerge ri = match ri.ri.replicas with Problem _ -> () | Different(_,_,d,_) -> d := Merge;; Callback.register "unisonRiSetMerge" unisonRiSetMerge;; let unisonRiForceOlder ri = Recon.setDirection ri.ri `Older `Force;; Callback.register "unisonRiForceOlder" unisonRiForceOlder;; let unisonRiForceNewer ri = Recon.setDirection ri.ri `Newer `Force;; Callback.register "unisonRiForceNewer" unisonRiForceNewer;; let unisonRiToProgress ri = match (ri.statusMessage, ri.whatHappened,ri.ri.replicas) with (None,None,_) -> "" | (Some s,None,_) -> s | (_,_,Different(_,_,{contents=Conflict},_)) -> "" | (_,_,Problem _) -> "" | (_,Some Util.Succeeded,_) -> "done" | (_,Some (Util.Failed s),_) -> "FAILED";; Callback.register "unisonRiToProgress" unisonRiToProgress;; let unisonRiToBytesTransferred ri = Uutil.Filesize.toInt ri.bytesTransferred;; Callback.register "unisonRiToBytesTransferred" unisonRiToBytesTransferred;; (* --------------------------------------------------- *) (* Defined in MyController.m, used to show diffs *) external displayDiff : string -> string -> unit = "displayDiff";; external displayDiffErr : string -> unit = "displayDiffErr";; (* If only properties have changed, we can't diff or merge. 'Can't diff' is produced (uicommon.ml) if diff is attemped when either side has PropsChanged *) let filesAreDifferent status1 status2 = match status1, status2 with `PropsChanged, `Unchanged -> false | `Unchanged, `PropsChanged -> false | `PropsChanged, `PropsChanged -> false | _, _ -> true;; (* check precondition for diff; used to disable diff button *) let canDiff ri = match ri.ri.replicas with Problem _ -> false | Different((`FILE, status1, _, _),(`FILE, status2, _, _), _, _) -> filesAreDifferent status1 status2 | Different _ -> false;; Callback.register "canDiff" canDiff;; (* from Uicommon *) (* 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, status1, _, ui1), (`FILE, status2, _, ui2), _, _) -> if filesAreDifferent status1 status2 then (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" let runShowDiffs ri i = let file = Uutil.File.ofLine i in showDiffs ri.ri displayDiff displayDiffErr file;; Callback.register "runShowDiffs" runShowDiffs;; (* --------------------------------------------------- *) let do_unisonSynchronize () = if Array.length !theState = 0 then Trace.status "Nothing to synchronize" else begin 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 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 -> debug (fun () -> Util.msg "MERGE '%s': '%s'" title text); displayDiff title text; 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; 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); initGlobalProgress Uutil.Filesize.zero; end;; external syncComplete : unit -> unit = "syncComplete";; (* Do this in another thread and return immedidately to free up main thread in cocoa *) let unisonSynchronize () = let doIt () = do_unisonSynchronize (); syncComplete (); in Thread.create doIt(); ;; Callback.register "unisonSynchronize" unisonSynchronize;; let unisonIgnorePath pathString = Uicommon.addIgnorePattern (Uicommon.ignorePath (Path.fromString pathString));; let unisonIgnoreExt pathString = Uicommon.addIgnorePattern (Uicommon.ignoreExt (Path.fromString pathString));; let unisonIgnoreName pathString = Uicommon.addIgnorePattern (Uicommon.ignoreName (Path.fromString pathString));; Callback.register "unisonIgnorePath" unisonIgnorePath;; Callback.register "unisonIgnoreExt" unisonIgnoreExt;; Callback.register "unisonIgnoreName" unisonIgnoreName;; (* Update the state to take into account ignore patterns. Return the new index of the first state item that is not ignored starting at old index i. *) let unisonUpdateForIgnore i = let l = ref [] in let num = ref(-1) in let newI = ref None in (* FIX: we should actually test whether any prefix is now ignored *) let keep s = not (Globals.shouldIgnore s.ri.path) in for j = 0 to (Array.length !theState - 1) do let s = !theState.(j) in if keep s then begin l := s :: !l; num := !num + 1; if (j>=i && !newI=None) then newI := Some !num end done; theState := Array.of_list (Safelist.rev !l); match !newI with None -> (Array.length !theState - 1) | Some i' -> i';; Callback.register "unisonUpdateForIgnore" unisonUpdateForIgnore;; let unisonState () = !theState;; Callback.register "unisonState" unisonState;; (* from Uicommon *) 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 unisonFirstRootString() = let replica1, replica2 = roots2niceStrings 32 (Globals.roots()) in replica1;; let unisonSecondRootString() = let replica1, replica2 = roots2niceStrings 32 (Globals.roots()) in replica2;; Callback.register "unisonFirstRootString" unisonFirstRootString;; Callback.register "unisonSecondRootString" unisonSecondRootString;; (* Note, this returns whether the files conflict, NOT whether the current setting is Conflict *) let unisonRiIsConflict ri = match ri.ri.replicas with | Different(_,_,_,Conflict) -> true | _ -> false;; Callback.register "unisonRiIsConflict" unisonRiIsConflict;; (* Test whether reconItem's current state is different from Unison's recommendation. Used to colour arrows in the reconItems table *) let changedFromDefault ri = match ri.ri.replicas with Different(_,_,{contents=curr},default) -> curr<>default | _ -> false;; Callback.register "changedFromDefault" changedFromDefault;; let unisonRiRevert ri = match ri.ri.replicas with | Different(_,_,d,d0) -> d := d0 | _ -> ();; Callback.register "unisonRiRevert" unisonRiRevert;; let unisonProfileInit (profileName:string) (r1:string) (r2:string) = Prefs.resetToDefaults(); Prefs.profileName := Some(profileName); Prefs.addComment "Unison preferences file"; (* Creates the file, assumes it doesn't exist *) ignore (Prefs.add "root" r1); ignore (Prefs.add "root" r2);; Callback.register "unisonProfileInit" unisonProfileInit;; Callback.register "unisonPasswordMsg" Terminal.password;; Callback.register "unisonPassphraseMsg" Terminal.passphrase;; Callback.register "unisonAuthenticityMsg" Terminal.authenticity;; let unisonExnInfo e = match e with Util.Fatal s -> Printf.sprintf "Fatal error: %s" s | Invalid_argument s -> Printf.sprintf "Invalid argument: %s" s | Unix.Unix_error(ue,s1,s2) -> Printf.sprintf "Unix error(%s,%s,%s)" (Unix.error_message ue) s1 s2 | _ -> Printexc.to_string e;; Callback.register "unisonExnInfo" unisonExnInfo;; unison-2.32.52/uimacnew/0000755000076500000000000000000011222164527014444 5ustar bcpiercewheelunison-2.32.52/uimacnew/Bridge.h0000644000076500000000000000303611176730177016023 0ustar bcpiercewheel// // Bridge.h // uimac // // Created by Craig Federighi on 4/25/07. // Copyright 2007 __MyCompanyName__. All rights reserved. // #import /* Bridge supports safe calling from C back to OCaml by using daemon threads spawned from OCaml to make the actual calls and converting all argument / return values in the OCaml thread (when in possession of the OCaml lock) */ @interface Bridge : NSObject { } + (void)startup:(const char **)argv; @end /* ocamlCall(sig, funcName, [args...]); Call ocaml function (via safe thread handoff mechanism). Args/return values are converted to/from C/OCaml according to the supplied type signture string. Type codes are: x - void (for return type) i - int s - char * S - NSString * @ - OCamlValue (see below) v - unwrapped OCaml value (deprecated -- unsafe!) Examples: int count = (int)ocamlCall("iS", "lengthOfString", @"Some String"); (void)ocamlCall("x", "someVoidOCamlFunction"); OCamlValue *v = (id)ocamlCall("@Si", "makeArray", @"Some String", 10); NSString s = [v getField:0 withType:'S']; */ extern void *ocamlCall(const char *argTypes, ...); // Wrapper/proxy for unconverted OCaml values @interface OCamlValue : NSObject { int _v; } - initWithValue:(int)v; - (void *)getField:(int)i withType:(char)t; // get value by position. See ocamlCall for list of type conversion codes - (int)count; // count of items in array - (int)value; // returns Ocaml value directly -- not safe to use except in direct callback from OCaml // (i.e. in the OCaml thread) @end unison-2.32.52/uimacnew/Bridge.m0000644000076500000000000002635311176730177016037 0ustar bcpiercewheel// // Bridge.m // uimac // // Created by Craig Federighi on 4/25/07. // Copyright 1999-2008 (see COPYING for details) // #import "Bridge.h" #define CAML_NAME_SPACE #include #include #include #include #include #import #include #include /* CMF, April 2007: Alternate strategy for solving UI crashes based on http://alan.petitepomme.net/cwn/2005.03.08.html#9: 1) Run OCaml in a separate thread from the Cocoa main run loop. 2) Handle all calls to OCaml as callbacks -- have an OCaml thread hang in C-land and use mutexes and conditions to pass control from the C calling thread to the OCaml callback thread. Value Conversion Done in Bridge Thread: Value creation/conversion (like calls to caml_named_value or caml_copy_string) or access calls (like Field) need to occur in the OCaml thread. We do this by passing C args for conversion to the bridgeThreadWait() thread. Example of vulnerability: Field(caml_reconItems,j) could dereference caml_reconItems when the GC (running independently in an OCaml thread) could be moving it. */ pthread_mutex_t init_lock = PTHREAD_MUTEX_INITIALIZER; pthread_cond_t init_cond = PTHREAD_COND_INITIALIZER; static BOOL doneInit = false; pthread_mutex_t global_call_lock = PTHREAD_MUTEX_INITIALIZER; pthread_cond_t global_call_cond = PTHREAD_COND_INITIALIZER; pthread_mutex_t global_res_lock = PTHREAD_MUTEX_INITIALIZER; pthread_cond_t global_res_cond = PTHREAD_COND_INITIALIZER; @implementation Bridge static Bridge *_instance = NULL; const char **the_argv; - (void)_ocamlStartup:(id)ignore { NSAutoreleasePool *pool = [[NSAutoreleasePool alloc] init]; pthread_mutex_lock(&init_lock); /* Initialize ocaml gc, etc. */ caml_startup((char **)the_argv); // cast to avoid warning, caml_startup assumes non-const, // NSApplicationMain assumes const // Register these with the collector // NSLog(@"*** _ocamlStartup - back from startup; signalling! (%d)", pthread_self()); doneInit = TRUE; pthread_cond_signal(&init_cond); pthread_mutex_unlock(&init_lock); // now start the callback thread // NSLog(@"*** _ocamlStartup - calling callbackThreadCreate (%d)", pthread_self()); value *f = caml_named_value("callbackThreadCreate"); (void)caml_callback_exn(*f,Val_unit); [pool release]; } + (void)startup:(const char **)argv { if (_instance) return; _instance = [[Bridge alloc] init]; [[NSExceptionHandler defaultExceptionHandler] setDelegate:_instance]; [[NSExceptionHandler defaultExceptionHandler] setExceptionHandlingMask: (NSLogUncaughtExceptionMask | NSLogTopLevelExceptionMask)]; // Init OCaml in another thread and wait for it to be ready pthread_mutex_lock(&init_lock); the_argv = argv; [NSThread detachNewThreadSelector:@selector(_ocamlStartup:) toTarget:_instance withObject:nil]; // NSLog(@"*** waiting for completion of caml_init"); while (!doneInit) pthread_cond_wait(&init_cond, &init_lock); pthread_mutex_unlock(&init_lock); // NSLog(@"*** caml_init complete!"); } - (BOOL)exceptionHandler:(NSExceptionHandler *)sender shouldLogException:(NSException *)exception mask:(unsigned int)aMask { // if (![[exception name] isEqual:@"OCamlException"]) return YES; NSString *msg = [NSString stringWithFormat:@"Uncaught exception: %@", [exception reason]]; msg = [[msg componentsSeparatedByString:@"\n"] componentsJoinedByString:@" "]; NSLog(@"%@", msg); NSRunAlertPanel(@"Fatal error", msg, @"Exit", nil, nil); exit(1); return FALSE; } @end // CallState struct is allocated on the C thread stack and then handed // to the OCaml callback thread to perform value conversion and issue the call typedef struct { enum { SafeCall, OldCall, FieldAccess } opCode; // New style calls const char *argTypes; va_list args; // Field access value *valueP; int fieldIndex; char fieldType; // Return values char *exception; void *retV; BOOL _autorelease; // for old style (unsafe) calls value call, a1, a2, a3, ret; int argCount; } CallState; static CallState *_CallState = NULL; static CallState *_RetState = NULL; // Our OCaml callback server thread -- waits for call then makes them // Called from thread spawned from OCaml CAMLprim value bridgeThreadWait(int ignore) { value args[10]; // NSLog(@"*** bridgeThreadWait init! (%d) Taking lock...", pthread_self()); while (TRUE) { // unblock ocaml while we wait for work caml_enter_blocking_section(); pthread_mutex_lock(&global_call_lock); while (!_CallState) pthread_cond_wait(&global_call_cond, &global_call_lock); // pick up our work and free up the call lock for other threads CallState *cs = _CallState; _CallState = NULL; pthread_mutex_unlock(&global_call_lock); // NSLog(@"*** bridgeThreadWait: have call -- leaving caml_blocking_section"); // we have a call to do -- get the ocaml lock caml_leave_blocking_section(); // NSLog(@"*** bridgeThreadWait: doing call"); NSAutoreleasePool *pool = [[NSAutoreleasePool alloc] init]; char retType = 'v'; value e = Val_unit; if (cs->opCode == SafeCall) { char *fname = va_arg(cs->args, char *); value *f = caml_named_value(fname); // varargs with C-based args -- convert them to OCaml values based on type code string const char *p = cs->argTypes; retType = *p++; int argCount = 0; for(; *p != '\0'; p++) { const char *str; switch (*p) { case 's': str = va_arg(cs->args, const char *); args[argCount] = caml_copy_string(str); break; case 'S': str = [va_arg(cs->args, NSString *) UTF8String]; args[argCount] = caml_copy_string(str); break; case 'n': // leak? args[argCount] = *caml_named_value(va_arg(cs->args, char *)); break; case 'i': args[argCount] = Val_int(va_arg(cs->args, int)); break; case 'v': args[argCount] = va_arg(cs->args, value); break; case '@': args[argCount] = [va_arg(cs->args, OCamlValue *) value]; break; } argCount++; } // Call OCaml -- TODO: add support for > 3 args if (argCount == 3) e = caml_callback3_exn(*f,args[0],args[1],args[2]); else if (argCount == 2) e = caml_callback2_exn(*f,args[0],args[1]); else if (argCount == 1) e = caml_callback_exn(*f,args[0]); else e = caml_callback_exn(*f,Val_unit); } else if (cs->opCode == OldCall) { // old style (unsafe) version where OCaml values were passed directly from C thread if (cs->argCount == 3) e = caml_callback3_exn(cs->call,cs->a1,cs->a2,cs->a3); else if (cs->argCount == 2) e = caml_callback2_exn(cs->call,cs->a1,cs->a2); else e = caml_callback_exn(cs->call,cs->a1); retType = 'v'; } else if (cs->opCode == FieldAccess) { int index = cs->fieldIndex; e = (index == -1) ? Val_int(Wosize_val(*cs->valueP)) : Field(*cs->valueP, cs->fieldIndex); retType = cs->fieldType; } // Process return value cs->_autorelease = FALSE; cs->ret = e; // OCaml return type -- unsafe... if (!Is_exception_result(e)) { switch (retType) { case 's': *((char **)&cs->retV) = (e == Val_unit) ? NULL : String_val(e); break; case 'S': *((NSString **)&cs->retV) = (e == Val_unit) ? NULL : [[NSString alloc] initWithUTF8String:String_val(e)]; cs->_autorelease = TRUE; break; case '@': *((NSObject **)&cs->retV) = (e == Val_unit) ? NULL : [[OCamlValue alloc] initWithValue:e]; cs->_autorelease = TRUE; break; case 'v': *((value *)&cs->retV) = e; break; case 'i': *((int *)&cs->retV) = Int_val(e); break; } } if (Is_exception_result(e)) { // get exception string -- it will get thrown back in the calling thread value *f = caml_named_value("unisonExnInfo"); cs->exception = String_val(caml_callback(*f,Extract_exception(e))); } [pool release]; // NSLog(@"*** bridgeThreadWait: returning"); // we're done, signal back pthread_mutex_lock(&global_res_lock); _RetState = cs; pthread_cond_signal(&global_res_cond); pthread_mutex_unlock(&global_res_lock); } // Never get here... return Val_unit; } void *_passCall(CallState *cs) { pthread_mutex_lock(&global_call_lock); _CallState = cs; // signal so call can happen on other thread pthread_mutex_lock(&global_res_lock); pthread_cond_signal(&global_call_cond); pthread_mutex_unlock(&global_call_lock); // NSLog(@"*** _passCall (%d) -- performing signal and waiting", pthread_self()); // wait until done -- make sure the result is for our call while (_RetState != cs) pthread_cond_wait(&global_res_cond, &global_res_lock); _RetState = NULL; pthread_mutex_unlock(&global_res_lock); // NSLog(@"*** doCallback -- back with result"); if (cs->exception) { @throw [NSException exceptionWithName:@"OCamlException" reason:[NSString stringWithUTF8String:cs->exception] userInfo:nil]; } if (cs->_autorelease) [((id)cs->retV) autorelease]; return cs->retV; } void *ocamlCall(const char *argTypes, ...) { va_list ap; va_start(ap, argTypes); CallState cs; cs.opCode = SafeCall; cs.exception = NULL; cs.argTypes = argTypes; cs.args = ap; void * res = _passCall(&cs); va_end(ap); return res; } void *getField(value *vP, int index, char type) { CallState cs; cs.opCode = FieldAccess; cs.valueP = vP; cs.fieldIndex = index; cs.fieldType = type; cs.exception = NULL; return _passCall(&cs); } @implementation OCamlValue - initWithValue:(int)v { [super init]; _v = v; caml_register_global_root((value *)&_v); return self; } - (int)count { return (int)getField((value *)&_v, -1, 'i'); } - (void *)getField:(int)i withType:(char)t { return getField((value *)&_v, i, t); } - (int)value { // Unsafe to use! return _v; } - (void)dealloc { _v = Val_unit; caml_remove_global_root((value *)&_v); [super dealloc]; } @end // Legacy OCaml call API -- no longer needed #if 0 extern value doCallback (value c, int argcount, value v1, value v2, value v3, BOOL exitOnException); extern value Callback_checkexn(value c,value v); extern value Callback2_checkexn(value c,value v1,value v2); extern value Callback3_checkexn(value c,value v1,value v2,value v3); void reportExn(const char *msg) { NSString *s = [NSString stringWithFormat:@"Uncaught exception: %s", msg]; s = [[s componentsSeparatedByString:@"\n"] componentsJoinedByString:@" "]; NSLog(@"%@",s); NSRunAlertPanel(@"Fatal error",s,@"Exit",nil,nil); } // FIXME! Claim is that value conversion must also happen in the OCaml thread... value doCallback (value c, int argcount, value v1, value v2, value v3, BOOL exitOnException) { // NSLog(@"*** doCallback: (%d) -- trying to acquire global lock", pthread_self()); CallState cs; cs.opCode = OldCall; cs.exception = NULL; cs.call = c; cs.a1 = v1; cs.a2 = v2; cs.a3 = v3; cs.argCount = argcount; @try { return _passCall(&cs); } @catch (NSException *ex) { if (exitOnException) { reportExn(cs.exception); exit(1); } @throw ex; } } value Callback_checkexn(value c,value v) { return doCallback(c, 1, v, 0, 0, TRUE); } value Callback2_checkexn(value c,value v1,value v2) { return doCallback(c, 2, v1, v2, 0, TRUE); } value Callback3_checkexn(value c,value v1,value v2,value v3) { return doCallback(c, 3, v1, v2, v3, TRUE); } #endif unison-2.32.52/uimacnew/cltool.c0000644000076500000000000000410211176730177016111 0ustar bcpiercewheel/* cltool.c This is a command-line tool for Mac OS X that looks up the unison application, where ever it has been installed, and runs it. This is intended to be installed in a standard place (e.g., /usr/bin/unison) to make it easy to invoke unison as a server, or to use unison from the command line when it has been installed with a GUI. */ #import #import #include #define BUFSIZE 1024 #define EXECPATH "/Contents/MacOS/Unison" int main(int argc, char **argv) { /* Look up the application by its bundle identifier, which is given in the Info.plist file. This will continue to work even if the user changes the name of the application, unlike fullPathForApplication. */ FSRef fsref; OSStatus status; int len; char buf[BUFSIZE]; status = LSFindApplicationForInfo(kLSUnknownCreator,CFSTR("edu.upenn.cis.Unison"),NULL,&fsref,NULL); if (status) { if (status == kLSApplicationNotFoundErr) { fprintf(stderr,"Error: can't find the Unison application using the Launch Services database.\n"); fprintf(stderr,"Try launching Unison from the Finder, and then try this again.\n",status); } else fprintf(stderr,"Error: can't find Unison application (%d).\n",status); exit(1); } status = FSRefMakePath(&fsref,(UInt8 *)buf,BUFSIZE); if (status) { fprintf(stderr,"Error: problem building path to Unison application (%d).\n",status); exit(1); } len = strlen(buf); if (len + strlen(EXECPATH) + 1 > BUFSIZE) { fprintf(stderr,"Error: path to Unison application exceeds internal buffer size (%d).\n",BUFSIZE); exit(1); } strcat(buf,EXECPATH); /* It's important to pass the absolute path on to the GUI, that's how it knows where to find the bundle, e.g., the Info.plist file. */ argv[0] = buf; // printf("The Unison executable is at %s\n",argv[0]); // printf("Running...\n"); execv(argv[0],argv); /* If we get here the execv has failed; print an error message to stderr */ perror("unison"); exit(1); } unison-2.32.52/uimacnew/English.lproj/0000755000076500000000000000000011222164527017162 5ustar bcpiercewheelunison-2.32.52/uimacnew/English.lproj/InfoPlist.strings0000644000076500000000000000013211176730177022510 0ustar bcpiercewheel/* Localized versions of Info.plist keys */ unison-2.32.52/uimacnew/English.lproj/MainMenu.nib/0000755000076500000000000000000011222164527021442 5ustar bcpiercewheelunison-2.32.52/uimacnew/English.lproj/MainMenu.nib/classes.nib0000644000076500000000000001503511176730177023605 0ustar bcpiercewheel IBClasses CLASS NSSegmentedControl LANGUAGE ObjC SUPERCLASS NSControl CLASS NSOutlineView LANGUAGE ObjC SUPERCLASS NSTableView CLASS ProfileTableView LANGUAGE ObjC OUTLETS myController MyController SUPERCLASS NSTableView CLASS ProfileController LANGUAGE ObjC OUTLETS tableView NSTableView SUPERCLASS NSObject CLASS NotificationController LANGUAGE ObjC SUPERCLASS NSObject ACTIONS anyEnter id localClick id remoteClick id CLASS PreferencesController LANGUAGE ObjC OUTLETS firstRootText NSTextField localButtonCell NSButtonCell profileNameText NSTextField remoteButtonCell NSButtonCell secondRootHost NSTextField secondRootText NSTextField secondRootUser NSTextField SUPERCLASS NSObject ACTIONS copyLR id copyRL id forceNewer id forceOlder id ignoreExt id ignoreName id ignorePath id leaveAlone id merge id revert id selectConflicts id showDiff id CLASS FirstResponder LANGUAGE ObjC SUPERCLASS NSObject CLASS MessageProgressIndicator LANGUAGE ObjC SUPERCLASS NSProgressIndicator ACTIONS cancelProfileButton id cltoolNoButton id cltoolYesButton id createButton id endPasswordWindow id installCommandLineTool id onlineHelp id openButton id raiseAboutWindow id raiseCltoolWindow id raiseWindow NSWindow rescan id restartButton id saveProfileButton id syncButton id tableModeChanged id CLASS MyController LANGUAGE ObjC OUTLETS ConnectingView NSView aboutWindow NSWindow chooseProfileView NSView cltoolPref NSButton cltoolWindow NSWindow detailsTextView NSTextView diffView NSTextView diffWindow NSWindow mainWindow NSWindow notificationController NotificationController passwordCancelButton NSButton passwordPrompt NSTextField passwordText NSTextField passwordWindow NSWindow preferencesController PreferencesController preferencesView NSView profileController ProfileController progressBar NSProgressIndicator statusText NSTextField tableModeSelector NSSegmentedControl tableView ReconTableView updatesText NSTextField updatesView NSView versionText NSTextField SUPERCLASS NSObject ACTIONS copyLR id copyRL id forceNewer id forceOlder id ignoreExt id ignoreName id ignorePath id leaveAlone id merge id revert id selectConflicts id showDiff id CLASS ReconTableView LANGUAGE ObjC SUPERCLASS NSOutlineView IBVersion 1 unison-2.32.52/uimacnew/English.lproj/MainMenu.nib/info.nib0000644000076500000000000000127711176730177023106 0ustar bcpiercewheel IBFramework Version 670 IBLastKnownRelativeProjectPath ../uimacnew.xcodeproj IBOldestOS 5 IBOpenObjects 402 198 423 29 197 307 21 IBSystem Version 9E17 targetFramework IBCocoaFramework unison-2.32.52/uimacnew/English.lproj/MainMenu.nib/keyedobjects.nib0000644000076500000000000012315411176730177024625 0ustar bcpiercewheelbplist00 X$versionT$topY$archiverX$objects]IB.objectdata_NSKeyedArchiver3 159@CDHL %&*+-/589:=BKV Wcmnotv{|     !&/9 :BCHMNQVWX]`abfmnosz{|} #,056>?@CFOPWX`e?fnovwz??? "#$(,-.145:;@IJKLTUX]stw ~   !)*,.29:;@FTUVX[\chptuxd$%*+.89=CDFJMPQRUVYZdeopqru 34vyz  "#%-12;<EFJKL MNSTYcdfksz{ "#(-137@HPQRSX]delmnry}~     & . / 6 7 ? @ H P Q X Y a b i j k l r s u } ~      ! " $ % * 2 3 4 9 : ? F G H L S T U V [ \ a l m n p w x y ~  o          ! ( ) * + 0 1 6 B C E I  J K P Q   $ % - 6 C L M V W Y a j k8 n p [       !"#$%&'()*+,-./0123456789@G       !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVGWXYZ[3\]^_`abcdefghijklSmnopqrstuvwxyz{|}~jU$null  !"#$%&'()*+,-./0VNSRootV$class]NSObjectsKeys_NSClassesValues_NSAccessibilityOidsValues]NSConnections[NSNamesKeys[NSFramework]NSClassesKeysZNSOidsKeys]NSNamesValues_NSAccessibilityConnectors]NSFontManager_NSVisibleWindows_NSObjectsValues_NSAccessibilityOidsKeysYNSNextOid\NSOidsValues2ہm1 ln/0o234[NSClassName678YNS.string]NSApplication:;<=X$classesZ$classname=>?_NSMutableStringXNSStringXNSObject:;ABB?^NSCustomObject_IBCocoaFrameworkEFGZNS.objects:;IJJK?\NSMutableSetUNSSetEMNLOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~ )?GTZ`nrv{ŀʀ!(,ׁفہ݁ HLNPTVXZ^cgijkx|~ǁ́΁]NSDestinationXNSSourceWNSLabel 23 _PreferencesController[NSCellFlags_NSAlternateContents_NSPeriodicInterval^NSButtonFlags2_NSAlternateImage_NSKeyEquivalentZNSContentsYNSSupport]NSControlView_NSPeriodicDelay\NSCellFlags2]NSButtonFlagsHCDEFGC+9,. -+L2MOPQSTU[NSFrameSize[NSExtension-~D-F}E_{{106, 208}, {408, 22}}XYZ[\]@`b_NSDrawsBackground[NSTextColorqA80/*@ 5defghjklWNSColor\NSColorSpace[NSColorName]NSCatalogName4321VSystem_textBackgroundColorephrsWNSWhite4B1:;udd?defghxjyl4761YtextColorephr~4B0:;?_NSTextFieldCell:;234?[NSTextFieldDG;9<= -;"-_{{46, 18}, {427, 22}}XYZ[\]?`b80/: 5[nextKeyViewAD@>DG߀A9BC -A);+-)_{{274, 56}, {199, 22}}XYZ[\]`b80/@ 5DG߀A9EF -A_{{46, 14}, {427, 22}}XYZ[\]`b80/D 5π(HSWNSTitle_NSKeyEquivModMaskZNSKeyEquiv]NSMnemonicLocYNSOnImage\NSMixedImageVNSMenuRJKLPI[NSMenuItemsUPasteQv2^NSResourceNameOMNWNSImage_NSMenuCheckmark:;?_NSCustomResource2OMQ_NSMenuMixedState:;?ZNSMenuItemVpaste: (%UYRWXLPV WRestartQr^restartButton:([_R]^LP\[Hide UnisonQhUhide:# %a%m'D)*+-'b9ce dbL2M-O234-6T8d~-zd|}{_{{20, 513}, {637, 13}}Y[=>#@A8hfga@k_Label Font TextEG#@$ defghJjKl4ji1\controlColorephrP4K0.66666669defghxjTl47l1_controlTextColorZstatusTextZ \o%q23_p_NotificationController_notificationControllerde(suh]Rt/LPV_Propagate Newer to Older[forceNewer:qr(wzuvRxyLPV[Leave AloneQ/[leaveAlone: %|L2-_NSDraggingSourceMaskForNonLocalYNSTvFlags_NSOriginalClassName\NSHeaderView_NSAllowsTypeSelect\NSCornerView_NSIntercellSpacingWidth_NSColumnAutoresizingStyle_NSIntercellSpacingHeight[NSGridColor_NSDraggingSourceMaskForLocal^NSTableColumns[NSRowHeight ~3 #@#@ d}#@2^ReconTableView[NSTableView-YNScvFlagsYNSDocViewYNSBGColor]NSNextKeyView987 |d|Z{635, 391}L-d|-9A@dY{635, 17}:;ʤ34?_NSTableHeaderView-dL3-[NSHScrollerXNSsFlags_NSHeaderClipView\NSScrollAmts[NSVScroller]NSContentView4>C6OAABd4:_{{-26, 0}, {16, 17}}:;34?]_NSCornerViewEM퀿򀊀r^NSIsResizeable\NSHeaderCell\NSIdentifierWNSWidthZNSDataCell^NSResizingMask_NSSortDescriptorPrototypeZNSMinWidthZNSMaxWidth #@z#@;#@@|TpathY     TPath#@& defghjl431[headerColordefghxjl471_headerTextColor:;!""?_NSTableHeaderCellXY$[')A1@8| k.)#@(defghJj3l4j1_controlBackgroundColor789:;<UNSKeyZNSSelector[NSAscending [pathSortKeyXcompare::;ABB?_NSSortDescriptor:;DEE?]NSTableColumnIJKLrMKK #@Q|^fileSizeStringY  S U TSizeXY$[']A8| k789:bcdXfileSizehijkljj#@0|XleftIconYp rs  Q<ephry4K0.33333299{|}~WNSStyleWNSAlignWNSScaleZNSAnimates :;?[NSImageCell789:뀛 [leftSortKey#@S(#@E #@Y|_percentTransferredY   U VActionXY$[']A8| k789:뀛 _directionSortKeyjjj|YrightIconY    Q>{|}~뀫 789:뀛 \rightSortKey:;ţ?^NSMutableArrayWNSArraydefghjl4€1YgridColorephrπ4D0.5:;Ң?^NSClassSwapperZdataSource׀(ƀ߀RǀȀLPISCutQxTcut: (%ˀ̀ހ̀( ΀L΁ҁӀ΁_{{370, 317}, {83, 24}}_NSSegmentImages_NSSelectedSegment݀ˀEMрՀ     ]_NSSegmentItemImage_NSSegmentItemImageScaling_NSSegmentItemWidth_NSSegmentItemLabel_NSSegmentItemTagԀ#@8/2OM\Outline-Flat:;?]NSSegmentItem   _NSSegmentItemSelectedԀ#@9UU` 2!OM_Outline-FlattenedQO   &'rԀڀ2+OM\Outline-DeepQD:;/00?_NSSegmentedCell:;233234?_NSSegmentedControl_tableModeChanged:?A:>_{{12, 39}, {70, 38}}EM=? AFUNSTagULocalX{70, 18}V{4, 2}N]QSK/URadio:;VWW234?XNSMatrixZ \%^_`abcdefghijk]mnoprqr\NSWindowView\NSScreenRect]NSWindowTitleYNSWTFlags]NSWindowClass\NSWindowRectYNSMaxSize_NSWindowBacking_NSWindowStyleMaskYNSMinSize[NSViewClass/px_{{194, 458}, {262, 266}}67vTViewLxz{x}EM iDxi9 _{{22, 152}, {220, 22}}Y[\b@80@5VUnison)_LucidaGrande-BoldiDxi9 _{{22, 20}, {224, 52}}Y[\>b80g@5oW Copyright 1999-2006. This software is licensed under the GNU General Public License.ixiZNSEditable[NSDragTypes   EFÀ_Apple PDF pasteboard type_Apple PNG pasteboard type_1NeXT Encapsulated PostScript v1.2 pasteboard type_NSFilenamesPboardType_NeXT TIFF v4.0 pasteboard type_Apple PICT pasteboard type_{{20, 182}, {224, 64}}{|}~d2ҀOM:;ե234?[NSImageViewiDxi9  _{{22, 101}, {224, 18}}Y[\b80  5_Sync you very much!.)]Optima-ItaliciDxi9 _{{22, 127}, {220, 17}}Y[\'b805U?.?.?Z{262, 266}:;334?_{{0, 0}, {1440, 878}}Z{213, 129}_{3.40282e+38, 3.40282e+38}:;?_NSWindowTemplate[aboutWindow (   ߀RLPIZSelect AllQaZselectAll:  (%"'  $#$ _{{14, 12}, {84, 32}}#%&#$& '%"VCancel676701()+4]߀R*/LPI_Select Conflicts_selectConflicts:' ?b%EMBC#.4aG2HI'LMN-PQ'SZNSMaxValueYNSpiFlags\NSDrawMatrixbÁ30"d/@ b1_MessageProgressIndicator_NSProgressIndicatorW2:;YZZ?ZNSPSMatrix_{{18, 16}, {641, 20}}'^_`3-'byx5dbEMegDEMj:>EMr|_{{1, 17}, {635, 391}}:;vww34?ZNSClipViewyz{~-XNSTargetXNSActionYNSPercent=;d<#?ڮ _{{-30, 17}, {15, 391}}\_doScroller::;234?ZNSScrolleryz{~-=?d<#? _{{-100, -100}, {629, 15}}EM_{{1, 0}, {635, 17}}Z{637, 409}:;34?\NSScrollViewG-4uCwEOd4sFFEMFsug-gXNSCursorD9pqGHd3DHEMHLdj-+_NSTextContainerYNSTVFlags\NSSharedDataXNSMinizeZNSDelegateFoQYI PmdnFEFҀ݁JKLMNO_NeXT RTFD pasteboard type_NSStringPboardType_Apple HTML pasteboard type_NSColor pasteboard type_#CorePasteboardFlavorType 0x6D6F6F76_*NeXT Rich Text Format v1.0 pasteboard typeY{635, 41}YNSTCFlagsZNSTextView_NSLayoutManagerXH#@Rj+_NSTextContainers]NSTextStorageYNSLMFlagsWVS>+UT67:;?_NSMutableAttributedString_NSAttributedStringEMƁQ:;?:;?     x+WNSFlags_NSDefaultParagraphStyle_NSInsertionColor_NSSelectedAttributes_NSMarkedAttributes_NSLinkAttributesl aj73ZbEWNS.keysa[\]_defghJj"l4j^1_selectedTextBackgroundColordefghxj(l47`1_selectedTextColor:;,--?\NSDictionaryE04a23\cd567efi[NSUnderlinee:h?@ABYNSHotSpot\NSCursorTypehg W{8, -8}:;E?G+IZNSTabStopsk:;KLL?_NSParagraphStyle:;NOO?_NSTextViewSharedData\{828, 1e+07}Y{634, 41}:;ST34?VNSText_{{1, 1}, {635, 41}}>?@XhrW{4, -5}yz[gg~_-gcZNSCurValueDD=td<D#?_{{-30, 1}, {15, 45}}yz[{gg~ij-gcnDD=vd<D#?B`_{{-100, -100}, {87, 18}}_{{0, 418}, {637, 43}}_{{20, 44}, {637, 461}}:;stt34?[NSSplitViewZ{677, 546}:;wxx34?\NSCustomView[updatesView }~%L23@3  #@1_ProfileTableView}}9Z{306, 190}L}9Y{306, 17}3COA A AA_{{307, 0}, {16, 17}}EMƀǁr} #@r#@G`XprofilesYp   XProfilesephry4Y$[})A83k\myController}23_ProfileController %L2MO6T~|}EMD9 _{{17, 236}, {329, 25}}Y[ A8hk_,Please choose a profile or create a new one $ _{{651, -524}, {84, 32}}]U$/TQuit67EM'EM/}_{{1, 17}, {306, 190}}yz{~6:=<#?`_{{307, 17}, {15, 190}}yz{~@D=<#? _{{-100, -100}, {113, 15}}EMH_{{1, 0}, {306, 17}}_{{20, 20}, {323, 208}}Z{363, 281}_chooseProfileView R|%YtableViewVWX^_`abcdefghZj\mn_`abӀՁԁ_{{163, 135}, {400, 229}}67v+ijҁEMmVopqrÁɁZvwZ$ _{{302, 12}, {84, 32}}]VU$/SYes67ZDZ9 _{{20, 188}, {383, 21}}Y[oA8h@k_7Would you like to install the Unison command-line tool?.)ZZ$ā _{{17, 36}, {145, 18}}]] p/ǀ/ƀ_Don't ask me againXNSSwitchZZ$ʁ _{{218, 12}, {84, 32}}]qU$/́̀RNo67ZDZ9ρ _{{17, 60}, {366, 120}}Y[ r@A8hр΀k_The command-line tool is a small program that can be installed in a standard place on your computer (/usr/bin/unison) so Unison can easily be found. If you want to be able to synchronize files on this computer by running Unison on a remote computer, you should probably install it. If you don't install it now, you can do so later by choosing 'Install command-line tool' from the Unison menu. _{{1, 9}, {400, 229}}_initialFirstResponder?ـ( [localClick: ߀ %_preferencesController|_outlineTableColumn(ށR߁LP\[Quit UnisonQqZterminate: (%RLP_Unison Online HelpQ?[onlineHelp:   %dj+oL  93_{{0, 2}, {505, 14}} &'X#@*+j+W>/+U67EM5     9+x=+?l+73EBEa[\]_EJMa3\d57ei\{505, 1e+07}X{114, 0}XdiffView}RZ \% D`a 9 _{{22, 90}, {183, 17}}Y[hZA8hk_Please enter your password ^passwordPromptpq(tuxRLP{|߁_Ignore ExtensionQeZignoreExt:(]R/LPV_!Revert to Unison's RecommendationWrevert: "% _passwordCancelButton(  ]R /LP\XShow All_unhideAllApplications: %2  Á _NSSecureTextField_{{20, 60}, {187, 22}}XYZ[\]`b80/ 5Xdelegate V(%_cltoolYesButton:C Ā.%[progressBarC ʀ+%GEM̀@)@*CdGrCYNSBoxType[NSTitleCell]NSTransparent\NSBorderTypeYNSOffsets_NSTitlePosition+(%#-$+;EM倿;EM逿?:D;9 -;_{{11, 20}, {30, 17}}Y[A8h!kVFile: _{{2, 2}, {493, 51}}_{{20, 129}, {497, 71}}V{0, 0}Y[\  80&'ZFirst rootephr 4M0 0.80000001:; 34?UNSBoxC  d GrC߀+(=<*-$+AEM ߀AEM  ! " $,03@7DD ) *߀A9-. -A_{{97, 58}, {37, 17}}Y[ 2 A8h/,kUUser:D : ;߀A912 -A_{{134, 56}, {91, 22}}XYZ[\] !`b80/0 5D K L߀A945 -A_{{236, 58}, {38, 17}}Y[ T "A8h63kUHost:D \ ]߀A989 -A_{{11, 16}, {30, 17}}Y[ e $A8h:7kUFile:_{{2, 2}, {493, 86}}_{{20, 16}, {497, 106}}Y[\ o q80>?[Second rootephr 4CD x yC+9AB -+_{{20, 213}, {87, 17}}Y[ A8hC@k]Profile name:Z{534, 250}673_preferencesView (IK ]RJ/LPV_Propagate Older to Newer[forceOlder: ! 0 M^secondRootUser @ O^secondRootHost (QS ]RR/LPVTDiffYshowDiff:@ * U_profileNameText H%W_detailsTextViewp À%YZcltoolPref ŀ([] ]R\/LPVUMergeVmerge: Ҁ(_b  xR`aLP[Ignore NameQn[ignoreName: (df ReLPV_Propagate Left to RightWcopyLR: D h^secondRootText !A@0> %|  l%wL2M O   T m~ntmv}uEM o D    l9pq- ml_{{315, 303}, {263, 19}}Y[\   b80rso5]Connecting...j)Z{871, 577}673^ConnectingView ( )(y{ , -Rz^LP\[Hide Others_hideOtherApplications: 8( }\remoteClick: = >(% A]R/LPVVRescanWrescan: J K( N O߀RLPITCopyQcUcopy:? Z _localButtonCell ^ `%^_`abcdefgh j d emn g h i j k_{{2, 118}, {227, 128}}^PasswordWindow67vEM r Z"_{{1, 9}, {227, 128}}^passwordWindow q }(%Ɂ_cltoolNoButton: (% ]R/LP\_Install command-line tool_raiseCltoolWindow: !A0>W %\cltoolWindow %\passwordText? : ]firstRootText  %^_`abcdefgh j m  R_{{519, 382}, {505, 342}}67ـ67v+ EM L  C?EM π ÁEM Հ Z{505, 342}>?@ hW{1, -1}yz[~ c=<_{{-30, 1}, {15, 356}}yz[{~ cn=<_{{1, 9}, {505, 342}}ZdiffWindow %_profileController (% ]R/LP\\About Unison_raiseAboutWindow:  ( sRLPV_Propagate Right to LeftWcopyRL:  (Á  xRāŀLP[Ignore PathQi[ignorePath:  (%ȁ # $RɁʀLPV_Synchronize allQg[syncButton: /ˀ%_tableModeSelector 3 5π%^_`abcdefghj 9 ;n = > ? @ ÁՀp(Ёց_{{0, 364}, {480, 360}}67vEM GZ{480, 360}ZmainWindow O%[versionTextE R Ss U# ix \ k@  p eoZZ J $ V xr  ~ qZ ^ "  ( W}?d g C ! ? Z ' =   C 3q 0 p  ܀a4%*Qށ@oD"7H́ ΀VÀIUɁ3|Ɓy [,sDˁ[.0:; oAbIl)d+H\πw)_@Áȁ   R݁ހLP\^Preferences...Q,VIgnoreEM Ӏ p сÁ_:; ע?  ]]]NSIsSeparator\NSIsDisabledR/ / LP\  ]]R/ / LP\ z] YNSSubmenuRV/LP WActions^submenuAction:EM d q  = dsIw[QU  ]]R/ / LPV z] R/LPTHelpEM "XMainMenuEM ' x ~ z] 5R\/LPEM 8 e U \ ( ܁[y   ]]R/ / LP\\_NSAppleMenu z P] URI/LPTEdit67 VEM [ J0ƁH) zx{] iR߀/LP[_NSMainMenu23 m:; oƢ?E R rs'Z'C CxZC ^ Z 3i Z xx i Z i } ~ ' W Cg i  xZ i\bb+\+V\\\+AIAI||π4|VVAV倆I\\A|AV4̀VbA\;|;l)V\VI+VDVVIAV\E R r# U ix \k@  po eZZ $ JV xr  ~ qZ ^ "  ( W?} dg C !? Z ' =  C  3q 0 p  Ła܁4%‪*Qށ@oD"7H́ ΀VÀIUɁ3|Ɓy [,sDˁ[.0:o blI)+dH\πw)_@Áȁ E R ]r ^ _ ` a b c d e7 g h i j k l m n o p q_ s t u v x y z { | } ~  e ?  ρ  &   p !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNO PQRSwTUVWXYZ[\]^_`abcdefghijk_Menu Item (Unison Online Help)_Static Text (Label Font Text)_Menu Item (Preferences...)WWindow1^Content View-2ZSplit View_Box (First root)]Menu (Ignore)[Separator-1ZImage CellZText Field_Menu Item (Diff)_Menu Item (Quit Unison)_Menu Item (About Unison)_Menu Item (Ignore Extension)_!Bordered Scroll View (Table View)_EStatic Text (Would you like to install the Unison command-line tool?)[Separator-2_Static Text (Profile name:)[AboutWindow\Text Field-2_Push Button (Cancel)_:Static Text (Please choose a profile or create a new one )_Scroll View (Text View)_Static Text (File:)^Content View-1_Menu Item (Copy)_Menu Item (Paste)_Push Button (Yes)_Table Column (leftIcon)_!Table Column (percentTransferred)\Content View_!Static Text (Sync you very much!)_Menu Item (Actions)_Static Text (The command-line tool is a small program that can be installed in a standard place on your computer (/usr/bin/unison) so Unison can easily be found. If you want to be able to synchronize files on this computer by running Unison on a remote computer, you should probably install it. If you don't install it now, you can do so later by choosing 'Install command-line tool' from the Unison menu. )^Menu (Actions)_#Bordered Scroll View (Table View)-1\File's Owner_Menu Item (Ignore Path)_Table Column (path)_Menu Item (Help)_$Menu Item (Propagate Older to Newer)oeStatic Text ( Copyright 1999-2006. This software is licensed under the GNU General Public License.)_Menu Item (Restart)_Secure Text Field_Push Button (No)_)Static Text (Please enter your password )[Application_Image View (Unison)_Static Text (Host:)_-Menu Item (Revert to Unison's Recommendation)_Menu Item (Ignore)_+Recon Table View (Path, Size, <, Action, >)_Menu Item (Cut)_Menu Item (Hide Others)_Table Column (profiles)_Button Cell (Remote)_Menu Item (Hide Unison)\Image Cell-1_Static Text (User:)\CltoolWindow_Button Cell (Local)[Menu (Help)_Profile Table View (Profiles)_Table Column (rightIcon)^Content View-3VMatrix_$Menu Item (Propagate Newer to Older)_ Bordered Scroll View (Text View)_,Round Segmented Control (Outline-Flat, O, D)_Menu Item (Merge)_Message Progress Indicator_Push Button (Quit)\Text Field-3\Text Field-1[Separator-3_Static Text (Connecting...)_Static Text (File: )^Content View-4_Table Column (fileSizeString)_#Menu Item (Propagate Right to Left)_Menu Item (Rescan)_%Menu Item (Install command-line tool)[Menu (Edit)_Menu Item (Select All)[Text View-1_Box (Second root)_PreferencesView_#Menu Item (Propagate Left to Right)YText View]Menu (Unison)_Static Text (Unison)VWindow_Menu Item (Leave Alone)YSeparator_Menu Item (Edit)_Menu Item (Select Conflicts)_Push Button (Continue)_Menu Item (Ignore Name)\Text Field-4_Check Box (Don't ask me again)_Menu Item (Synchronize all)_Static Text (?.?.?)_Menu Item (Show All)_Menu Item (Unison)E R;C}.|E RBP/}E RI U#yipw`Z lZr $oV xRr ~ Z ^ "  (UW z\ ?m^ =Y] tO |} 3q 0TQS Vu Wxxd \ hkg@ p_ eoXZes J v[k q bn{Pafq ?}idg C !c Z ' Cj  ~p ܀aLc!{ށoD́7?΀I3~|Ɓy ZNˀʁ:v) dTHVπw)T)@G^`4nH%׀*Qi@r "Hḱ ـVŁ݀ÀUɁ,P΁([|,gjـsD[.0ǀ; oAblIZx+ۀ\_XÁȁ E R   !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~7́pqrstuvwxyz{|}~ÁāŁƁǁȁɁʁˁ́́΁ρЁсҁӁԁՁցׁ؁فځہ܁݁ށ߁i      !"#$%&'()*+,-. vfztsg uq mlwkj|CyL {r}8o  A J~I onjx^pBKD39EME RE R:;?^NSIBObjectData"'1:?DRTf ! ( / = O k y  ! + 8 : = @ C F H K M P S V Y [ ] ` c f i r ~  & 1 3 4 = D Q W ` b             # & ) , / 2 5 8 ; > A D G J M P S V Y \ _ b e h k n q t w z }        . c o ')+-/13579;@GX_foqz|  /COgr{ (-CLNOXan{   !,.147O (*,9NW^v  -Rfr{} "79;=?IVX[dm8:<>@BCEQbdfhj  2468:;=?W|~  "$&3?BEHNP]lnprz  -/13579FILOWYhy{} #$&(MORUX[]`cf)>@BDFYduwy{}#0246WY[]_acoq}3@Ub|   #%&(*,.02;JV(*-03579;=GPYm '*-0357:MPRUXZ\s|   + G R ] ^ ` b d m o q z !!!!!!!/!8!C!W!x!}!!!!!!!!!!!!!!!!!!!"" """"" ")"2"7"J"S"X"f""""""""""""""""""# # #######+#-#/#1#2#;#`#b#d#f#o#q#s#u#~###############$$ $$$$$$$0$A$C$E$G$H$T$y${$}$$$$$$$$$$$$$$$%%%% % % %% %"%$%&%'%:%_%a%c%e%g%i%k%u%%%%%%%%%%%%%%%%%%&& &&!&#&%&'&1&>&@&E&N&S&b&m&z&|&~&&&&&&&&&&&&&&&&&&&&&&&''''!'$'''*','/'H'e'w''''''''''''''( ((2(4(6(?(A(N(P(R(T(a(j(o(}((((((((((((()))) )))))*),)5)>)P)Y)d)y))))))))))))* *********$*-*4*a*c*e*g*i*k*m*p*v***********++++++5+G+[+e+q+s+v+y+{+++++++++++++++++++++++,,,&,(,*,,,.,/,1,3,L,m,v,x,z,|,~,,,,,,,,,,,,,,,,,-- -"-$-&-(---/-. .. .".%.(.).,.../.1.3.<.>.K.M.P.S.V.Y.\.x...///7/X/Z/]/^/k/m/o/r/{/////////////0000 0 0!0204070E0f0h0j0m0p0q0s0u0000000000000111'1,1?1K1X1Z1]1`1111111111111111111111227292<2>2A2D2F2I2P2Y2[2d2f2s2u2x2{22222222222222222233303;3E3R3T3V3Y3\3_3a3d3g3i3l3333333333333444 4 4444 4"4-4/424547494B4D4G4I4a4j4s4~444444444444445555G5I5K5N5Q5S5V5X5a5}5555555556666 666$6&6)6,6/626;6=6D6G6J6M6~666666666666666667777&7)7,7/7275787;7>7@7C7F7H7Q7S7j7m7o7r7u7x7{7~7777777788E8O8d8n8y888888888888888889999969K9T9V9Y9\9e9j9s9x999999: ::::::::":/:7:::?:B:E:J:M:P:e:g:i:l:n::::::::::::::::;;;; ;;";(;*;1;>;H;U;X;[;];e;n;s;|;;;;;;;;;;;;;<<<'<*<-<5<^>>>>>>>>>>>!>$>&>)>,>5>H>u>x>{>~>>>>>>>>>>>>>>>>>>???? ? ???2?5?7?:?=?@????????????????????@ @ @ @@@@@'@*@3@P@R@U@X@Z@\@e@r@t@@@@@@@@@@@@@@@@@@@@AA&A)A,A/A2A5A8A;A>AGAIAPASAVAYAzA}AAAAAAAAAAAAAAABB'B*B,B/B2B3B6B9BSBBBBBBBBBBBBBBBBBBBBBBBBCCC"C%C(C+C.C1C:CSC|CCCCCCCCCCCCCCCDDD&D(D*D,D/D9DJDLDODRDUDDDDDDDDDDDDDDDDDDDDDDEEEE E'E*E,E/E2E3E6ENEEEEEEEEEEEEEEEEEEEF F F FFFFFFWFhFjFlFFFFFFFFFFFFFFFFFGGGGG'GDGGGIGLGOGPGSGkGGGGGGGGGGGGGGGGGGHH%H'H)H,H.H1H3IIIJJJJJ JJ'J)J+J-J0JHJYJ[J]J_JbJwJJJJJJJJJJJJJJJJJJJJKKKKK K"K%K2K5K8K;KPKRK^KoKqKtKvKyKKKKKKKKKKKKKKKKKLLLLL2L5L8LALDLYL\L_LbLdLqLtLwLyLLLLLLLLLLLLLLLLLLLLLLLLMMMM MMMM#M,M5MFMHMKMNMQMbMdMgMiMlMMMMMMMMMMMMMMMMN NNNNN@NBNENHNJNLNON\N_NbNeNxNzNNNNNNNNNNNNNNOOO O OO&O7O9O;O>OAObOdOgOiOkOmOoOxOOOOOOOOOOOOOOOOPP5P7P9P;P=P@PAPCPLP]P_PaPdPgPzPPPPPPPPPPPPPPPPPPQQQ)Q7QDQNQ`QbQeQhQkQlQoQqQtQvQxQQQQQQQQQQQQQQQQQQRRR R RRRRR0RIRPRmRoRqRtRvRyRRRRRRRRRRRRRSSSSS SSSSS#S%S4S6S9SZLZ]Z_ZaZlZuZwZZZZZZZZZZZZZZZZ[ [ [[[[ [1[3[5[8[;[X[Z[][_[a[c[e[l[t[[[[[[[[[[[[[[[[[[[[\\\\ \ \=\?\B\E\H\J\M\P\R\U\X\q\\\\\\\\\\\\\\\\\\]]]]]]9];]>]@]B]D]F]b]w]]]]]]]]]]]]]]]]]]]]]]^ ^^^^!^$^U^X^[^^^a^d^g^j^m^p^^^^^^^^^^^^^^^____ _______ _)_+_2_5_8_;_D_F_I_L_W_d_g_j_r_______________```+`-`0`2`5`I`Z`\`^`a`d````````````````````aaa%a'a*a-aNaPaSaVaXaZa]aiakawaaaaaaaaaaaaaaaaaaaabb b"b%b'b*b[b]b`bcbebjblbobrbubxb{bbbbbbbbbbbbbbbbbccccccccccccdddd d dddddddd!d$d'd*d-d/d2d4d6d9d;d=d@dCdFdHdJdMdOdRdUdWdYd\d_dbdedhdkdmdpdsdvdxdzd}ddddddddddddddddddddddddddddddddddddddddddddddddddeeee e ee1e3e6e9e;e=e?eNePeWe`ebeieleoere{eeeeeeeeeeeeeeeffffff f2ff@fCfEfGfIfLfOf`fcfffiflftfffffffffffffffffffffffffg(g*g-g0g2g4g6g9gADGJMPSVY\_behknqtwz}Łȁˁ΁сԁׁځ݁ "%(+.147:=@CFILORUX[^adgjmpsvy|Ăǂʂ͂Ђӂւق܂߂ !$'*-0357:=@BEHKNPRUX[]_begjmoqsuxz}ƒăƃɃ̃σ҃Ճ؃ڃ݃ "%(+-/1368:=@CFILNPRTWY\^gjlnqsuxz|ĄƄȄ˄̈́ЄӄՄ؄ڄ܄߄ *unison-2.32.52/uimacnew/English.lproj/MainMenu.nib/objects.nib0000644000076500000000000004706411176730177023610 0ustar bcpiercewheel streamtyped@NSIBObjectDataNSObjectNSCustomObject)@@NSMutableStringNSString+ NSApplicationir NSTextField NSControl)NSView) NSResponderNSBox* NSCustomView) @@@@ffffffffNSMutableArrayNSArrayNSMatrix> 'F&F&icc@#iiii:::ffffi@@@@@ NSActionCellNSCellAF(D NSButtonCell?ii@@@@RemoteNSFont$[36c]LucidaGrandef ci: ssii@@@@@Q@User:Ąc@@controlTextColor:8[[ƪAq@ó˷textBackgroundColor textColorʆ:&&ƪ@Host:ѷȆ8ƪAq@óԷφ ƪ@File:ַȆ.ƪAq@óٷφVVjjff@@cccƪ Second rooẗ́L?WWƪ@ Profile name:޷ȆjƪAq@óφNSView NSResponderGGƪ First rooẗ́L?.ƪAq@óφ33 ƪ@File: Ȇ NSTableColumn)@fff@@ccleftIconNSTableHeaderCellƪ<$LucidaGrande  >headerTextColorʆ NSImageCell)iii@NSClassSwapper*@#ReconTableView NSTableView= NSClipView: NSScrollView NSSplitView MessageProgressIndicatorNSProgressIndicatorb NSPSMatrix[12f]ccddcd} } ƪ@Label Font Text$LucidaGrande  Ȇ""NSView NSResponderNSTextViewTemplateNSViewTemplate. NSMutableSetNSSetI Apple HTML pasteboard typeApple PICT pasteboard type1NeXT Encapsulated PostScript v1.2 pasteboard type*NeXT Rich Text Format v1.0 pasteboard typeApple PDF pasteboard typeNSFilenamesPboardTypeNSStringPboardTypeNeXT TIFF v4.0 pasteboard typeNSColor pasteboard type#CorePasteboardFlavorType 0x6D6F6F76NeXT RTFD pasteboard type{){) NSTextView NSDictionaryNSBackgroundColorselectedTextBackgroundColorNSColorselectedTextColorʆʵ{z)<{){)@@cccNSCursor NSScroller--ff: _doScroller: 3WWCr?ӯ }+}+24ffffi,}}3qv?ӯ3uu?ӯNSTableHeaderView8{{8{{::τcontrolBackgroundColor _NSCornerView}}678>{{<{{ @@@ff@@f::i:>ﻄpathAPath􅅰 headerColorƪ@1$LucidaGrande <ȆﻄfileSizeStringFFFSize􅅰Fƪ@1I<ȆﻄpercentTransferred@GBg(BdAction􅅰Fƪ@1I<Ȇﻄ rightIcon>􅅰F@ gridColor? ڒ NSMenuItemNSMenui@@@Unison ]^ i@@IIi@@@@:i@ About UnisonÂNSCustomResource)NSImageNSMenuCheckmarkefNSMenuMixedState]^ۂÂdh]^Preferences...,dh]^Install command-line toolÂdh]^ۂÂdh\]^ Hide Othershdh]^Show AllÂdh]^ۂÂdh]^ Quit Unisonqdh _NSAppleMenu Hide Unisonhdh^B]_Edit]~Cutxdh}]~Pastevdh]~ Select Alladh]~Select ConflictsÂdhCopycdh~]_MainMenu]UnisonÂdhsubmenuAction:^]EditÂdh~]ActionsÂdh_Actions ]Propagate Left to Right>dh]Propagate Right to Left<dh]Propagate Newer to OlderÂdh]Propagate Older to NewerÂdh] Leave Alone/dh]!Revert to Unison's RecommendationÂdh]MergeÂdh]DiffÂdh]ۂÂdh]Restartrdh]Rescandh]Synchronize allgdh]IgnoreÂdh_Ignore] Ignore Pathidh]Ignore Extensionedh] Ignore Namendh _NSMainMenuHelpÂdh_Help]Unison Online Help?dh֩J VV? NSTextView)NSBackgroundColor+NSColor.ʵrVV1NSImage.sNSBitmapImageRep NSImageRep [2490c]MM*  SSS_ ???T  #***???T  '***???T  (***???T  (***???T  (***???T  (***???T  (***???T  (***@@@S (****** (******yyyooo[H/ (***oooxxx***<(  'ZU***yyyooo  "H88pppyyy***+'<*** (oooooo2HG1    U RS 3ddӯ3WWCr?ӯVV ^ƪ@@Unison,[44c]$LucidaGrande-Boldφ44ƪ@X© Copyright 1999-2006. This software is licensed under the GNU General Public License.φ NSImageViewApple PDF pasteboard type1NeXT Encapsulated PostScript v1.2 pasteboard typeNeXT TIFF v4.0 pasteboard typeNSFilenamesPboardTypeApple PICT pasteboard typeApple PNG pasteboard type@@efUnisonƪ@@?.?.?Iφ   eƪ@@Sync you very much!$Optima-Italic φNSSecureTextFieldNSButtons b b 8Continue@[28c]Helvetica  T T 8Cancel@Zƪ@Please enter your password Ȇ <ƪAq@óφﻄprofilesCs=BProfiles􅅰>ƪ@1ProfileTableView IIƪ@,Please choose a profile or create a new one ȆT T Quit @ÄkkNSView NSResponder33~?ӯ3qqُ}?ӯ;)22)22++<?3CC'(), 22<22ׁ+,Y@’ȆProfileControllerPreferencesControllerNSWindowTemplate iiffffi@@@@@c xpÄNSWindowViewffff ~NotificationControllerq^ᢖ:. T T :Yes<@Ä::ƪ@7Would you like to install the Unison command-line tool?,$LucidaGrande-Bold @Ȇ9: T T :NoD@Ä:(;0;0hcHO;ޗ,|zxwHOxHO<4wcxHO|xxyHO}<x8cxHOiHOa/y@<<8c8HO!?>?;l:їD>_}>>>HO<x<cxHOHN<Ɨ@<ex}8爨9CxHN<<HcHN<LHNP|~xrHN<T=89xHN<\|}xXwHNi/A(<CxƗ`exx9HNAH <Cxexdx8HN!?xhHNPrHNT<Бh=8x9HM<\|}xlopHM/A(<DCxƗpexx9HMH <Cxexdx8HMhxHMy<cxtxHMe<_8Bt8!b|N ;Z4;9:`?y;LHL <|}x<,cHK<0HK逗|exxHKـ|}x<cHKŀ<d<_<==_8B8ƅ9~)x9Jx88A<@HKy|~xxHKi/A <<~xh8Ɔ xHKE/A <<~xh8ƆxHK!/A <<~exh8Ɔ,xHJ/A <<~Exh8Ɔ<xHJ/AHyHJŀ~xHJ<<h|}x8ƆLxxHJxHJ/ALyHJy<}{xlHJi<<h|}x8Ɔ\xxHJIxHJ=/A <<}sxh8ƆlxHJ<~óxxpHJ8!x|HI|@&||+xHG齡$A!B<LHI<|~x<PcHI<<T||x8xHI|}yAH<xXHIm/A0<x\HIU<<@|ex8ƃxHI9<<xT8HI!|}yAH<xXHI /A0<x\HH<<@|ex8ƂxHH<xHH<_8B0aP|t/A<<<c8T8`HH|`yTA8a@HH58a@HH /@L<aTdHHU<<h8|}xHH=<PlxHH)8a@HGHT8a@HGu|dx<8cdHGH8<<cHG<Pp<88t9HG8!@a$}c HF|h8!`|fxxcxxa|H>|a<}cx?l!??|+xă{0ȃ,H><X<8y(H>}h8!`|fxxcxxa|H>X|??<!;ކX;||x /A}H=?<?;tc`;H=<<\8v8H=<c4H=<<8vx8H=|t/A<x`H=u8X8!P|N |<||x<xpx8H>zxH>exH>]8`H<_8B{bbh8!`A|N |B}H|AX<8!Px8sH88|H=X8!P|N ||y|B!@<<8cr8rHh>wy,/@<<8cr8rHD/@ c/A<8rpH=|~x/@<<8cr8sH7 H;a@<8(8scx>H<:H=Unh8 a8xH x@/A|#xH&|yxH<_BS" AxH!||xHL8;@xH&MxH&%x8|ex#xH%/||x@ |wxH/@<88c[HeH/AcxH!|{xH,xH%x|{x#xH%Q|}xxH"%x/@<x8c[H H@x8@H'9/@<x8c[H8cxH$8`8``cA cxH$~9>8^;cx;^x;}iD}bEH'=88HCxH$E8@>`B8@Cx,>(^@ x;>;@#xH#=U8$x8\x^^H<_8B'888~H"xH"||yAP;Cx8xH"Q|cyA<|fx88DxH"<xx8cYHH;88HxH"/888^@;a@`x;x8Hx$HxH!u||yAP;Cx8xH!|cyA<|fx88DxH!Y<xx8cYHH48:`x[>??;9Dؐ^H!m||yA/A;~óx8xH! |cyA<|fx88DxH <_~xBQpb<_BQtcxBFxH ]|}y@ <cxFx8E<8H |}x<$xx8cYxxH/AHxH H<xH||y@~óx88HH/A??;9EK/@0/A~cx88PHq;88\x;^0;~H uU8x8\Cx^Вԓ~H-CxH||x<8cYxHQ/AP;cx8xH|cyA<|fx88ExHU<xx8cYHHd<`PHu|{yA<P~Pd~`8~@H5/||x@h;/A/AD;8~8xH|cyA<|fx88DxH<8cZHXhCxTH||yAL;8~8xH|cyA<|fx88ExHe<8cZxxH/A0cxH!8~0H|{yAL;8~8xH=|cyA<|fx88ExH<xx8cZ(H/@|x8~@H|{yAL;8~8xH|cyA<|fx88DxH<xx8cZ8HE/@|xx!a|N |AB|}x!@|#x|+x88\;@xH8@\xH|~x<8cTxH/A /wA4<x8cTHH 8a@xEx8gxK|~x/A/w@;8!xA|N |AB|#x!|{x;@8@Hi;|}xxxHU/@<dx8cTH/@<x8cT$HHL;x8a@xK|dy@ <_xBKbH|zxH<ex8cT4HX8!PCxA|N |}y|B|#x!|+x|3x;`@<8cSlHEH<_xBJDxH||y@<x8cS|HHH/@<x8cSHHxxFxx88@9DaDH-|{y@D<x8cSH/A @aD/A/A xHHxHxHqx8!pcx|N |}D$&~D$$腌t}D$fu$iDžuZ:nD$}D$E$DDžu5JƉ$ V~T$$Nj~D$4$ [^_]UVSkt|D$E$׋mT$1}T$$軋D$ q}D$|D$4$蛋[^]UVS6kBtZ|D$E$lfmT$|T$$PD$ |D$V|D$4$0[^]UWVS,j}ƃs{D$|D$s$t{D$s$ӊ|D$~}$車:kD$ t${T$$藊|D$}$D$t$ |$|T$$]st{D$<$Bƃs,[^_]UWVSiA{D$|$ … lD$ !lD$){D$$ډ…zD$$辉D$|$T$$菉ECED${D$U$o1lT$zT$$SƋ{D$|$9zT$$'D$zD$4$qk|$zT$$ƋzD$4$=vGzD$<$Ȉ)‰T$zD$4$諈|$zT$$蕈脈t$zT$$xƋzD$4$d=vGzD$<$K)‰T$zD$4$.|$zT$$ƍED$D$ ED$zD$|$…t D$ t$zD$$ćCED$t$Al$轇UT$Ql$訇{D$E$zD$4$mD$,T$$Du1ҋ$ẺЃEЄt,1EEE ED$Ẻ$1[^_]USfD$?xD$E$迆[]U\fxo]US$Lfiot.D$UT$ D$hT$$ʆ$[]UWVSe}uhouhD$h$2&Pxu+@tht$$ʆxuh뱍huhEhEiEčiEȍ.iE̍>iEЍNiEԍ^ipM؍nitE4EED$D$ d04$r|GD$D$ 4$UEGEED$D$4$1EwOWxE|EuMG EEEEEUEEt uM EEƉEuu ~iE}҃oH tpL@ DGttDGD`D$lD$T$ ED$ED$d$蒄Ɖ$v4$|$M $E$Ĭ[^_]UHE$eUEE؋EE܋E EEEEE}ˆUE EEԉ$/U0cEPl]Uc=l]US c$lt@tD$r$諃[]UWVSLbuu D$ cfD$sfD$4$舃EЅua4$ɃƅD$$UDžu 4$覃lj4$諃|$f$諂<$艃rD$EЉ$EԅuEЉ$PEԋEЉD$98<$͂ƅt~$EED$ED$D$ D$t$<$\Ẻ4$4$Et$D$EԉD$f$E$Ȃ}̅uEԉD$f$ƁyẺ$Y趂9tj譂$NjẺ$4$ ƋẺD$t$ |$EԉD$f$f4$D<$<Ẻ$1EEԉ$EЉ$EẼL[^_]UWVSL`Eu1D$D$ $E̋E uwcwc|$E $t|$Ủ$̀u\it,BuBt|$$?t$Gƅu ƅtt$|$Ẻ$F4$*E u dU dEԉD$U $ӀEԉD$Ủ$(uxit/B uBt!UԉT$$蘀t$蠀ƅu!Džt4$QƉ<$茀tt$EԉD$Ủ$膀4$jE u dE dUЉT$E $UЉT$Ẻ$h0Dž$U…tldEU D$D$D$ ED$ED$ $*ƅt2D$UЉT$Ẻ$4$UЉT$Ẻ$~<${E uddt$U $*t?t$Ẻ$~u,dD$Ủ$tD$t$Ẻ$(ỦT$ $v~ƋẺ$~L[^_]UD$E$UWVSPtTD$$rDžuVD$}T$q1n[rWU WT$D$|$ ED$D$3t04$qEr-WT$D$|$ UT$D$4$qNjZttZqD$D$ED$ aD$D$4$qD$D$|$ D$D$4$`qƃZVZtM+qD$ UT$aD$4$pD$ |$D$4$pƃZE$Kq<$Cq$Z<[^_]UWVS,OpT$$pƃXX$qEEmTE؍}TE@ED$X$/pƋE؉D$4$}pNjE܉D$4$lp$׃EE9E|X$ppǃXXt$ƃX,[^_]US$NEEEED$E$ptD$T$oEE$[]UVSpNEEut$E$/ptD$AT$n1t$p$np[^]UWVD$$nƉ<$^o^_]UVS`Mut$ D$D$pmet$lnftT$S$%n1t$cp$n`[^]UWVƅu1D$$Wnlj4$n^_]UWVSVMuu&SD$6S$m+E$nD$FSD$4$mlj4$LnEut$E$nt?EED$t$$wnft%T$ED$VS$mEE$vnD$D$ED$ D$D$E$:ntD$ED$fS$lE$nD$ED$o$ nEE$mE$mMu%D$E$lEu UoD$ oD$D$o04$mNjEt_D$MD$<$lE$lEED$D$ 4$kƉD$MD$<$l4$lEt$ED$MD$<$ulE$Vl1Ĝ[^_]UWVSJu}|$4$lEED$ED$D$D$D$ D$D$<$ltD$t$ Q$jEE܉D$D$E$ZlftT$t$Q$j1KE܉$lE܉$kD$E܋D$Om$kƋE܉$kE܉$kE$k1Č[^_]UWVSID$ D$ED$l$jƅu1$xlj4$j[^_]UWVS,MIDžDžut"4$j4$XjDž{E t E $jkt$D$4$jD$ 1уL$t$$"jNjE uD$O$h1E tU $i,<$j|$$jƉ<$iu|$O${h1PT$<$ju|$OM$i=~fDž$ifDžt$ D$T$$ifUD$HD$$hEEȉu̍uE$hfu$hЅu>D$O$T$mGT$$VƋHD$]I$VD$ t$HT$$mV[^]UWVS,6QHD$H$>VƋ%HD$H$$VED$!HD$4$ VNjGD$H$UƋHD$<$UD$HD$4$UE܋YHD$<$UDHD$$UD$FD$E$UD$HD$U܉$jUUHD$4$XU…uu>E1GD$<$0UGD$H$Ut$ UT$GT$$TljD$FD$E$TD$EGD$U܉$Tt uGD$E܉$THE },[^_]TUWVS<+4E+ED$E$`Tƍ}䋃FD$U$FTt$|$$/Vft/+ED$E$Tt$ UT$D$<EED$D$D$ D$D$E$[UttFUT$D$<+EtD$FD$G$S<$S1<[^_]UWVS|3uED$4$JS;T$ET$$.S}|$4$TEED$|$$YTftT$t$;$RUE$eTEE$;TD$ ED$~ED$4$RƋE$-TE$T1|[^_]UWVS,2u:D$CD$4$CRǍ:D$CD$4$%Rt!D$}DD$E$R;D$CD$4$Q…u1yDD$$QE]DD$D$QUT$ |$uDT$$Qt4ED$ t$|$wT$=R DT$$OQ1,[^_]UWVS,0uDCD$4$ QNj@CD$4$ QEuD$D$E؉$LDž>D$E؉$sL>T$$aLE},E?D$4$:LMEE\ff.Ev.wLf.w( (W,.]wE EW,.w.vE.vM܋>D$E$Kƅ_u"E>E E؉E<[^_]K<[^_]UWVS+=D$E$XKp=T$$FK0=D$4$0K$T$EUD$T$ Mul=D$<$Kƅu[^_]Vv12@0:4O@8O@8@0:4v36@0:4@8@12@16@20i24c28@32v40@0:4@8@12@16@20i24c28@32@36v8@0:4v12@0:4c8@8@0:4@16@0:4@8@12@12@0:4@8v12@0:4@8c12@0:4@8c8@0:4registerApplicationWithDictionary:growlVersionwriteToFile:atomically:dataFromPropertyList:format:errorDescription:stringByAppendingPathComponent:substringToIndex:lengthstringByAppendingPathExtension:globallyUniqueStringstringByAppendingString:fileSystemRepresentationpostNotificationName:object:growlIsReadyperformSelector:withObject:userInfoapplicationIconDataForGrowlprocessNameapplicationNameForGrowldictionaryWithDictionary:removeObjectForKey:dockDescriptioncontainsObject:bundlePathdictionaryWithContentsOfFile:pathForResource:ofType:mainBundleregistrationDictionaryForGrowlisEqualToString:growlPrefPaneBundlepostNotificationName:object:userInfo:deliverImmediately:postNotificationWithDictionary:setProtocolForProxy:rootProxyconnectionWithRegisteredName:host:TIFFRepresentationisKindOfClass:objectForKey:classmutableCopyinitWithBool:setObject:forKey:initWithObjectsAndKeys:initWithInt:growlNotificationTimedOut:releaseremoveObserver:name:object:respondsToSelector:growlNotificationWasClicked:initWithFormat:allocprocessIdentifierprocessInfoaddObserver:selector:name:object:retainautoreleasedefaultCentersetGrowlDelegate:growlDelegatenotifyWithTitle:description:notificationName:iconData:priority:isSticky:clickContext:notifyWithTitle:description:notificationName:iconData:priority:isSticky:clickContext:identifier:notifyWithDictionary:isGrowlInstalledisGrowlRunningregisterWithDictionary:reregisterGrowlNotificationssetWillRegisterWhenGrowlIsReady:willRegisterWhenGrowlIsReadyregistrationDictionaryFromDelegateregistrationDictionaryFromBundle:bestRegistrationDictionaryregistrationDictionaryByFillingInDictionary:registrationDictionaryByFillingInDictionary:restrictToKeys:_applicationNameForGrowlSearchingRegistrationDictionary:_applicationIconDataForGrowlSearchingRegistrationDictionary:_growlNotificationWasClicked:_growlNotificationTimedOut:_growlIsReady:_launchGrowlIfInstalledWithRegistrationDictionary:launchGrowlIfInstalledNSPropertyListSerializationNSNotificationCenterNSDictionaryNSBundleGrowlPathUtilNSConnectionNSImageNSMutableDictionaryNSNumberNSStringNSProcessInfoNSDistributedNotificationCenter/Users/chris/source_code/projects/growl-0.7.4/Framework/Source/GrowlApplicationBridge.mGrowlNotificationProtocolNSObjectGrowlApplicationBridgeGrowlApplicationBridge: Cannot register because the application name was not supplied and could not be determined%@Lend Me Some Sugar; I Am Your Neighbor!GrowlClicked!%@-%d-%@GrowlTimedOut!NotificationAppIconNotificationNameApplicationPIDApplicationNameNotificationTitleNotificationDescriptionNotificationIconNotificationClickContextNotificationPriorityNotificationStickyGrowlNotificationIdentifierGrowlApplicationBridgePathwayGrowlApplicationBridge: exception while sending notification: %@GrowlNotificationcom.Growl.GrowlHelperAppgrowlRegDictGrowl Registration TicketGrowlApplicationBridge: The bundle at %@ contains a registration dictionary, but it is not a valid property list. Please tell this application's developer.GrowlApplicationBridge: The Growl delegate did not supply a registration dictionary, and the app bundle at %@ does not have one. Please tell this application's developer.ApplicationIconAppLocationfile-dataDefaultNotificationsAllNotificationsClickedContextappGrowlHelperApp-GrowlApplicationBridge: Error writing registration dictionary at %@: %@GrowlApplicationBridge: Registration dictionary follows %@GrowlApplicationBridge: Growl_PostNotification called with a NULL notificationGrowlApplicationBridge: Growl_PostNotification called, but no delegate is in effect to supply an application name - either set a delegate, or use Growl_PostNotificationWithDictionary insteadGrowlApplicationBridge: Growl_PostNotification called, but no application name was found in the delegateGrowlApplicationBridge: Delegate did not supply a registration dictionary, and the app bundle at %@ does not have oneGrowlApplicationBridge: Got error reading property list at %@: %@GrowlApplicationBridge: Delegate did not supply a registration dictionary, and it could not be loaded from %@GrowlApplicationBridge: Registration dictionary file at %@ didn't contain a dictionary (dictionary type ID is '%@' whereas the file contained '%@'); description of object follows %@prefPanecom.growl.prefpanelCallbackContextGrowlApplicationBridge: Could not find the temporary directory path, therefore cannot register./.GrowlApplicationBridge: Error writing registration dictionary to URL %@: %@Growl.prefPaneGrowlApplicationBridge: Growl_SetDelegate called, but no application name was found in the delegate_CFURLAliasData_CFURLStringType_CFURLStringin copyCurrentProcessName in CFGrowlAdditions: Could not get process name because CopyProcessName returned %liin copyCurrentProcessURL in CFGrowlAdditions: Could not get application location, because GetProcessBundleLocation returned %li in copyTemporaryFolderPath in CFGrowlAdditions: Could not locate temporary folder because FSFindFolder returned %liin copyDockDescriptionForURL in CFGrowlAdditions: Cannot copy Dock description for a NULL URLfilein copyDockDescriptionForURL in CFGrowlAdditions: FSNewAlias for %@ returned %liin copyDockDescriptionForURL in CFGrowlAdditions: FSCopyAliasInfo for %@ returned %liin copyIconDataForURL in CFGrowlAdditions: could not get icon for %@: GetIconRefFromFileInfo returned %li in copyIconDataForURL in CFGrowlAdditions: could not get icon for %@: IconRefToIconFamily returned %li in createURLByMakingDirectoryAtURLWithName in CFGrowlAdditions: parent directory URL is NULL (please tell the Growl developers) in createURLByMakingDirectoryAtURLWithName in CFGrowlAdditions: name of directory to create is NULL (please tell the Growl developers) in createURLByMakingDirectoryAtURLWithName in CFGrowlAdditions: could not create FSRef for parent directory at %@ (please tell the Growl developers) PBCreateDirectoryUnicodeSync or PBMakeFSRefUnicodeSync returned %li; calling CFURLCreateFromFSRefCFURLCreateFromFSRef returned %@in createURLByMakingDirectoryAtURLWithName in CFGrowlAdditions: could not create directory '%@' in parent directory at %@: FSCreateDirectoryUnicode returned %li (please tell the Growl developers)(could not get path for source file: FSRefMakePath returned %li)in copyFork in CFGrowlAdditions: PBOpenForkSync (source: %s) returned %liin copyFork in CFGrowlAdditions: PBGetCatalogInfoSync (source: %s) returned %liPBMakeFSRefUnicodeSync(could not get path for destination directory: FSRefMakePath returned %li)(could not get filename for destination file: CFStringCreateWithCharactersNoCopy returned NULL)in copyFork in CFGrowlAdditions: %s (destination: %s/%@) returned %liPBCreateFileUnicodeSyncin copyFork in CFGrowlAdditions: PBOpenForkSync (dest) returned %li(could not get path for dest file: FSRefMakePath returned %li)in copyFork in CFGrowlAdditions: PBOpenForkSync (destination: %s) returned %liin copyFork in CFGrowlAdditions: PBReadForkSync (source: %s) returned %liin copyFork in CFGrowlAdditions: PBWriteForkSync (destination: %s) returned %liin copyFork in CFGrowlAdditions: PBCloseForkSync (destination: %s) returned %liin copyFork in CFGrowlAdditions: PBCloseForkSync (source: %s) returned %liin createURLByCopyingFileFromURLToDirectoryURL in CFGrowlAdditions: CFURLGetFSRef failed with source URL %@in createURLByCopyingFileFromURLToDirectoryURL in CFGrowlAdditions: CFURLGetFSRef failed with destination URL %@PBIterateForksSync returned %liin GrowlCopyObjectSync in CFGrowlAdditions: PBIterateForksSync returned %liin createURLByCopyingFileFromURLToDirectoryURL in CFGrowlAdditions: CopyObjectSync returned %li for source URL %@in createPropertyListFromURL in CFGrowlAdditions: cannot read from a NULL URLin createPropertyListFromURL in CFGrowlAdditions: could not create stream for reading from URL %@in createPropertyListFromURL in CFGrowlAdditions: could not open stream for reading from URL %@in createPropertyListFromURL in CFGrowlAdditions: could not read property list from URL %@ (error string: %@)@"NSData"@"NSString"@"NSDictionary"initinitWithAllNotifications:defaultNotifications:deallocsetApplicationNameForGrowl:setApplicationIconDataForGrowl:registrationDictionary/Users/chris/source_code/projects/growl-0.7.4/Framework/Source/GrowlDelegate.mGrowlApplicationBridgeDelegateGrowlDelegateaddObject:stringByDeletingPathExtensioninitWithCapacity:countdirectoryContentsAtPath:createDirectoryAtPath:attributes:objectAtIndex:bundleForClass:skipDescendentspathExtensionenumeratorAtPath:compare:options:bundleIdentifierbundleWithPath:fileExistsAtPath:defaultManagernextObjectobjectEnumeratorhelperAppBundlegrowlSupportDirscreenshotsDirectorynextScreenshotNameNSMutableSetNSFileManager/Users/chris/source_code/projects/growl-0.7.4/Common/Source/GrowlPathUtil.mPreferencePanesApplication Support/GrowlLibrary/Application Support/Growl/ScreenshotsScreenshot %ludictionaryWithCapacity:pathfileExistsAtPath:isDirectory:intValuedataWithBytes:length:caseInsensitiveCompare:schemefileURLWithPath:bytesaliasDatafileURLWithAliasData:fileURLWithDockDescription:NSData/Users/chris/source_code/projects/growl-0.7.4/Common/Source/NSURLAdditions.mNSURLGrowlAdditionsin +[NSURL(GrowlAdditions) fileURLWithAliasData:]: Could not allocate an alias handle from %u bytes of alias data (data follows) because PtrToHand returned %li %@in +[NSURL(GrowlAdditions) fileURLWithAliasData:]: Could not resolve alias (alias data follows) because FSResolveAlias returned %li - will try path %@in +[NSURL(GrowlAdditions) fileURLWithAliasData:]: FSCopyAliasInfo returned a nil pathin -[NSURL(GrowlAdditions) dockDescription]: FSNewAlias for %@ returned %liv32@0:4{_NSRect={_NSPoint=ff}{_NSSize=ff}}8i24f28{_NSSize=ff}16@0:4{_NSSize=ff}8@16@0:4{_NSSize=ff}8bestRepresentationForDevice:representationssetSize:drawInRect:fromRect:operation:fraction:setImageInterpolation:currentContextsetScalesWhenResized:sizedrawScaledInRect:operation:fraction:adjustSizeToDrawAtSize:bestRepresentationForSize:representationOfSize:NSGraphicsContext/Users/chris/source_code/projects/growl-0.7.4/Core/Source/GrowlImageAdditions.mGrowlImageAdditions $Ë$?G8HXoqp p'4p DpPp`ptpppppppqq0qLqlq@qqq q rrTsds ps |sssssssGt:qTtNptpduhptpppqqp`ppeq quuHvAvmvTsds ps |ssqwwss p'www_HxLxPxKt:xsxc4p DpPpy y4y Dyny8zsz]p {{Ph{U{j,|g|}}8~a~ ~IO(EC N\IOOHJkptKqTMa_hm|ss$xwwqss4P-V {tK4y y y0Te]<e[e8eh,ee,ege^0e\4dMcb؎ ` f$fTftffffffkg g0gLgXgtgggggglhlDlggh,h8hklXhlhhhhhi$i8iHiXi`ikli|iii(kmmiiimi j,jOg~ 9Me!Bl,?[mx(?Rk(GVdx   / > V f           , = [ t         $ 4 T g            , M U ] e s  *3?ES+:)7 "*.4>  & >FJR`nplX^nvz&0<Iy"  Z9} @Z`jmH5    {| H 8 (   ؑ ȑ x h X H 8 (   ؐ Ȑ x h X H 8 (  (   ؔ Ȕ x h X H 8 (   ؓ ȓ x h X H 8 (   ؒ Ȓ x h X x h X H 8 (   ؖ Ȗ x h X H 8 (   ؕ ȕ x h X H 8 8 (   ؗ ȗ x h X H |~}ihefg eePegjkmnqrtuvwxy{|}~foshlzip.objc_class_name_GrowlApplicationBridge.objc_class_name_GrowlDelegate.objc_class_name_GrowlPathUtil.objc_category_name_NSURL_GrowlAdditions.objc_category_name_NSImage_GrowlImageAdditions.objc_class_name_NSBundle.objc_class_name_NSConnection.objc_class_name_NSData.objc_class_name_NSDictionary.objc_class_name_NSDistributedNotificationCenter.objc_class_name_NSFileManager.objc_class_name_NSGraphicsContext.objc_class_name_NSImage.objc_class_name_NSMutableDictionary.objc_class_name_NSMutableSet.objc_class_name_NSNotificationCenter.objc_class_name_NSNumber.objc_class_name_NSObject.objc_class_name_NSProcessInfo.objc_class_name_NSPropertyListSerialization.objc_class_name_NSString.objc_class_name_NSURL.objc_class_name_Protocol_CFArrayAppendArray_CFArrayAppendValue_CFArrayCreate_CFArrayCreateMutable_CFArrayGetCount_CFArrayGetValueAtIndex_CFBundleCopyBundleURL_CFBundleCopyResourceURL_CFBundleCreate_CFBundleCreateBundlesFromDirectory_CFBundleGetIdentifier_CFBundleGetMainBundle_CFCopyTypeIDDescription_CFDataCreate_CFDictionaryContainsKey_CFDictionaryCreate_CFDictionaryCreateCopy_CFDictionaryCreateMutable_CFDictionaryCreateMutableCopy_CFDictionaryGetTypeID_CFDictionaryGetValue_CFDictionaryRemoveValue_CFDictionarySetValue_CFEqual_CFGetAllocator_CFGetTypeID_CFNotificationCenterAddObserver_CFNotificationCenterGetDistributedCenter_CFNotificationCenterPostNotification_CFNotificationCenterRemoveEveryObserver_CFNotificationCenterRemoveObserver_CFNumberCreate_CFPropertyListCreateFromStream_CFPropertyListWriteToStream_CFReadStreamClose_CFReadStreamCreateWithFile_CFReadStreamOpen_CFRelease_CFRetain_CFSetContainsValue_CFStringCompare_CFStringCreateByCombiningStrings_CFStringCreateWithCStringNoCopy_CFStringCreateWithCharactersNoCopy_CFStringCreateWithFormat_CFStringGetCharacters_CFStringGetLength_CFURLCopyFileSystemPath_CFURLCopyLastPathComponent_CFURLCopyScheme_CFURLCreateCopyAppendingPathComponent_CFURLCreateCopyDeletingLastPathComponent_CFURLCreateFromFSRef_CFURLCreateFromFileSystemRepresentation_CFURLCreateWithFileSystemPath_CFURLGetFSRef_CFUUIDCreate_CFUUIDCreateString_CFWriteStreamClose_CFWriteStreamCreateWithFile_CFWriteStreamOpen_CopyProcessName_DisposeHandle_FNNotify_FSCopyAliasInfo_FSFindFolder_FSNewAlias_FSPathMakeRef_FSRefMakePath_GetHandleSize_GetIconRefFromFileInfo_GetNextProcess_GetProcessBundleLocation_HLock_HUnlock_IconRefToIconFamily_LSOpenFromRefSpec_LSOpenFromURLSpec_NSEqualSizes_NSHomeDirectory_NSLog_NSSearchPathForDirectoriesInDomains_NSTemporaryDirectory_PBCloseForkSync_PBCreateDirectoryUnicodeSync_PBCreateFileUnicodeSync_PBGetCatalogInfoSync_PBIterateForksSync_PBMakeFSRefUnicodeSync_PBOpenForkSync_PBReadForkSync_PBWriteForkSync_ProcessInformationCopyDictionary_PtrToHand_ReleaseIconRef__NSAddHandler2__NSExceptionObjectFromHandler2__NSRemoveHandler2___CFConstantStringClassReference__setjmp_ceilf_floorf_free_getcwd_getpid_kCFAllocatorDefault_kCFAllocatorNull_kCFBundleIdentifierKey_kCFTypeArrayCallBacks_kCFTypeDictionaryKeyCallBacks_kCFTypeDictionaryValueCallBacks_malloc_memcpy_memset_objc_msgSend_objc_msgSendSuper_snprintfsingle moduledyld__mh_dylib_headerdyld_lazy_symbol_binding_entry_pointdyld_func_lookup_pointer__dyld_func_lookupdyld_stub_binding_helper+[GrowlApplicationBridge launchGrowlIfInstalled]+[GrowlApplicationBridge _launchGrowlIfInstalledWithRegistrationDictionary:]+[GrowlApplicationBridge _growlIsReady:]+[GrowlApplicationBridge _growlNotificationTimedOut:]+[GrowlApplicationBridge _growlNotificationWasClicked:]+[GrowlApplicationBridge _applicationIconDataForGrowlSearchingRegistrationDictionary:]+[GrowlApplicationBridge _applicationNameForGrowlSearchingRegistrationDictionary:]+[GrowlApplicationBridge registrationDictionaryByFillingInDictionary:restrictToKeys:]+[GrowlApplicationBridge registrationDictionaryByFillingInDictionary:]+[GrowlApplicationBridge bestRegistrationDictionary]+[GrowlApplicationBridge registrationDictionaryFromBundle:]+[GrowlApplicationBridge registrationDictionaryFromDelegate]+[GrowlApplicationBridge willRegisterWhenGrowlIsReady]+[GrowlApplicationBridge setWillRegisterWhenGrowlIsReady:]+[GrowlApplicationBridge reregisterGrowlNotifications]+[GrowlApplicationBridge registerWithDictionary:]+[GrowlApplicationBridge isGrowlRunning]+[GrowlApplicationBridge isGrowlInstalled]+[GrowlApplicationBridge notifyWithDictionary:]+[GrowlApplicationBridge notifyWithTitle:description:notificationName:iconData:priority:isSticky:clickContext:identifier:]+[GrowlApplicationBridge notifyWithTitle:description:notificationName:iconData:priority:isSticky:clickContext:]+[GrowlApplicationBridge growlDelegate]+[GrowlApplicationBridge setGrowlDelegate:]_growlLaunched_appIconData_appName_delegate_registerWhenGrowlIsReady___i686.get_pc_thunk.bx___i686.get_pc_thunk.cx_targetsToNotifyArray_delegate_registerWhenGrowlIsReady_growlLaunched_registeredForClickCallbacks__copyAllPreferencePaneBundles__launchGrowlIfInstalledWithRegistrationDictionary__growlIsReady__growlNotificationWasClicked__growlNotificationTimedOut_Growl_CopyRegistrationDictionaryFromBundle_Growl_CopyRegistrationDictionaryFromDelegate_Growl_CreateBestRegistrationDictionary_Growl_CreateRegistrationDictionaryByFillingInDictionary_Growl_CreateRegistrationDictionaryByFillingInDictionaryRestrictedToKeys_Growl_GetDelegate_Growl_IsInstalled_Growl_IsRunning_Growl_LaunchIfInstalled_Growl_NotifyWithTitleDescriptionNameIconPriorityStickyClickContext_Growl_PostNotification_Growl_PostNotificationWithDictionary_Growl_RegisterWithDictionary_Growl_Reregister_Growl_SetDelegate_Growl_SetWillRegisterWhenGrowlIsReady_Growl_WillRegisterWhenGrowlIsReady__CFURLAliasDataKey__CFURLStringTypeKey__CFURLStringKey_copyFork_copyCurrentProcessURL_copyIconDataForURL_copyCurrentProcessName_copyTemporaryFolderPath_createDockDescriptionForURL_copyCurrentProcessPath_copyIconDataForPath_copyTemporaryFolderURL_createPropertyListFromURL_createURLByCopyingFileFromURLToDirectoryURL_createURLByMakingDirectoryAtURLWithName-[GrowlDelegate setApplicationIconDataForGrowl:]-[GrowlDelegate applicationIconDataForGrowl]-[GrowlDelegate setApplicationNameForGrowl:]-[GrowlDelegate applicationNameForGrowl]-[GrowlDelegate registrationDictionaryForGrowl]-[GrowlDelegate dealloc]-[GrowlDelegate initWithAllNotifications:defaultNotifications:]+[GrowlPathUtil nextScreenshotName]+[GrowlPathUtil screenshotsDirectory]+[GrowlPathUtil growlSupportDir]+[GrowlPathUtil helperAppBundle]+[GrowlPathUtil growlPrefPaneBundle]_bundleIDComparisonFlags.94447_prefPaneBundle_helperAppBundle-[NSURL(GrowlAdditions) dockDescription]-[NSURL(GrowlAdditions) aliasData]+[NSURL(GrowlAdditions) fileURLWithDockDescription:]+[NSURL(GrowlAdditions) fileURLWithAliasData:]-[NSImage(GrowlImageAdditions) representationOfSize:]-[NSImage(GrowlImageAdditions) bestRepresentationForSize:]-[NSImage(GrowlImageAdditions) adjustSizeToDrawAtSize:]-[NSImage(GrowlImageAdditions) drawScaledInRect:operation:fraction:]__mh_dylib_headerunison-2.32.52/uimacnew/Growl.framework/Versions/A/Headers/0000755000076500000000000000000011222164527023075 5ustar bcpiercewheelunison-2.32.52/uimacnew/Growl.framework/Versions/A/Headers/Growl.h0000644000076500000000000000020211176730177024342 0ustar bcpiercewheel#include "GrowlDefines.h" #ifdef __OBJC__ # include "GrowlApplicationBridge.h" #endif #include "GrowlApplicationBridge-Carbon.h" unison-2.32.52/uimacnew/Growl.framework/Versions/A/Headers/GrowlApplicationBridge-Carbon.h0000644000076500000000000010110311176730177031047 0ustar bcpiercewheel// // GrowlApplicationBridge-Carbon.h // Growl // // Created by Mac-arena the Bored Zo on Wed Jun 18 2004. // Based on GrowlApplicationBridge.h by Evan Schoenberg. // This source code is in the public domain. You may freely link it into any // program. // #ifndef _GROWLAPPLICATIONBRIDGE_CARBON_H_ #define _GROWLAPPLICATIONBRIDGE_CARBON_H_ #include #include /*! @header GrowlApplicationBridge-Carbon.h * @abstract Declares an API that Carbon applications can use to interact with Growl. * @discussion GrowlApplicationBridge uses a delegate to provide information //XXX * to Growl (such as your application's name and what notifications it may * post) and to provide information to your application (such as that Growl * is listening for notifications or that a notification has been clicked). * * You can set the Growldelegate with Growl_SetDelegate and find out the * current delegate with Growl_GetDelegate. See struct Growl_Delegate for more * information about the delegate. */ __BEGIN_DECLS /*! @struct Growl_Delegate * @abstract Delegate to supply GrowlApplicationBridge with information and respond to events. * @discussion The Growl delegate provides your interface to * GrowlApplicationBridge. When GrowlApplicationBridge needs information about * your application, it looks for it in the delegate; when Growl or the user * does something that you might be interested in, GrowlApplicationBridge * looks for a callback in the delegate and calls it if present * (meaning, if it is not NULL). * XXX on all of that * @field size The size of the delegate structure. * @field applicationName The name of your application. * @field registrationDictionary A dictionary describing your application and the notifications it can send out. * @field applicationIconData Your application's icon. * @field growlInstallationWindowTitle The title of the installation window. * @field growlInstallationInformation Text to display in the installation window. * @field growlUpdateWindowTitle The title of the update window. * @field growlUpdateInformation Text to display in the update window. * @field referenceCount A count of owners of the delegate. * @field retain Called when GrowlApplicationBridge receives this delegate. * @field release Called when GrowlApplicationBridge no longer needs this delegate. * @field growlIsReady Called when GrowlHelperApp is listening for notifications. * @field growlNotificationWasClicked Called when a Growl notification is clicked. * @field growlNotificationTimedOut Called when a Growl notification timed out. */ struct Growl_Delegate { /* @discussion This should be sizeof(struct Growl_Delegate). */ size_t size; /*All of these attributes are optional. *Optional attributes can be NULL; required attributes that * are NULL cause setting the Growl delegate to fail. *XXX - move optional/required status into the discussion for each field */ /* This name is used both internally and in the Growl preferences. * * This should remain stable between different versions and incarnations of * your application. * For example, "SurfWriter" is a good app name, whereas "SurfWriter 2.0" and * "SurfWriter Lite" are not. * * This can be NULL if it is provided elsewhere, namely in an * auto-discoverable plist file in your app bundle * (XXX refer to more information on that) or in registrationDictionary. */ CFStringRef applicationName; /* * Must contain at least these keys: * GROWL_NOTIFICATIONS_ALL (CFArray): * Contains the names of all notifications your application may post. * * Can also contain these keys: * GROWL_NOTIFICATIONS_DEFAULT (CFArray): * Names of notifications that should be enabled by default. * If omitted, GROWL_NOTIFICATIONS_ALL will be used. * GROWL_APP_NAME (CFString): * Same as the applicationName member of this structure. * If both are present, the applicationName member shall prevail. * If this key is present, you may omit applicationName (set it to NULL). * GROWL_APP_ICON (CFData): * Same as the iconData member of this structure. * If both are present, the iconData member shall prevail. * If this key is present, you may omit iconData (set it to NULL). * * If you change the contents of this dictionary after setting the delegate, * be sure to call Growl_Reregister. * * This can be NULL if you have an auto-discoverable plist file in your app * bundle. (XXX refer to more information on that) */ CFDictionaryRef registrationDictionary; /* The data can be in any format supported by NSImage. As of * Mac OS X 10.3, this includes the .icns, TIFF, JPEG, GIF, PNG, PDF, and * PICT formats. * * If this is not supplied, Growl will look up your application's icon by * its application name. */ CFDataRef applicationIconData; /* Installer display attributes * * These four attributes are used by the Growl installer, if this framework * supports it. * For any of these being NULL, a localised default will be * supplied. */ /* If this is NULL, Growl will use a default, * localized title. * * Only used if you're using Growl-WithInstaller.framework. Otherwise, * this member is ignored. */ CFStringRef growlInstallationWindowTitle; /* This information may be as long or short as desired (the * window will be sized to fit it). If Growl is not installed, it will * be displayed to the user as an explanation of what Growl is and what * it can do in your application. * It should probably note that no download is required to install. * * If this is NULL, Growl will use a default, localized * explanation. * * Only used if you're using Growl-WithInstaller.framework. Otherwise, * this member is ignored. */ CFStringRef growlInstallationInformation; /* If this is NULL, Growl will use a default, * localized title. * * Only used if you're using Growl-WithInstaller.framework. Otherwise, * this member is ignored. */ CFStringRef growlUpdateWindowTitle; /* This information may be as long or short as desired (the * window will be sized to fit it). If an older version of Growl is * installed, it will be displayed to the user as an explanation that an * updated version of Growl is included in your application and * no download is required. * * If this is NULL, Growl will use a default, localized * explanation. * * Only used if you're using Growl-WithInstaller.framework. Otherwise, * this member is ignored. */ CFStringRef growlUpdateInformation; /* This member is provided for use by your retain and release * callbacks (see below). * * GrowlApplicationBridge never directly uses this member. Instead, it * calls your retain callback (if non-NULL) and your release * callback (if non-NULL). */ unsigned referenceCount; //Functions. Currently all of these are optional (any of them can be NULL). /* When you call Growl_SetDelegate(newDelegate), it will call * oldDelegate->release(oldDelegate), and then it will call * newDelegate->retain(newDelegate), and the return value from retain * is what will be set as the delegate. * (This means that this member works like CFRetain and -[NSObject retain].) * This member is optional (it can be NULL). * For a delegate allocated with malloc, this member would be * NULL. * @result A delegate to which GrowlApplicationBridge holds a reference. */ void *(*retain)(void *); /* When you call Growl_SetDelegate(newDelegate), it will call * oldDelegate->release(oldDelegate), and then it will call * newDelegate->retain(newDelegate), and the return value from retain * is what will be set as the delegate. * (This means that this member works like CFRelease and * -[NSObject release].) * This member is optional (it can be NULL). * For a delegate allocated with malloc, this member might be * free(3). */ void (*release)(void *); /* Informs the delegate that Growl (specifically, the GrowlHelperApp) was * launched successfully (or was already running). The application can * take actions with the knowledge that Growl is installed and functional. */ void (*growlIsReady)(void); /* Informs the delegate that a Growl notification was clicked. It is only * sent for notifications sent with a non-NULL clickContext, * so if you want to receive a message when a notification is clicked, * clickContext must not be NULL when calling * Growl_PostNotification or * Growl_NotifyWithTitleDescriptionNameIconPriorityStickyClickContext. */ void (*growlNotificationWasClicked)(CFPropertyListRef clickContext); /* Informs the delegate that a Growl notification timed out. It is only * sent for notifications sent with a non-NULL clickContext, * so if you want to receive a message when a notification is clicked, * clickContext must not be NULL when calling * Growl_PostNotification or * Growl_NotifyWithTitleDescriptionNameIconPriorityStickyClickContext. */ void (*growlNotificationTimedOut)(CFPropertyListRef clickContext); }; /*! @struct Growl_Notification * @abstract Structure describing a Growl notification. * @discussion XXX * @field size The size of the notification structure. * @field name Identifies the notification. * @field title Short synopsis of the notification. * @field description Additional text. * @field iconData An icon for the notification. * @field priority An indicator of the notification's importance. * @field reserved Bits reserved for future usage. * @field isSticky Requests that a notification stay on-screen until dismissed explicitly. * @field clickContext An identifier to be passed to your click callback when a notification is clicked. * @field clickCallback A callback to call when the notification is clicked. */ struct Growl_Notification { /* This should be sizeof(struct Growl_Notification). */ size_t size; /* The notification name distinguishes one type of * notification from another. The name should be human-readable, as it * will be displayed in the Growl preference pane. * * The name is used in the GROWL_NOTIFICATIONS_ALL and * GROWL_NOTIFICATIONS_DEFAULT arrays in the registration dictionary, and * in this member of the Growl_Notification structure. */ CFStringRef name; /* A notification's title describes the notification briefly. * It should be easy to read quickly by the user. */ CFStringRef title; /* The description supplements the title with more * information. It is usually longer and sometimes involves a list of * subjects. For example, for a 'Download complete' notification, the * description might have one filename per line. GrowlMail in Growl 0.6 * uses a description of '%d new mail(s)' (formatted with the number of * messages). */ CFStringRef description; /* The notification icon usually indicates either what * happened (it may have the same icon as e.g. a toolbar item that * started the process that led to the notification), or what it happened * to (e.g. a document icon). * * The icon data is optional, so it can be NULL. In that * case, the application icon is used alone. Not all displays support * icons. * * The data can be in any format supported by NSImage. As of Mac OS X * 10.3, this includes the .icns, TIFF, JPEG, GIF, PNG, PDF, and PICT form * ats. */ CFDataRef iconData; /* Priority is new in Growl 0.6, and is represented as a * signed integer from -2 to +2. 0 is Normal priority, -2 is Very Low * priority, and +2 is Very High priority. * * Not all displays support priority. If you do not wish to assign a * priority to your notification, assign 0. */ signed int priority; /* These bits are not used in Growl 0.6. Set them to 0. */ unsigned reserved: 31; /* When the sticky bit is clear, in most displays, * notifications disappear after a certain amount of time. Sticky * notifications, however, remain on-screen until the user dismisses them * explicitly, usually by clicking them. * * Sticky notifications were introduced in Growl 0.6. Most notifications * should not be sticky. Not all displays support sticky notifications, * and the user may choose in Growl's preference pane to force the * notification to be sticky or non-sticky, in which case the sticky bit * in the notification will be ignored. */ unsigned isSticky: 1; /* If this is not NULL, and your click callback * is not NULL either, this will be passed to the callback * when your notification is clicked by the user. * * Click feedback was introduced in Growl 0.6, and it is optional. Not * all displays support click feedback. */ CFPropertyListRef clickContext; /* If this is not NULL, it will be called instead * of the Growl delegate's click callback when clickContext is * non-NULL and the notification is clicked on by the user. * * Click feedback was introduced in Growl 0.6, and it is optional. Not * all displays support click feedback. * * The per-notification click callback is not yet supported as of Growl * 0.7. */ void (*clickCallback)(CFPropertyListRef clickContext); }; #pragma mark - #pragma mark Easy initialisers /*! @defined InitGrowlDelegate * @abstract Callable macro. Initializes a Growl delegate structure to defaults. * @discussion Call with a pointer to a struct Growl_Delegate. All of the * members of the structure will be set to 0 or NULL, except for * size (which will be set to sizeof(struct Growl_Delegate)) and * referenceCount (which will be set to 1). */ #define InitGrowlDelegate(delegate) \ do { \ if (delegate) { \ (delegate)->size = sizeof(struct Growl_Delegate); \ (delegate)->applicationName = NULL; \ (delegate)->registrationDictionary = NULL; \ (delegate)->applicationIconData = NULL; \ (delegate)->growlInstallationWindowTitle = NULL; \ (delegate)->growlInstallationInformation = NULL; \ (delegate)->growlUpdateWindowTitle = NULL; \ (delegate)->growlUpdateInformation = NULL; \ (delegate)->referenceCount = 1U; \ (delegate)->retain = NULL; \ (delegate)->release = NULL; \ (delegate)->growlIsReady = NULL; \ (delegate)->growlNotificationWasClicked = NULL; \ (delegate)->growlNotificationTimedOut = NULL; \ } \ } while(0) /*! @defined InitGrowlNotification * @abstract Callable macro. Initializes a Growl notification structure to defaults. * @discussion Call with a pointer to a struct Growl_Notification. All of * the members of the structure will be set to 0 or NULL, except * for size (which will be set to * sizeof(struct Growl_Notification)). */ #define InitGrowlNotification(notification) \ do { \ if (notification) { \ (notification)->size = sizeof(struct Growl_Notification); \ (notification)->name = NULL; \ (notification)->title = NULL; \ (notification)->description = NULL; \ (notification)->iconData = NULL; \ (notification)->priority = 0; \ (notification)->reserved = 0U; \ (notification)->isSticky = false; \ (notification)->clickContext = NULL; \ } \ } while(0) #pragma mark - #pragma mark Public API // @functiongroup Managing the Growl delegate /*! @function Growl_SetDelegate * @abstract Replaces the current Growl delegate with a new one, or removes * the Growl delegate. * @param newDelegate * @result Returns false and does nothing else if a pointer that was passed in * is unsatisfactory (because it is non-NULL, but at least one * required member of it is NULL). Otherwise, sets or unsets the * delegate and returns true. * @discussion When newDelegate is non-NULL, sets * the delegate to newDelegate. When it is NULL, * the current delegate will be unset, and no delegate will be in place. * * It is legal for newDelegate to be the current delegate; * nothing will happen, and Growl_SetDelegate will return true. It is also * legal for it to be NULL, as described above; again, it will * return true. * * If there was a delegate in place before the call, Growl_SetDelegate will * call the old delegate's release member if it was non-NULL. If * newDelegate is non-NULL, Growl_SetDelegate will * call newDelegate->retain, and set the delegate to its return * value. * * If you are using Growl-WithInstaller.framework, and an older version of * Growl is installed on the user's system, the user will automatically be * prompted to update. * * GrowlApplicationBridge currently does not copy this structure, nor does it * retain any of the CF objects in the structure (it regards the structure as * a container that retains the objects when they are added and releases them * when they are removed or the structure is destroyed). Also, * GrowlApplicationBridge currently does not modify any member of the * structure, except possibly the referenceCount by calling the retain and * release members. */ Boolean Growl_SetDelegate(struct Growl_Delegate *newDelegate); /*! @function Growl_GetDelegate * @abstract Returns the current Growl delegate, if any. * @result The current Growl delegate. * @discussion Returns the last pointer passed into Growl_SetDelegate, or * NULL if no such call has been made. * * This function follows standard Core Foundation reference-counting rules. * Because it is a Get function, not a Copy function, it will not retain the * delegate on your behalf. You are responsible for retaining and releasing * the delegate as needed. */ struct Growl_Delegate *Growl_GetDelegate(void); #pragma mark - // @functiongroup Posting Growl notifications /*! @function Growl_PostNotification * @abstract Posts a Growl notification. * @param notification The notification to post. * @discussion This is the preferred means for sending a Growl notification. * The notification name and at least one of the title and description are * required (all three are preferred). All other parameters may be * NULL (or 0 or false as appropriate) to accept default values. * * If using the Growl-WithInstaller framework, if Growl is not installed the * user will be prompted to install Growl. * If the user cancels, this function will have no effect until the next * application session, at which time when it is called the user will be * prompted again. The user is also given the option to not be prompted again. * If the user does choose to install Growl, the requested notification will * be displayed once Growl is installed and running. */ void Growl_PostNotification(const struct Growl_Notification *notification); /*! @function Growl_PostNotificationWithDictionary * @abstract Notifies using a userInfo dictionary suitable for passing to * CFDistributedNotificationCenter. * @param userInfo The dictionary to notify with. * @discussion Before Growl 0.6, your application would have posted * notifications using CFDistributedNotificationCenter by creating a userInfo * dictionary with the notification data. This had the advantage of allowing * you to add other data to the dictionary for programs besides Growl that * might be listening. * * This function allows you to use such dictionaries without being restricted * to using CFDistributedNotificationCenter. The keys for this dictionary * can be found in GrowlDefines.h. */ void Growl_PostNotificationWithDictionary(CFDictionaryRef userInfo); /*! @function Growl_NotifyWithTitleDescriptionNameIconPriorityStickyClickContext * @abstract Posts a Growl notification using parameter values. * @param title The title of the notification. * @param description The description of the notification. * @param notificationName The name of the notification as listed in the * registration dictionary. * @param iconData Data representing a notification icon. Can be NULL. * @param priority The priority of the notification (-2 to +2, with -2 * being Very Low and +2 being Very High). * @param isSticky If true, requests that this notification wait for a * response from the user. * @param clickContext An object to pass to the clickCallback, if any. Can * be NULL, in which case the clickCallback is not called. * @discussion Creates a temporary Growl_Notification, fills it out with the * supplied information, and calls Growl_PostNotification on it. * See struct Growl_Notification and Growl_PostNotification for more * information. * * The icon data can be in any format supported by NSImage. As of Mac OS X * 10.3, this includes the .icns, TIFF, JPEG, GIF, PNG, PDF, and PICT formats. */ void Growl_NotifyWithTitleDescriptionNameIconPriorityStickyClickContext( /*inhale*/ CFStringRef title, CFStringRef description, CFStringRef notificationName, CFDataRef iconData, signed int priority, Boolean isSticky, CFPropertyListRef clickContext); #pragma mark - // @functiongroup Registering /*! @function Growl_RegisterWithDictionary * @abstract Register your application with Growl without setting a delegate. * @discussion When you call this function with a dictionary, * GrowlApplicationBridge registers your application using that dictionary. * If you pass NULL, GrowlApplicationBridge will ask the delegate * (if there is one) for a dictionary, and if that doesn't work, it will look * in your application's bundle for an auto-discoverable plist. * (XXX refer to more information on that) * * If you pass a dictionary to this function, it must include the * GROWL_APP_NAME key, unless a delegate is set. * * This function is mainly an alternative to the delegate system introduced * with Growl 0.6. Without a delegate, you cannot receive callbacks such as * growlIsReady (since they are sent to the delegate). You can, * however, set a delegate after registering without one. * * This function was introduced in Growl.framework 0.7. * @result false if registration failed (e.g. if Growl isn't installed). */ Boolean Growl_RegisterWithDictionary(CFDictionaryRef regDict); /*! @function Growl_Reregister * @abstract Updates your registration with Growl. * @discussion If your application changes the contents of the * GROWL_NOTIFICATIONS_ALL key in the registrationDictionary member of the * Growl delegate, or if it changes the value of that member, or if it * changes the contents of its auto-discoverable plist, call this function * to have Growl update its registration information for your application. * * Otherwise, this function does not normally need to be called. If you're * using a delegate, your application will be registered when you set the * delegate if both the delegate and its registrationDictionary member are * non-NULL. * * This function is now implemented using * Growl_RegisterWithDictionary. */ void Growl_Reregister(void); #pragma mark - /*! @function Growl_SetWillRegisterWhenGrowlIsReady * @abstract Tells GrowlApplicationBridge to register with Growl when Growl * launches (or not). * @discussion When Growl has started listening for notifications, it posts a * GROWL_IS_READY notification on the Distributed Notification * Center. GrowlApplicationBridge listens for this notification, using it to * perform various tasks (such as calling your delegate's * growlIsReady callback, if it has one). If this function is * called with true, one of those tasks will be to reregister * with Growl (in the manner of Growl_Reregister). * * This attribute is automatically set back to false * (the default) after every GROWL_IS_READY notification. * @param flag true if you want GrowlApplicationBridge to register with * Growl when next it is ready; false if not. */ void Growl_SetWillRegisterWhenGrowlIsReady(Boolean flag); /*! @function Growl_WillRegisterWhenGrowlIsReady * @abstract Reports whether GrowlApplicationBridge will register with Growl * when Growl next launches. * @result true if GrowlApplicationBridge will register with * Growl when next it posts GROWL_IS_READY; false if not. */ Boolean Growl_WillRegisterWhenGrowlIsReady(void); #pragma mark - // @functiongroup Obtaining registration dictionaries /*! @function Growl_CopyRegistrationDictionaryFromDelegate * @abstract Asks the delegate for a registration dictionary. * @discussion If no delegate is set, or if the delegate's * registrationDictionary member is NULL, this * function returns NULL. * * This function does not attempt to clean up the dictionary in any way - for * example, if it is missing the GROWL_APP_NAME key, the result * will be missing it too. Use * Growl_CreateRegistrationDictionaryByFillingInDictionary: or * Growl_CreateRegistrationDictionaryByFillingInDictionaryRestrictedToKeys * to try to fill in missing keys. * * This function was introduced in Growl.framework 0.7. * @result A registration dictionary. */ CFDictionaryRef Growl_CopyRegistrationDictionaryFromDelegate(void); /*! @function Growl_CopyRegistrationDictionaryFromBundle * @abstract Looks in a bundle for a registration dictionary. * @discussion This function looks in a bundle for an auto-discoverable * registration dictionary file using CFBundleCopyResourceURL. * If it finds one, it loads the file using CFPropertyList and * returns the result. * * If you pass NULL as the bundle, the main bundle is examined. * * This function does not attempt to clean up the dictionary in any way - for * example, if it is missing the GROWL_APP_NAME key, the result * will be missing it too. Use * Growl_CreateRegistrationDictionaryByFillingInDictionary: or * Growl_CreateRegistrationDictionaryByFillingInDictionaryRestrictedToKeys * to try to fill in missing keys. * * This function was introduced in Growl.framework 0.7. * @result A registration dictionary. */ CFDictionaryRef Growl_CopyRegistrationDictionaryFromBundle(CFBundleRef bundle); /*! @function Growl_CreateBestRegistrationDictionary * @abstract Obtains a registration dictionary, filled out to the best of * GrowlApplicationBridge's knowledge. * @discussion This function creates a registration dictionary as best * GrowlApplicationBridge knows how. * * First, GrowlApplicationBridge examines the Growl delegate (if there is * one) and gets the registration dictionary from that. If no such dictionary * was obtained, GrowlApplicationBridge looks in your application's main * bundle for an auto-discoverable registration dictionary file. If that * doesn't exist either, this function returns NULL. * * Second, GrowlApplicationBridge calls * Growl_CreateRegistrationDictionaryByFillingInDictionary with * whatever dictionary was obtained. The result of that function is the * result of this function. * * GrowlApplicationBridge uses this function when you call * Growl_SetDelegate, or when you call * Growl_RegisterWithDictionary with NULL. * * This function was introduced in Growl.framework 0.7. * @result A registration dictionary. */ CFDictionaryRef Growl_CreateBestRegistrationDictionary(void); #pragma mark - // @functiongroup Filling in registration dictionaries /*! @function Growl_CreateRegistrationDictionaryByFillingInDictionary * @abstract Tries to fill in missing keys in a registration dictionary. * @param regDict The dictionary to fill in. * @result The dictionary with the keys filled in. * @discussion This function examines the passed-in dictionary for missing keys, * and tries to work out correct values for them. As of 0.7, it uses: * * Key Value * --- ----- * GROWL_APP_NAME CFBundleExecutableName * GROWL_APP_ICON The icon of the application. * GROWL_APP_LOCATION The location of the application. * GROWL_NOTIFICATIONS_DEFAULT GROWL_NOTIFICATIONS_ALL * * Keys are only filled in if missing; if a key is present in the dictionary, * its value will not be changed. * * This function was introduced in Growl.framework 0.7. */ CFDictionaryRef Growl_CreateRegistrationDictionaryByFillingInDictionary(CFDictionaryRef regDict); /*! @function Growl_CreateRegistrationDictionaryByFillingInDictionaryRestrictedToKeys * @abstract Tries to fill in missing keys in a registration dictionary. * @param regDict The dictionary to fill in. * @param keys The keys to fill in. If NULL, any missing keys are filled in. * @result The dictionary with the keys filled in. * @discussion This function examines the passed-in dictionary for missing keys, * and tries to work out correct values for them. As of 0.7, it uses: * * Key Value * --- ----- * GROWL_APP_NAME CFBundleExecutableName * GROWL_APP_ICON The icon of the application. * GROWL_APP_LOCATION The location of the application. * GROWL_NOTIFICATIONS_DEFAULT GROWL_NOTIFICATIONS_ALL * * Only those keys that are listed in keys will be filled in. * Other missing keys are ignored. Also, keys are only filled in if missing; * if a key is present in the dictionary, its value will not be changed. * * This function was introduced in Growl.framework 0.7. */ CFDictionaryRef Growl_CreateRegistrationDictionaryByFillingInDictionaryRestrictedToKeys(CFDictionaryRef regDict, CFSetRef keys); #pragma mark - // @functiongroup Querying Growl's status /*! @function Growl_IsInstalled * @abstract Determines whether the Growl prefpane and its helper app are * installed. * @result Returns true if Growl is installed, false otherwise. */ Boolean Growl_IsInstalled(void); /*! @function Growl_IsRunning * @abstract Cycles through the process list to find whether GrowlHelperApp * is running. * @result Returns true if Growl is running, false otherwise. */ Boolean Growl_IsRunning(void); #pragma mark - // @functiongroup Launching Growl /*! @typedef GrowlLaunchCallback * @abstract Callback to notify you that Growl is running. * @param context The context pointer passed to Growl_LaunchIfInstalled. * @discussion Growl_LaunchIfInstalled calls this callback function if Growl * was already running or if it launched Growl successfully. */ typedef void (*GrowlLaunchCallback)(void *context); /*! @function Growl_LaunchIfInstalled * @abstract Launches GrowlHelperApp if it is not already running. * @param callback A callback function which will be called if Growl was successfully * launched or was already running. Can be NULL. * @param context The context pointer to pass to the callback. Can be NULL. * @result Returns true if Growl was successfully launched or was already * running; returns false and does not call the callback otherwise. * @discussion Returns true and calls the callback (if the callback is not * NULL) if the Growl helper app began launching or was already * running. Returns false and performs no other action if Growl could not be * launched (e.g. because the Growl preference pane is not properly installed). * * If Growl_CreateBestRegistrationDictionary returns * non-NULL, this function will register with Growl atomically. * * The callback should take a single argument; this is to allow applications * to have context-relevant information passed back. It is perfectly * acceptable for context to be NULL. The callback itself can be * NULL if you don't want one. */ Boolean Growl_LaunchIfInstalled(GrowlLaunchCallback callback, void *context); #pragma mark - #pragma mark Constants /*! @defined GROWL_PREFPANE_BUNDLE_IDENTIFIER * @abstract The CFBundleIdentifier of the Growl preference pane bundle. * @discussion GrowlApplicationBridge uses this to determine whether Growl is * currently installed, by searching for the Growl preference pane. Your * application probably does not need to use this macro itself. */ #ifndef GROWL_PREFPANE_BUNDLE_IDENTIFIER #define GROWL_PREFPANE_BUNDLE_IDENTIFIER CFSTR("com.growl.prefpanel") #endif __END_DECLS #endif /* _GROWLAPPLICATIONBRIDGE_CARBON_H_ */ unison-2.32.52/uimacnew/Growl.framework/Versions/A/Headers/GrowlApplicationBridge.h0000644000076500000000000006317411176730177027664 0ustar bcpiercewheel// // GrowlApplicationBridge.h // Growl // // Created by Evan Schoenberg on Wed Jun 16 2004. // Copyright 2004-2005 The Growl Project. All rights reserved. // /*! * @header GrowlApplicationBridge.h * @abstract Defines the GrowlApplicationBridge class. * @discussion This header defines the GrowlApplicationBridge class as well as * the GROWL_PREFPANE_BUNDLE_IDENTIFIER constant. */ #ifndef __GrowlApplicationBridge_h__ #define __GrowlApplicationBridge_h__ #import #import "GrowlDefines.h" //Forward declarations @protocol GrowlApplicationBridgeDelegate; /*! * @defined GROWL_PREFPANE_BUNDLE_IDENTIFIER * @discussion The bundle identifier for the Growl prefpane. */ #define GROWL_PREFPANE_BUNDLE_IDENTIFIER @"com.growl.prefpanel" /*! * @defined GROWL_PREFPANE_NAME * @discussion The file name of the Growl prefpane. */ #define GROWL_PREFPANE_NAME @"Growl.prefPane" //Internal notification when the user chooses not to install (to avoid continuing to cache notifications awaiting installation) #define GROWL_USER_CHOSE_NOT_TO_INSTALL_NOTIFICATION @"User chose not to install" //------------------------------------------------------------------------------ #pragma mark - /*! * @class GrowlApplicationBridge * @abstract A class used to interface with Growl. * @discussion This class provides a means to interface with Growl. * * Currently it provides a way to detect if Growl is installed and launch the * GrowlHelperApp if it's not already running. */ @interface GrowlApplicationBridge : NSObject { } /*! * @method isGrowlInstalled * @abstract Detects whether Growl is installed. * @discussion Determines if the Growl prefpane and its helper app are installed. * @result Returns YES if Growl is installed, NO otherwise. */ + (BOOL) isGrowlInstalled; /*! * @method isGrowlRunning * @abstract Detects whether GrowlHelperApp is currently running. * @discussion Cycles through the process list to find whether GrowlHelperApp is running and returns its findings. * @result Returns YES if GrowlHelperApp is running, NO otherwise. */ + (BOOL) isGrowlRunning; #pragma mark - /*! * @method setGrowlDelegate: * @abstract Set the object which will be responsible for providing and receiving Growl information. * @discussion This must be called before using GrowlApplicationBridge. * * The methods in the GrowlApplicationBridgeDelegate protocol are required * and return the basic information needed to register with Growl. * * The methods in the GrowlApplicationBridgeDelegate_InformalProtocol * informal protocol are individually optional. They provide a greater * degree of interaction between the application and growl such as informing * the application when one of its Growl notifications is clicked by the user. * * The methods in the GrowlApplicationBridgeDelegate_Installation_InformalProtocol * informal protocol are individually optional and are only applicable when * using the Growl-WithInstaller.framework which allows for automated Growl * installation. * * When this method is called, data will be collected from inDelegate, Growl * will be launched if it is not already running, and the application will be * registered with Growl. * * If using the Growl-WithInstaller framework, if Growl is already installed * but this copy of the framework has an updated version of Growl, the user * will be prompted to update automatically. * * @param inDelegate The delegate for the GrowlApplicationBridge. It must conform to the GrowlApplicationBridgeDelegate protocol. */ + (void) setGrowlDelegate:(NSObject *)inDelegate; /*! * @method growlDelegate * @abstract Return the object responsible for providing and receiving Growl information. * @discussion See setGrowlDelegate: for details. * @result The Growl delegate. */ + (NSObject *) growlDelegate; #pragma mark - /*! * @method notifyWithTitle:description:notificationName:iconData:priority:isSticky:clickContext: * @abstract Send a Growl notification. * @discussion This is the preferred means for sending a Growl notification. * The notification name and at least one of the title and description are * required (all three are preferred). All other parameters may be * nil (or 0 or NO as appropriate) to accept default values. * * If using the Growl-WithInstaller framework, if Growl is not installed the * user will be prompted to install Growl. If the user cancels, this method * will have no effect until the next application session, at which time when * it is called the user will be prompted again. The user is also given the * option to not be prompted again. If the user does choose to install Growl, * the requested notification will be displayed once Growl is installed and * running. * * @param title The title of the notification displayed to the user. * @param description The full description of the notification displayed to the user. * @param notifName The internal name of the notification. Should be human-readable, as it will be displayed in the Growl preference pane. * @param iconData NSData object to show with the notification as its icon. If nil, the application's icon will be used instead. * @param priority The priority of the notification. The default value is 0; positive values are higher priority and negative values are lower priority. Not all Growl displays support priority. * @param isSticky If YES, the notification will remain on screen until clicked. Not all Growl displays support sticky notifications. * @param clickContext A context passed back to the Growl delegate if it implements -(void)growlNotificationWasClicked: and the notification is clicked. Not all display plugins support clicking. The clickContext must be plist-encodable (completely of NSString, NSArray, NSNumber, NSDictionary, and NSData types). */ + (void) notifyWithTitle:(NSString *)title description:(NSString *)description notificationName:(NSString *)notifName iconData:(NSData *)iconData priority:(signed int)priority isSticky:(BOOL)isSticky clickContext:(id)clickContext; /*! * @method notifyWithTitle:description:notificationName:iconData:priority:isSticky:clickContext:identifier: * @abstract Send a Growl notification. * @discussion This is the preferred means for sending a Growl notification. * The notification name and at least one of the title and description are * required (all three are preferred). All other parameters may be * nil (or 0 or NO as appropriate) to accept default values. * * If using the Growl-WithInstaller framework, if Growl is not installed the * user will be prompted to install Growl. If the user cancels, this method * will have no effect until the next application session, at which time when * it is called the user will be prompted again. The user is also given the * option to not be prompted again. If the user does choose to install Growl, * the requested notification will be displayed once Growl is installed and * running. * * @param title The title of the notification displayed to the user. * @param description The full description of the notification displayed to the user. * @param notifName The internal name of the notification. Should be human-readable, as it will be displayed in the Growl preference pane. * @param iconData NSData object to show with the notification as its icon. If nil, the application's icon will be used instead. * @param priority The priority of the notification. The default value is 0; positive values are higher priority and negative values are lower priority. Not all Growl displays support priority. * @param isSticky If YES, the notification will remain on screen until clicked. Not all Growl displays support sticky notifications. * @param clickContext A context passed back to the Growl delegate if it implements -(void)growlNotificationWasClicked: and the notification is clicked. Not all display plugins support clicking. The clickContext must be plist-encodable (completely of NSString, NSArray, NSNumber, NSDictionary, and NSData types). * @param identifier An identifier for this notification. Notifications with equal identifiers are coalesced. */ + (void) notifyWithTitle:(NSString *)title description:(NSString *)description notificationName:(NSString *)notifName iconData:(NSData *)iconData priority:(signed int)priority isSticky:(BOOL)isSticky clickContext:(id)clickContext identifier:(NSString *)identifier; /*! @method notifyWithDictionary: * @abstract Notifies using a userInfo dictionary suitable for passing to * NSDistributedNotificationCenter. * @param userInfo The dictionary to notify with. * @discussion Before Growl 0.6, your application would have posted * notifications using NSDistributedNotificationCenter by * creating a userInfo dictionary with the notification data. This had the * advantage of allowing you to add other data to the dictionary for programs * besides Growl that might be listening. * * This method allows you to use such dictionaries without being restricted * to using NSDistributedNotificationCenter. The keys for this dictionary * can be found in GrowlDefines.h. */ + (void) notifyWithDictionary:(NSDictionary *)userInfo; #pragma mark - /*! @method registerWithDictionary: * @abstract Register your application with Growl without setting a delegate. * @discussion When you call this method with a dictionary, * GrowlApplicationBridge registers your application using that dictionary. * If you pass nil, GrowlApplicationBridge will ask the delegate * (if there is one) for a dictionary, and if that doesn't work, it will look * in your application's bundle for an auto-discoverable plist. * (XXX refer to more information on that) * * If you pass a dictionary to this method, it must include the * GROWL_APP_NAME key, unless a delegate is set. * * This method is mainly an alternative to the delegate system introduced * with Growl 0.6. Without a delegate, you cannot receive callbacks such as * -growlIsReady (since they are sent to the delegate). You can, * however, set a delegate after registering without one. * * This method was introduced in Growl.framework 0.7. */ + (BOOL) registerWithDictionary:(NSDictionary *)regDict; /*! @method reregisterGrowlNotifications * @abstract Reregister the notifications for this application. * @discussion This method does not normally need to be called. If your * application changes what notifications it is registering with Growl, call * this method to have the Growl delegate's * -registrationDictionaryForGrowl method called again and the * Growl registration information updated. * * This method is now implemented using -registerWithDictionary:. */ + (void) reregisterGrowlNotifications; #pragma mark - /*! @method setWillRegisterWhenGrowlIsReady: * @abstract Tells GrowlApplicationBridge to register with Growl when Growl * launches (or not). * @discussion When Growl has started listening for notifications, it posts a * GROWL_IS_READY notification on the Distributed Notification * Center. GrowlApplicationBridge listens for this notification, using it to * perform various tasks (such as calling your delegate's * -growlIsReady method, if it has one). If this method is * called with YES, one of those tasks will be to reregister * with Growl (in the manner of -reregisterGrowlNotifications). * * This attribute is automatically set back to NO (the default) * after every GROWL_IS_READY notification. * @param flag YES if you want GrowlApplicationBridge to register with * Growl when next it is ready; NO if not. */ + (void) setWillRegisterWhenGrowlIsReady:(BOOL)flag; /*! @method willRegisterWhenGrowlIsReady * @abstract Reports whether GrowlApplicationBridge will register with Growl * when Growl next launches. * @result YES if GrowlApplicationBridge will register with Growl * when next it posts GROWL_IS_READY; NO if not. */ + (BOOL) willRegisterWhenGrowlIsReady; #pragma mark - /*! @method registrationDictionaryFromDelegate * @abstract Asks the delegate for a registration dictionary. * @discussion If no delegate is set, or if the delegate's * -registrationDictionaryForGrowl method returns * nil, this method returns nil. * * This method does not attempt to clean up the dictionary in any way - for * example, if it is missing the GROWL_APP_NAME key, the result * will be missing it too. Use +[GrowlApplicationBridge * registrationDictionaryByFillingInDictionary:] or * +[GrowlApplicationBridge * registrationDictionaryByFillingInDictionary:restrictToKeys:] to try * to fill in missing keys. * * This method was introduced in Growl.framework 0.7. * @result A registration dictionary. */ + (NSDictionary *) registrationDictionaryFromDelegate; /*! @method registrationDictionaryFromBundle: * @abstract Looks in a bundle for a registration dictionary. * @discussion This method looks in a bundle for an auto-discoverable * registration dictionary file using -[NSBundle * pathForResource:ofType:]. If it finds one, it loads the file using * +[NSDictionary dictionaryWithContentsOfFile:] and returns the * result. * * If you pass nil as the bundle, the main bundle is examined. * * This method does not attempt to clean up the dictionary in any way - for * example, if it is missing the GROWL_APP_NAME key, the result * will be missing it too. Use +[GrowlApplicationBridge * registrationDictionaryByFillingInDictionary:] or * +[GrowlApplicationBridge * registrationDictionaryByFillingInDictionary:restrictToKeys:] to try * to fill in missing keys. * * This method was introduced in Growl.framework 0.7. * @result A registration dictionary. */ + (NSDictionary *) registrationDictionaryFromBundle:(NSBundle *)bundle; /*! @method bestRegistrationDictionary * @abstract Obtains a registration dictionary, filled out to the best of * GrowlApplicationBridge's knowledge. * @discussion This method creates a registration dictionary as best * GrowlApplicationBridge knows how. * * First, GrowlApplicationBridge contacts the Growl delegate (if there is * one) and gets the registration dictionary from that. If no such dictionary * was obtained, GrowlApplicationBridge looks in your application's main * bundle for an auto-discoverable registration dictionary file. If that * doesn't exist either, this method returns nil. * * Second, GrowlApplicationBridge calls * +registrationDictionaryByFillingInDictionary: with whatever * dictionary was obtained. The result of that method is the result of this * method. * * GrowlApplicationBridge uses this method when you call * +setGrowlDelegate:, or when you call * +registerWithDictionary: with nil. * * This method was introduced in Growl.framework 0.7. * @result A registration dictionary. */ + (NSDictionary *) bestRegistrationDictionary; #pragma mark - /*! @method registrationDictionaryByFillingInDictionary: * @abstract Tries to fill in missing keys in a registration dictionary. * @discussion This method examines the passed-in dictionary for missing keys, * and tries to work out correct values for them. As of 0.7, it uses: * * Key Value * --- ----- * GROWL_APP_NAME CFBundleExecutableName * GROWL_APP_ICON The icon of the application. * GROWL_APP_LOCATION The location of the application. * GROWL_NOTIFICATIONS_DEFAULT GROWL_NOTIFICATIONS_ALL * * Keys are only filled in if missing; if a key is present in the dictionary, * its value will not be changed. * * This method was introduced in Growl.framework 0.7. * @param regDict The dictionary to fill in. * @result The dictionary with the keys filled in. This is an autoreleased * copy of regDict. */ + (NSDictionary *) registrationDictionaryByFillingInDictionary:(NSDictionary *)regDict; /*! @method registrationDictionaryByFillingInDictionary:restrictToKeys: * @abstract Tries to fill in missing keys in a registration dictionary. * @discussion This method examines the passed-in dictionary for missing keys, * and tries to work out correct values for them. As of 0.7, it uses: * * Key Value * --- ----- * GROWL_APP_NAME CFBundleExecutableName * GROWL_APP_ICON The icon of the application. * GROWL_APP_LOCATION The location of the application. * GROWL_NOTIFICATIONS_DEFAULT GROWL_NOTIFICATIONS_ALL * * Only those keys that are listed in keys will be filled in. * Other missing keys are ignored. Also, keys are only filled in if missing; * if a key is present in the dictionary, its value will not be changed. * * This method was introduced in Growl.framework 0.7. * @param regDict The dictionary to fill in. * @param keys The keys to fill in. If nil, any missing keys are filled in. * @result The dictionary with the keys filled in. This is an autoreleased * copy of regDict. */ + (NSDictionary *) registrationDictionaryByFillingInDictionary:(NSDictionary *)regDict restrictToKeys:(NSSet *)keys; @end //------------------------------------------------------------------------------ #pragma mark - /*! * @protocol GrowlApplicationBridgeDelegate * @abstract Required protocol for the Growl delegate. * @discussion The methods in this protocol are required and are called * automatically as needed by GrowlApplicationBridge. See * +[GrowlApplicationBridge setGrowlDelegate:]. * See also GrowlApplicationBridgeDelegate_InformalProtocol. */ @protocol GrowlApplicationBridgeDelegate // -registrationDictionaryForGrowl has moved to the informal protocol as of 0.7. @end //------------------------------------------------------------------------------ #pragma mark - /*! * @category NSObject(GrowlApplicationBridgeDelegate_InformalProtocol) * @abstract Methods which may be optionally implemented by the GrowlDelegate. * @discussion The methods in this informal protocol will only be called if implemented by the delegate. */ @interface NSObject (GrowlApplicationBridgeDelegate_InformalProtocol) /*! * @method registrationDictionaryForGrowl * @abstract Return the dictionary used to register this application with Growl. * @discussion The returned dictionary gives Growl the complete list of * notifications this application will ever send, and it also specifies which * notifications should be enabled by default. Each is specified by an array * of NSString objects. * * For most applications, these two arrays can be the same (if all sent * notifications should be displayed by default). * * The NSString objects of these arrays will correspond to the * notificationName: parameter passed in * +[GrowlApplicationBridge * notifyWithTitle:description:notificationName:iconData:priority:isSticky:clickContext:] calls. * * The dictionary should have 2 key object pairs: * key: GROWL_NOTIFICATIONS_ALL object: NSArray of NSString objects * key: GROWL_NOTIFICATIONS_DEFAULT object: NSArray of NSString objects * * You do not need to implement this method if you have an auto-discoverable * plist file in your app bundle. (XXX refer to more information on that) * * @result The NSDictionary to use for registration. */ - (NSDictionary *) registrationDictionaryForGrowl; /*! * @method applicationNameForGrowl * @abstract Return the name of this application which will be used for Growl bookkeeping. * @discussion This name is used both internally and in the Growl preferences. * * This should remain stable between different versions and incarnations of * your application. * For example, "SurfWriter" is a good app name, whereas "SurfWriter 2.0" and * "SurfWriter Lite" are not. * * You do not need to implement this method if you are providing the * application name elsewhere, meaning in an auto-discoverable plist file in * your app bundle (XXX refer to more information on that) or in the result * of -registrationDictionaryForGrowl. * * @result The name of the application using Growl. */ - (NSString *) applicationNameForGrowl; /*! * @method applicationIconDataForGrowl * @abstract Return the NSData to treat as the application icon. * @discussion The delegate may optionally return an NSData * object to use as the application icon; if this is not implemented, the * application's own icon is used. This is not generally needed. * @result The NSData to treat as the application icon. */ - (NSData *) applicationIconDataForGrowl; /*! * @method growlIsReady * @abstract Informs the delegate that Growl has launched. * @discussion Informs the delegate that Growl (specifically, the * GrowlHelperApp) was launched successfully or was already running. The * application can take actions with the knowledge that Growl is installed and * functional. */ - (void) growlIsReady; /*! * @method growlNotificationWasClicked: * @abstract Informs the delegate that a Growl notification was clicked. * @discussion Informs the delegate that a Growl notification was clicked. It * is only sent for notifications sent with a non-nil * clickContext, so if you want to receive a message when a notification is * clicked, clickContext must not be nil when calling * +[GrowlApplicationBridge notifyWithTitle: description:notificationName:iconData:priority:isSticky:clickContext:]. * @param clickContext The clickContext passed when displaying the notification originally via +[GrowlApplicationBridge notifyWithTitle:description:notificationName:iconData:priority:isSticky:clickContext:]. */ - (void) growlNotificationWasClicked:(id)clickContext; /*! * @method growlNotificationTimedOut: * @abstract Informs the delegate that a Growl notification timed out. * @discussion Informs the delegate that a Growl notification timed out. It * is only sent for notifications sent with a non-nil * clickContext, so if you want to receive a message when a notification is * clicked, clickContext must not be nil when calling * +[GrowlApplicationBridge notifyWithTitle: description:notificationName:iconData:priority:isSticky:clickContext:]. * @param clickContext The clickContext passed when displaying the notification originally via +[GrowlApplicationBridge notifyWithTitle:description:notificationName:iconData:priority:isSticky:clickContext:]. */ - (void) growlNotificationTimedOut:(id)clickContext; @end #pragma mark - /*! * @category NSObject(GrowlApplicationBridgeDelegate_Installation_InformalProtocol) * @abstract Methods which may be optionally implemented by the Growl delegate when used with Growl-WithInstaller.framework. * @discussion The methods in this informal protocol will only be called if * implemented by the delegate. They allow greater control of the information * presented to the user when installing or upgrading Growl from within your * application when using Growl-WithInstaller.framework. */ @interface NSObject (GrowlApplicationBridgeDelegate_Installation_InformalProtocol) /*! * @method growlInstallationWindowTitle * @abstract Return the title of the installation window. * @discussion If not implemented, Growl will use a default, localized title. * @result An NSString object to use as the title. */ - (NSString *)growlInstallationWindowTitle; /*! * @method growlUpdateWindowTitle * @abstract Return the title of the upgrade window. * @discussion If not implemented, Growl will use a default, localized title. * @result An NSString object to use as the title. */ - (NSString *)growlUpdateWindowTitle; /*! * @method growlInstallationInformation * @abstract Return the information to display when installing. * @discussion This information may be as long or short as desired (the window * will be sized to fit it). It will be displayed to the user as an * explanation of what Growl is and what it can do in your application. It * should probably note that no download is required to install. * * If this is not implemented, Growl will use a default, localized explanation. * @result An NSAttributedString object to display. */ - (NSAttributedString *)growlInstallationInformation; /*! * @method growlUpdateInformation * @abstract Return the information to display when upgrading. * @discussion This information may be as long or short as desired (the window * will be sized to fit it). It will be displayed to the user as an * explanation that an updated version of Growl is included in your * application and no download is required. * * If this is not implemented, Growl will use a default, localized explanation. * @result An NSAttributedString object to display. */ - (NSAttributedString *)growlUpdateInformation; @end //private @interface GrowlApplicationBridge (GrowlInstallationPrompt_private) + (void) _userChoseNotToInstallGrowl; @end #endif /* __GrowlApplicationBridge_h__ */ unison-2.32.52/uimacnew/Growl.framework/Versions/A/Headers/GrowlDefines.h0000644000076500000000000003255111176730177025654 0ustar bcpiercewheel// // GrowlDefines.h // #ifndef _GROWLDEFINES_H #define _GROWLDEFINES_H #ifdef __OBJC__ #define XSTR(x) (@x) #define STRING NSString * #else #define XSTR CFSTR #define STRING CFStringRef #endif /*! @header GrowlDefines.h * @abstract Defines all the notification keys. * @discussion Defines all the keys used for registration with Growl and for * Growl notifications. * * Most applications should use the functions or methods of Growl.framework * instead of posting notifications such as those described here. * @updated 2004-01-25 */ // UserInfo Keys for Registration #pragma mark UserInfo Keys for Registration /*! @group Registration userInfo keys */ /* @abstract Keys for the userInfo dictionary of a GROWL_APP_REGISTRATION distributed notification. * @discussion The values of these keys describe the application and the * notifications it may post. * * Your application must register with Growl before it can post Growl * notifications (and have them not be ignored). However, as of Growl 0.6, * posting GROWL_APP_REGISTRATION notifications directly is no longer the * preferred way to register your application. Your application should instead * use Growl.framework's delegate system. * See +[GrowlApplicationBridge setGrowlDelegate:] or Growl_SetDelegate for * more information. */ /*! @defined GROWL_APP_NAME * @abstract The name of your application. * @discussion The name of your application. This should remain stable between * different versions and incarnations of your application. * For example, "SurfWriter" is a good app name, whereas "SurfWriter 2.0" and * "SurfWriter Lite" are not. */ #define GROWL_APP_NAME XSTR("ApplicationName") /*! @defined GROWL_APP_ICON * @abstract The image data for your application's icon. * @discussion Image data representing your application's icon. This may be * superimposed on a notification icon as a badge, used as the notification * icon when a notification-specific icon is not supplied, or ignored * altogether, depending on the display. Must be in a format supported by * NSImage, such as TIFF, PNG, GIF, JPEG, BMP, PICT, or PDF. * * Optional. Not supported by all display plugins. */ #define GROWL_APP_ICON XSTR("ApplicationIcon") /*! @defined GROWL_NOTIFICATIONS_DEFAULT * @abstract The array of notifications to turn on by default. * @discussion These are the names of the notifications that should be enabled * by default when your application registers for the first time. If your * application reregisters, Growl will look here for any new notification * names found in GROWL_NOTIFICATIONS_ALL, but ignore any others. */ #define GROWL_NOTIFICATIONS_DEFAULT XSTR("DefaultNotifications") /*! @defined GROWL_NOTIFICATIONS_ALL * @abstract The array of all notifications your application can send. * @discussion These are the names of all of the notifications that your * application may post. See GROWL_NOTIFICATION_NAME for a discussion of good * notification names. */ #define GROWL_NOTIFICATIONS_ALL XSTR("AllNotifications") /*! @defined GROWL_TICKET_VERSION * @abstract The version of your registration ticket. * @discussion Include this key in a ticket plist file that you put in your * application bundle for auto-discovery. The current ticket version is 1. */ #define GROWL_TICKET_VERSION XSTR("TicketVersion") // UserInfo Keys for Notifications #pragma mark UserInfo Keys for Notifications /*! @group Notification userInfo keys */ /* @abstract Keys for the userInfo dictionary of a GROWL_NOTIFICATION distributed notification. * @discussion The values of these keys describe the content of a Growl * notification. * * Not all of these keys are supported by all displays. Only the name, title, * and description of a notification are universal. Most of the built-in * displays do support all of these keys, and most other visual displays * probably will also. But, as of 0.6, the Log, MailMe, and Speech displays * support only textual data. */ /*! @defined GROWL_NOTIFICATION_NAME * @abstract The name of the notification. * @discussion The name of the notification. This should be human-readable, as * it's shown in the prefpane, in the list of notifications your application * supports. */ #define GROWL_NOTIFICATION_NAME XSTR("NotificationName") /*! @defined GROWL_NOTIFICATION_TITLE * @abstract The title to display in the notification. * @discussion The title of the notification. Should be very brief. * The title usually says what happened, e.g. "Download complete". */ #define GROWL_NOTIFICATION_TITLE XSTR("NotificationTitle") /*! @defined GROWL_NOTIFICATION_DESCRIPTION * @abstract The description to display in the notification. * @discussion The description should be longer and more verbose than the title. * The description usually tells the subject of the action, * e.g. "Growl-0.6.dmg downloaded in 5.02 minutes". */ #define GROWL_NOTIFICATION_DESCRIPTION XSTR("NotificationDescription") /*! @defined GROWL_NOTIFICATION_ICON * @discussion Image data for the notification icon. Must be in a format * supported by NSImage, such as TIFF, PNG, GIF, JPEG, BMP, PICT, or PDF. * * Optional. Not supported by all display plugins. */ #define GROWL_NOTIFICATION_ICON XSTR("NotificationIcon") /*! @defined GROWL_NOTIFICATION_APP_ICON * @discussion Image data for the application icon, in case GROWL_APP_ICON does * not apply for some reason. Must be in a format supported by NSImage, such * as TIFF, PNG, GIF, JPEG, BMP, PICT, or PDF. * * Optional. Not supported by all display plugins. */ #define GROWL_NOTIFICATION_APP_ICON XSTR("NotificationAppIcon") /*! @defined GROWL_NOTIFICATION_PRIORITY * @discussion The priority of the notification as an integer number from * -2 to +2 (+2 being highest). * * Optional. Not supported by all display plugins. */ #define GROWL_NOTIFICATION_PRIORITY XSTR("NotificationPriority") /*! @defined GROWL_NOTIFICATION_STICKY * @discussion A Boolean number controlling whether the notification is sticky. * * Optional. Not supported by all display plugins. */ #define GROWL_NOTIFICATION_STICKY XSTR("NotificationSticky") /*! @defined GROWL_NOTIFICATION_CLICK_CONTEXT * @abstract Identifies which notification was clicked. * @discussion An identifier for the notification for clicking purposes. * * This will be passed back to the application when the notification is * clicked. It must be plist-encodable (a data, dictionary, array, number, or * string object), and it should be unique for each notification you post. * A good click context would be a UUID string returned by NSProcessInfo or * CFUUID. * * Optional. Not supported by all display plugins. */ #define GROWL_NOTIFICATION_CLICK_CONTEXT XSTR("NotificationClickContext") /*! @defined GROWL_DISPLAY_PLUGIN * @discussion The name of a display plugin which should be used for this notification. * Optional. If this key is not set or the specified display plugin does not * exist, the display plugin stored in the application ticket is used. This key * allows applications to use different default display plugins for their * notifications. The user can still override those settings in the preference * pane. */ #define GROWL_DISPLAY_PLUGIN XSTR("NotificationDisplayPlugin") /*! @defined GROWL_NOTIFICATION_IDENTIFIER * @abstract An identifier for the notification for coalescing purposes. * Notifications with the same identifier fall into the same class; only * the last notification of a class is displayed on the screen. If a * notification of the same class is currently being displayed, it is * replaced by this notification. * * Optional. Not supported by all display plugins. */ #define GROWL_NOTIFICATION_IDENTIFIER XSTR("GrowlNotificationIdentifier") /*! @defined GROWL_APP_PID * @abstract The process identifier of the process which sends this * notification. If this field is set, the application will only receive * clicked and timed out notifications which originate from this process. * * Optional. */ #define GROWL_APP_PID XSTR("ApplicationPID") // Notifications #pragma mark Notifications /*! @group Notification names */ /* @abstract Names of distributed notifications used by Growl. * @discussion These are notifications used by applications (directly or * indirectly) to interact with Growl, and by Growl for interaction between * its components. * * Most of these should no longer be used in Growl 0.6 and later, in favor of * Growl.framework's GrowlApplicationBridge APIs. */ /*! @defined GROWL_APP_REGISTRATION * @abstract The distributed notification for registering your application. * @discussion This is the name of the distributed notification that can be * used to register applications with Growl. * * The userInfo dictionary for this notification can contain these keys: *
    *
  • GROWL_APP_NAME
    • *
  • GROWL_APP_ICON
    • *
  • GROWL_NOTIFICATIONS_ALL
    • *
  • GROWL_NOTIFICATIONS_DEFAULT
    • *
* * No longer recommended as of Growl 0.6. An alternate method of registering * is to use Growl.framework's delegate system. * See +[GrowlApplicationBridge setGrowlDelegate:] or Growl_SetDelegate for * more information. */ #define GROWL_APP_REGISTRATION XSTR("GrowlApplicationRegistrationNotification") /*! @defined GROWL_APP_REGISTRATION_CONF * @abstract The distributed notification for confirming registration. * @discussion The name of the distributed notification sent to confirm the * registration. Used by the Growl preference pane. Your application probably * does not need to use this notification. */ #define GROWL_APP_REGISTRATION_CONF XSTR("GrowlApplicationRegistrationConfirmationNotification") /*! @defined GROWL_NOTIFICATION * @abstract The distributed notification for Growl notifications. * @discussion This is what it all comes down to. This is the name of the * distributed notification that your application posts to actually send a * Growl notification. * * The userInfo dictionary for this notification can contain these keys: *
    *
  • GROWL_NOTIFICATION_NAME (required)
    • *
  • GROWL_NOTIFICATION_TITLE (required)
    • *
  • GROWL_NOTIFICATION_DESCRIPTION (required)
    • *
  • GROWL_NOTIFICATION_ICON
    • *
  • GROWL_NOTIFICATION_APP_ICON
    • *
  • GROWL_NOTIFICATION_PRIORITY
    • *
  • GROWL_NOTIFICATION_STICKY
    • *
  • GROWL_NOTIFICATION_CLICK_CONTEXT
    • *
  • GROWL_APP_NAME (required)
    • *
* * No longer recommended as of Growl 0.6. Three alternate methods of posting * notifications are +[GrowlApplicationBridge notifyWithTitle:description:notificationName:iconData:priority:isSticky:clickContext:], * Growl_NotifyWithTitleDescriptionNameIconPriorityStickyClickContext, and * Growl_PostNotification. */ #define GROWL_NOTIFICATION XSTR("GrowlNotification") /*! @defined GROWL_SHUTDOWN * @abstract The distributed notification name that tells Growl to shutdown. * @discussion The Growl preference pane posts this notification when the * "Stop Growl" button is clicked. */ #define GROWL_SHUTDOWN XSTR("GrowlShutdown") /*! @defined GROWL_PING * @abstract A distributed notification to check whether Growl is running. * @discussion This is used by the Growl preference pane. If it receives a * GROWL_PONG, the preference pane takes this to mean that Growl is running. */ #define GROWL_PING XSTR("Honey, Mind Taking Out The Trash") /*! @defined GROWL_PONG * @abstract The distributed notification sent in reply to GROWL_PING. * @discussion GrowlHelperApp posts this in reply to GROWL_PING. */ #define GROWL_PONG XSTR("What Do You Want From Me, Woman") /*! @defined GROWL_IS_READY * @abstract The distributed notification sent when Growl starts up. * @discussion GrowlHelperApp posts this when it has begin listening on all of * its sources for new notifications. GrowlApplicationBridge (in * Growl.framework), upon receiving this notification, reregisters using the * registration dictionary supplied by its delegate. */ #define GROWL_IS_READY XSTR("Lend Me Some Sugar; I Am Your Neighbor!") /*! @defined GROWL_NOTIFICATION_CLICKED * @abstract The distributed notification sent when a supported notification is clicked. * @discussion When a Growl notification with a click context is clicked on by * the user, Growl posts this distributed notification. * The GrowlApplicationBridge responds to this notification by calling a * callback in its delegate. */ #define GROWL_NOTIFICATION_CLICKED XSTR("GrowlClicked!") #define GROWL_NOTIFICATION_TIMED_OUT XSTR("GrowlTimedOut!") /*! @group Other symbols */ /* Symbols which don't fit into any of the other categories. */ /*! @defined GROWL_KEY_CLICKED_CONTEXT * @abstract Used internally as the key for the clickedContext passed over DNC. * @discussion This key is used in GROWL_NOTIFICATION_CLICKED, and contains the * click context that was supplied in the original notification. */ #define GROWL_KEY_CLICKED_CONTEXT XSTR("ClickedContext") /*! @defined GROWL_REG_DICT_EXTENSION * @abstract The filename extension for registration dictionaries. * @discussion The GrowlApplicationBridge in Growl.framework registers with * Growl by creating a file with the extension of .(GROWL_REG_DICT_EXTENSION) * and opening it in the GrowlHelperApp. This happens whether or not Growl is * running; if it was stopped, it quits immediately without listening for * notifications. */ #define GROWL_REG_DICT_EXTENSION XSTR("growlRegDict") #endif //ndef _GROWLDEFINES_H unison-2.32.52/uimacnew/Growl.framework/Versions/A/Resources/0000755000076500000000000000000011222164527023474 5ustar bcpiercewheelunison-2.32.52/uimacnew/Growl.framework/Versions/A/Resources/Info.plist0000644000076500000000000000135311176730177025456 0ustar bcpiercewheel CFBundleDevelopmentRegion English CFBundleExecutable Growl CFBundleIdentifier com.growl.growlframework CFBundleInfoDictionaryVersion 6.0 CFBundlePackageType FMWK CFBundleShortVersionString 0.7.3 CFBundleSignature GRRR CFBundleVersion 0.7.3 NSPrincipalClass GrowlApplicationBridge unison-2.32.52/uimacnew/Growl.framework/Versions/Current0000755000076500000000000000000011222164527023003 2Austar bcpiercewheelunison-2.32.52/uimacnew/ImageAndTextCell.h0000644000076500000000000000053511176730177017742 0ustar bcpiercewheel// // ImageAndTextCell.h // // Copyright (c) 2001-2002, Apple. All rights reserved. // #import @interface ImageAndTextCell : NSTextFieldCell { @private NSImage *image; } - (void)setImage:(NSImage *)anImage; - (NSImage *)image; - (void)drawWithFrame:(NSRect)cellFrame inView:(NSView *)controlView; - (NSSize)cellSize; @end unison-2.32.52/uimacnew/ImageAndTextCell.m0000644000076500000000000001220111176730177017740 0ustar bcpiercewheel/* ImageAndTextCell.m Copyright (c) 2001-2004, Apple Computer, Inc., all rights reserved. Author: Chuck Pisula Milestones: Initially created 3/1/01 Subclass of NSTextFieldCell which can display text and an image simultaneously. */ /* IMPORTANT: This Apple software is supplied to you by Apple Computer, Inc. ("Apple") in consideration of your agreement to the following terms, and your use, installation, modification or redistribution of this Apple software constitutes acceptance of these terms. If you do not agree with these terms, please do not use, install, modify or redistribute this Apple software. In consideration of your agreement to abide by the following terms, and subject to these terms, Apple grants you a personal, non-exclusive license, under Apples copyrights in this original Apple software (the "Apple Software"), to use, reproduce, modify and redistribute the Apple Software, with or without modifications, in source and/or binary forms; provided that if you redistribute the Apple Software in its entirety and without modifications, you must retain this notice and the following text and disclaimers in all such redistributions of the Apple Software. Neither the name, trademarks, service marks or logos of Apple Computer, Inc. may be used to endorse or promote products derived from the Apple Software without specific prior written permission from Apple. Except as expressly stated in this notice, no other rights or licenses, express or implied, are granted by Apple herein, including but not limited to any patent rights that may be infringed by your derivative works or by other works in which the Apple Software may be incorporated. The Apple Software is provided by Apple on an "AS IS" basis. APPLE MAKES NO WARRANTIES, EXPRESS OR IMPLIED, INCLUDING WITHOUT LIMITATION THE IMPLIED WARRANTIES OF NON-INFRINGEMENT, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE, REGARDING THE APPLE SOFTWARE OR ITS USE AND OPERATION ALONE OR IN COMBINATION WITH YOUR PRODUCTS. IN NO EVENT SHALL APPLE BE LIABLE FOR ANY SPECIAL, INDIRECT, INCIDENTAL OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) ARISING IN ANY WAY OUT OF THE USE, REPRODUCTION, MODIFICATION AND/OR DISTRIBUTION OF THE APPLE SOFTWARE, HOWEVER CAUSED AND WHETHER UNDER THEORY OF CONTRACT, TORT (INCLUDING NEGLIGENCE), STRICT LIABILITY OR OTHERWISE, EVEN IF APPLE HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ #import "ImageAndTextCell.h" @implementation ImageAndTextCell - (void)dealloc { [image release]; image = nil; [super dealloc]; } - copyWithZone:(NSZone *)zone { ImageAndTextCell *cell = (ImageAndTextCell *)[super copyWithZone:zone]; cell->image = [image retain]; return cell; } - (void)setImage:(NSImage *)anImage { if (anImage != image) { [image release]; image = [anImage retain]; } } - (NSImage *)image { return image; } - (NSRect)imageFrameForCellFrame:(NSRect)cellFrame { if (image != nil) { NSRect imageFrame; imageFrame.size = [image size]; imageFrame.origin = cellFrame.origin; imageFrame.origin.x += 3; imageFrame.origin.y += ceil((cellFrame.size.height - imageFrame.size.height) / 2); return imageFrame; } else return NSZeroRect; } - (void)editWithFrame:(NSRect)aRect inView:(NSView *)controlView editor:(NSText *)textObj delegate:(id)anObject event:(NSEvent *)theEvent { NSRect textFrame, imageFrame; NSDivideRect (aRect, &imageFrame, &textFrame, 3 + [image size].width, NSMinXEdge); [super editWithFrame: textFrame inView: controlView editor:textObj delegate:anObject event: theEvent]; } - (void)selectWithFrame:(NSRect)aRect inView:(NSView *)controlView editor:(NSText *)textObj delegate:(id)anObject start:(int)selStart length:(int)selLength { NSRect textFrame, imageFrame; NSDivideRect (aRect, &imageFrame, &textFrame, 3 + [image size].width, NSMinXEdge); [super selectWithFrame: textFrame inView: controlView editor:textObj delegate:anObject start:selStart length:selLength]; } - (void)drawWithFrame:(NSRect)cellFrame inView:(NSView *)controlView { if (image != nil) { NSSize imageSize; NSRect imageFrame; imageSize = [image size]; NSDivideRect(cellFrame, &imageFrame, &cellFrame, 3 + imageSize.width, NSMinXEdge); if ([self drawsBackground]) { [[self backgroundColor] set]; NSRectFill(imageFrame); } imageFrame.origin.x += 3; imageFrame.size = imageSize; if ([controlView isFlipped]) imageFrame.origin.y += ceil((cellFrame.size.height + imageFrame.size.height) / 2); else imageFrame.origin.y += ceil((cellFrame.size.height - imageFrame.size.height) / 2); [image compositeToPoint:imageFrame.origin operation:NSCompositeSourceOver]; } [super drawWithFrame:cellFrame inView:controlView]; } - (NSSize)cellSize { NSSize cellSize = [super cellSize]; cellSize.width += (image ? [image size].width : 0) + 3; return cellSize; } @end unison-2.32.52/uimacnew/Info.plist0000644000076500000000000000204711176730177016427 0ustar bcpiercewheel CFBundleName Unison CFBundleDevelopmentRegion English CFBundleExecutable Unison CFBundleIconFile Unison.icns CFBundleIdentifier edu.upenn.cis.Unison CFBundleInfoDictionaryVersion 6.0 CFBundlePackageType APPL CFBundleSignature ???? CFBundleShortVersionString $(MARKETING_VERSION) CFBundleGetInfoString ${MARKETING_VERSION}, ©1999-2007, licensed under GNU GPL. NSHumanReadableCopyright ©1999-2006, licensed under GNU GPL. NSMainNibFile MainMenu NSPrincipalClass NSApplication unison-2.32.52/uimacnew/Info.plist.template0000644000076500000000000000211711176730177020237 0ustar bcpiercewheel CFBundleName Unison CFBundleDevelopmentRegion English CFBundleExecutable Unison CFBundleIconFile Unison.icns CFBundleIdentifier edu.upenn.cis.Unison CFBundleInfoDictionaryVersion 6.0 CFBundlePackageType APPL CFBundleSignature ???? CFBundleVersion @@VERSION@@ CFBundleShortVersionString @@VERSION@@ CFBundleGetInfoString @@VERSION@@. ©1999-2007, licensed under GNU GPL. NSHumanReadableCopyright ©1999-2006, licensed under GNU GPL. NSMainNibFile MainMenu NSPrincipalClass NSApplication unison-2.32.52/uimacnew/main.m0000644000076500000000000000342311176730177015560 0ustar bcpiercewheel// // main.m // uimac // // Created by Trevor Jim on Sun Aug 17 2003. // Copyright (c) 2003, see file COPYING for details. // #import #import "Bridge.h" int main(int argc, const char *argv[]) { int i; /* When you click-start or use the open command, the program is invoked with a command-line arg of the form -psn_XXXXXXXXX. The XXXXXXXX is a "process serial number" and it seems to be important for Carbon programs. We need to get rid of it if it's there so the ocaml code won't exit. Note, the extra arg is not added if the binary is invoked directly from the command line without using the open command. */ if (argc == 2 && strncmp(argv[1],"-psn_",5) == 0) { argc--; argv[1] = NULL; } [Bridge startup:argv]; /* Check for invocations that don't start up the gui */ for (i=1; i @class ProfileController, PreferencesController, NotificationController, ReconItem, ParentReconItem, ReconTableView, UnisonToolbar, OCamlValue; @interface MyController : NSObject { IBOutlet NSWindow *mainWindow; UnisonToolbar *toolbar; IBOutlet NSWindow *cltoolWindow; IBOutlet NSButton *cltoolPref; IBOutlet ProfileController *profileController; IBOutlet NSView *chooseProfileView; NSString *myProfile; IBOutlet PreferencesController *preferencesController; IBOutlet NSView *preferencesView; IBOutlet NSView *updatesView; IBOutlet NSView *ConnectingView; NSView *blankView; IBOutlet ReconTableView *tableView; IBOutlet NSTextField *updatesText; IBOutlet NSTextView *detailsTextView; IBOutlet NSTextField *statusText; IBOutlet NSWindow *passwordWindow; IBOutlet NSTextField *passwordPrompt; IBOutlet NSTextField *passwordText; IBOutlet NSButton *passwordCancelButton; BOOL waitingForPassword; IBOutlet NSWindow *aboutWindow; IBOutlet NSTextField *versionText; IBOutlet NSProgressIndicator *progressBar; IBOutlet NotificationController *notificationController; BOOL syncable; BOOL duringSync; BOOL afterSync; NSMutableArray *reconItems; ParentReconItem *rootItem; OCamlValue *preconn; BOOL doneFirstDiff; IBOutlet NSWindow *diffWindow; IBOutlet NSTextView *diffView; IBOutlet NSSegmentedControl *tableModeSelector; } - (id)init; - (void)awakeFromNib; - (void)chooseProfiles; - (IBAction)createButton:(id)sender; - (IBAction)saveProfileButton:(id)sender; - (IBAction)cancelProfileButton:(id)sender; - (NSString *)profile; - (void)profileSelected:(NSString *)aProfile; - (IBAction)restartButton:(id)sender; - (IBAction)rescan:(id)sender; - (IBAction)openButton:(id)sender; - (void)connect:(NSString *)profileName; - (void)raisePasswordWindow:(NSString *)prompt; - (void)controlTextDidEndEditing:(NSNotification *)notification; - (IBAction)endPasswordWindow:(id)sender; - (void)afterOpen; - (IBAction)syncButton:(id)sender; - (IBAction)tableModeChanged:(id)sender; - (void)initTableMode; - (NSMutableArray *)reconItems; - (void)updateForChangedItems; - (void)updateReconItems:(OCamlValue *)items; - (id)updateForIgnore:(id)i; - (void)statusTextSet:(NSString *)s; - (void)diffViewTextSet:(NSString *)title bodyText:(NSString *)body; - (void)displayDetails:(ReconItem *)item; - (void)clearDetails; - (IBAction)raiseCltoolWindow:(id)sender; - (IBAction)cltoolYesButton:(id)sender; - (IBAction)cltoolNoButton:(id)sender; - (IBAction)raiseAboutWindow:(id)sender; - (IBAction)raiseWindow:(NSWindow *)theWindow; - (IBAction)onlineHelp:(id)sender; - (IBAction)installCommandLineTool:(id)sender; - (BOOL)validateItem:(IBAction *) action; - (BOOL)validateMenuItem:(NSMenuItem *)menuItem; - (BOOL)validateToolbarItem:(NSToolbarItem *)toolbarItem; - (void)resizeWindowToSize:(NSSize)newSize; - (float)toolbarHeightForWindow:(NSWindow *)window; @end unison-2.32.52/uimacnew/MyController.m0000644000076500000000000007544211176730177017277 0ustar bcpiercewheel/* Copyright (c) 2003, see file COPYING for details. */ #import "MyController.h" #import "ProfileController.h" #import "PreferencesController.h" #import "NotificationController.h" #import "ReconItem.h" #import "ReconTableView.h" #import "UnisonToolbar.h" #import "ImageAndTextCell.h" #import "ProgressCell.h" #import "Bridge.h" #define CAML_NAME_SPACE #include #include #include #include @interface NSString (_UnisonUtil) - (NSString *)trim; @end @implementation MyController static MyController *me; // needed by reloadTable and displayStatus, below static int unset = 0; static int dontAsk = 1; static int doAsk = 2; - (id)init { if (([super init])) { /* Initialize locals */ me = self; doneFirstDiff = NO; /* By default, invite user to install cltool */ int pref = [[NSUserDefaults standardUserDefaults] integerForKey:@"CheckCltool"]; if (pref==unset) [[NSUserDefaults standardUserDefaults] setInteger:doAsk forKey:@"CheckCltool"]; } return self; } - (void)awakeFromNib { // Window positioning NSRect screenFrame = [[mainWindow screen] visibleFrame]; [mainWindow cascadeTopLeftFromPoint: NSMakePoint(screenFrame.origin.x, screenFrame.origin.y+screenFrame.size.height)]; blankView = [[NSView alloc] init]; /* Double clicking in the profile list will open the profile */ [[profileController tableView] setTarget:self]; [[profileController tableView] setDoubleAction:@selector(openButton:)]; [tableView setAutoresizesOutlineColumn:NO]; // use combo-cell for path [[tableView tableColumnWithIdentifier:@"path"] setDataCell:[[[ImageAndTextCell alloc] init] autorelease]]; // Custom progress cell ProgressCell *progressCell = [[ProgressCell alloc] init]; [[tableView tableColumnWithIdentifier:@"percentTransferred"] setDataCell:progressCell]; /* Set up the version string in the about box. We use a custom about box just because PRCS doesn't seem capable of getting the version into the InfoPlist.strings file; otherwise we'd use the standard about box. */ [versionText setStringValue:ocamlCall("S", "unisonGetVersion")]; /* Command-line processing */ OCamlValue *clprofile = (id)ocamlCall("@", "unisonInit0"); /* Add toolbar */ toolbar = [[[UnisonToolbar alloc] initWithIdentifier: @"unisonToolbar" :self :tableView] autorelease]; [mainWindow setToolbar: toolbar]; [toolbar takeTableModeView:tableModeSelector]; [self initTableMode]; /* Set up the first window the user will see */ if (clprofile) { /* A profile name was given on the command line */ NSString *profileName = [clprofile getField:0 withType:'S']; [self profileSelected:profileName]; /* If invoked from terminal we need to bring the app to the front */ [NSApp activateIgnoringOtherApps:YES]; /* Start the connection */ [self connect:profileName]; } else { /* If invoked from terminal we need to bring the app to the front */ [NSApp activateIgnoringOtherApps:YES]; /* Bring up the dialog to choose a profile */ [self chooseProfiles]; } [mainWindow display]; [mainWindow makeKeyAndOrderFront:nil]; /* unless user has clicked Don't ask me again, ask about cltool */ if ( ([[NSUserDefaults standardUserDefaults] integerForKey:@"CheckCltool"]==doAsk) && (![[NSFileManager defaultManager] fileExistsAtPath:@"/usr/bin/unison"]) ) [self raiseCltoolWindow:nil]; } - (void)chooseProfiles { [mainWindow setContentView:blankView]; [self resizeWindowToSize:[chooseProfileView frame].size]; [mainWindow setContentMinSize: NSMakeSize(NSWidth([[mainWindow contentView] frame]),150)]; [mainWindow setContentMaxSize:NSMakeSize(FLT_MAX, FLT_MAX)]; [mainWindow setContentView:chooseProfileView]; [toolbar setView:@"chooseProfileView"]; [mainWindow setTitle:@"Unison"]; // profiles get keyboard input [mainWindow makeFirstResponder:[profileController tableView]]; [chooseProfileView display]; } - (IBAction)createButton:(id)sender { [preferencesController reset]; [mainWindow setContentView:blankView]; [self resizeWindowToSize:[preferencesView frame].size]; [mainWindow setContentMinSize: NSMakeSize(400,NSHeight([[mainWindow contentView] frame]))]; [mainWindow setContentMaxSize: NSMakeSize(FLT_MAX,NSHeight([[mainWindow contentView] frame]))]; [mainWindow setContentView:preferencesView]; [toolbar setView:@"preferencesView"]; } - (IBAction)saveProfileButton:(id)sender { if ([preferencesController validatePrefs]) { // so the list contains the new profile [profileController initProfiles]; [self chooseProfiles]; } } - (IBAction)cancelProfileButton:(id)sender { [self chooseProfiles]; } /* Only valid once a profile has been selected */ - (NSString *)profile { return myProfile; } - (void)profileSelected:(NSString *)aProfile { [aProfile retain]; [myProfile release]; myProfile = aProfile; [mainWindow setTitle: [NSString stringWithFormat:@"Unison: %@", myProfile]]; } - (IBAction)restartButton:(id)sender { [tableView setEditable:NO]; [self chooseProfiles]; } - (IBAction)rescan:(id)sender { /* There is a delay between turning off the button and it actually being disabled. Make sure we don't respond. */ if ([self validateItem:@selector(rescan:)]) { waitingForPassword = NO; [self afterOpen]; } } - (IBAction)openButton:(id)sender { NSString *profile = [profileController selected]; [self profileSelected:profile]; [self connect:profile]; return; } - (void)updateToolbar { [toolbar validateVisibleItems]; [tableModeSelector setEnabled:((syncable && !duringSync) || afterSync)]; // Why? [updatesView setNeedsDisplay:YES]; } - (void)updateTableViewWithReset:(BOOL)shouldResetSelection { [tableView reloadData]; if (shouldResetSelection) { [tableView selectRow:0 byExtendingSelection:NO]; shouldResetSelection = NO; } [updatesView setNeedsDisplay:YES]; } - (void)updateProgressBar:(NSNumber *)newProgress { // NSLog(@"Updating progress bar: %i - %i", (int)[newProgress doubleValue], (int)[progressBar doubleValue]); [progressBar incrementBy:([newProgress doubleValue] - [progressBar doubleValue])]; } - (void)updateTableViewSelection { int n = [tableView numberOfSelectedRows]; if (n == 1) [self displayDetails:[tableView itemAtRow:[tableView selectedRow]]]; else [self clearDetails]; } - (void)outlineViewSelectionDidChange:(NSNotification *)note { [self updateTableViewSelection]; } - (void)connect:(NSString *)profileName { // contact server, propagate prefs NSLog(@"Connecting to %@...", profileName); // Switch to ConnectingView [mainWindow setContentView:blankView]; [self resizeWindowToSize:[updatesView frame].size]; [mainWindow setContentMinSize:NSMakeSize(150,150)]; [mainWindow setContentMaxSize:NSMakeSize(FLT_MAX, FLT_MAX)]; [mainWindow setContentView:ConnectingView]; [toolbar setView:@"connectingView"]; // Update (almost) immediately [ConnectingView display]; syncable = NO; afterSync = NO; [self updateToolbar]; // will spawn thread on OCaml side and callback when complete (void)ocamlCall("xS", "unisonInit1", profileName); } CAMLprim value unisonInit1Complete(value v) { if (v == Val_unit) { NSLog(@"Connected."); [me->preconn release]; me->preconn = NULL; [me performSelectorOnMainThread:@selector(afterOpen:) withObject:nil waitUntilDone:FALSE]; } else { // prompting required me->preconn = [[OCamlValue alloc] initWithValue:Field(v,0)]; // value of Some [me performSelectorOnMainThread:@selector(unisonInit1Complete:) withObject:nil waitUntilDone:FALSE]; } return Val_unit; } - (void)unisonInit1Complete:(id)ignore { @try { OCamlValue *prompt = ocamlCall("@@", "openConnectionPrompt", preconn); if (!prompt) { // turns out, no prompt needed, but must finish opening connection ocamlCall("x@", "openConnectionEnd", preconn); NSLog(@"Connected."); waitingForPassword = NO; [self afterOpen]; return; } waitingForPassword = YES; [self raisePasswordWindow:[prompt getField:0 withType:'S']]; } @catch (NSException *ex) { NSRunAlertPanel(@"Connection Error", [ex description], @"OK", nil, nil); [self chooseProfiles]; return; } NSLog(@"Connected."); } - (void)raisePasswordWindow:(NSString *)prompt { // FIX: some prompts don't ask for password, need to look at it NSLog(@"Got the prompt: '%@'",prompt); if ((int)ocamlCall("iS", "unisonPasswordMsg", prompt)) { [passwordPrompt setStringValue:@"Please enter your password"]; [NSApp beginSheet:passwordWindow modalForWindow:mainWindow modalDelegate:nil didEndSelector:nil contextInfo:nil]; return; } if ((int)ocamlCall("iS", "unisonPassphraseMsg", prompt)) { [passwordPrompt setStringValue:@"Please enter your passphrase"]; [NSApp beginSheet:passwordWindow modalForWindow:mainWindow modalDelegate:nil didEndSelector:nil contextInfo:nil]; return; } if ((int)ocamlCall("iS", "unisonAuthenticityMsg", prompt)) { int i = NSRunAlertPanel(@"New host",prompt,@"Yes",@"No",nil); if (i == NSAlertDefaultReturn) { ocamlCall("x@s", "openConnectionReply", preconn, "yes"); prompt = ocamlCall("S@", "openConnectionPrompt", preconn); if (!prompt) { // all done with prompts, finish opening connection ocamlCall("x@", "openConnectionEnd", preconn); waitingForPassword = NO; [self afterOpen]; return; } else { [self raisePasswordWindow:[NSString stringWithUTF8String:String_val(Field(prompt,0))]]; return; } } if (i == NSAlertAlternateReturn) { ocamlCall("x@", "openConnectionCancel", preconn); return; } else { NSLog(@"Unrecognized response '%d' from NSRunAlertPanel",i); ocamlCall("x@", "openConnectionCancel", preconn); return; } } NSLog(@"Unrecognized message from ssh: %@",prompt); ocamlCall("x@", "openConnectionCancel", preconn); } // The password window will invoke this when Enter occurs, b/c we // are the delegate. - (void)controlTextDidEndEditing:(NSNotification *)notification { NSNumber *reason = [[notification userInfo] objectForKey:@"NSTextMovement"]; int code = [reason intValue]; if (code == NSReturnTextMovement) [self endPasswordWindow:self]; } // Or, the Continue button will invoke this when clicked - (IBAction)endPasswordWindow:(id)sender { [passwordWindow orderOut:self]; [NSApp endSheet:passwordWindow]; if ([sender isEqualTo:passwordCancelButton]) { ocamlCall("x@", "openConnectionCancel", preconn); [self chooseProfiles]; return; } NSString *password = [passwordText stringValue]; ocamlCall("x@S", "openConnectionReply", preconn, password); OCamlValue *prompt = ocamlCall("@@", "openConnectionPrompt", preconn); if (!prompt) { // all done with prompts, finish opening connection ocamlCall("x@", "openConnectionEnd", preconn); waitingForPassword = NO; [self afterOpen]; } else { [self raisePasswordWindow:[prompt getField:0 withType:'S']]; } } - (void)afterOpen:(id)ignore { [self afterOpen]; } - (void)afterOpen { if (waitingForPassword) return; // move to updates window after clearing it [self updateReconItems:nil]; [progressBar setDoubleValue:0.0]; [progressBar stopAnimation:self]; // [self clearDetails]; [mainWindow setContentView:blankView]; [self resizeWindowToSize:[updatesView frame].size]; [mainWindow setContentMinSize: NSMakeSize(NSWidth([[mainWindow contentView] frame]),200)]; [mainWindow setContentMaxSize:NSMakeSize(FLT_MAX, FLT_MAX)]; [mainWindow setContentView:updatesView]; [toolbar setView:@"updatesView"]; syncable = NO; afterSync = NO; [tableView deselectAll:self]; [self updateToolbar]; [self updateProgressBar:[NSNumber numberWithDouble:0.0]]; // this should depend on the number of reconitems, and is now done // in updateReconItems: // reconItems table gets keyboard input //[mainWindow makeFirstResponder:tableView]; [tableView scrollRowToVisible:0]; [preconn release]; preconn = nil; // so old preconn can be garbage collected // This will run in another thread spawned in OCaml and will return immediately // We'll get a call back to unisonInit2Complete() when it is complete ocamlCall("x", "unisonInit2"); } - (void)afterUpdate:(id)retainedReconItems { // NSLog(@"In afterUpdate:..."); [self updateReconItems:retainedReconItems]; [retainedReconItems release]; [notificationController updateFinishedFor:[self profile]]; // label the left and right columns with the roots NSString *leftHost = [(NSString *)ocamlCall("S", "unisonFirstRootString") trim]; NSString *rightHost = [(NSString *)ocamlCall("S", "unisonSecondRootString") trim]; /* [[[tableView tableColumnWithIdentifier:@"left"] headerCell] setObjectValue:lefthost]; [[[tableView tableColumnWithIdentifier:@"right"] headerCell] setObjectValue:rightHost]; */ [mainWindow setTitle: [NSString stringWithFormat:@"Unison: %@ (%@ <-> %@)", [self profile], leftHost, rightHost]]; // initial sort [tableView setSortDescriptors:[NSArray arrayWithObjects: [[tableView tableColumnWithIdentifier:@"fileSizeString"] sortDescriptorPrototype], [[tableView tableColumnWithIdentifier:@"path"] sortDescriptorPrototype], nil]]; [self updateTableViewWithReset:([reconItems count] > 0)]; [self updateToolbar]; } CAMLprim value unisonInit2Complete(value v) { [me performSelectorOnMainThread:@selector(afterUpdate:) withObject:[[OCamlValue alloc] initWithValue:v] waitUntilDone:FALSE]; return Val_unit; } - (IBAction)syncButton:(id)sender { [tableView setEditable:NO]; syncable = NO; duringSync = YES; [self updateToolbar]; // This will run in another thread spawned in OCaml and will return immediately // We'll get a call back to syncComplete() when it is complete ocamlCall("x", "unisonSynchronize"); } - (void)afterSync:(id)ignore { [notificationController syncFinishedFor:[self profile]]; duringSync = NO; afterSync = YES; [self updateToolbar]; int i; for (i = 0; i < [reconItems count]; i++) { [[reconItems objectAtIndex:i] resetProgress]; } [self updateTableViewSelection]; [self updateTableViewWithReset:FALSE]; } CAMLprim value syncComplete() { [me performSelectorOnMainThread:@selector(afterSync:) withObject:nil waitUntilDone:FALSE]; return Val_unit; } // A function called from ocaml - (void)reloadTable:(NSNumber *)i { // NSLog(@"*** ReloadTable: %i", [i intValue]); [[reconItems objectAtIndex:[i intValue]] resetProgress]; [self updateTableViewWithReset:FALSE]; } CAMLprim value reloadTable(value row) { // NSLog(@"OCaml says... ReloadTable: %i", Int_val(row)); NSNumber *num = [[NSNumber alloc] initWithInt:Int_val(row)]; [me performSelectorOnMainThread:@selector(reloadTable:) withObject:num waitUntilDone:FALSE]; [num release]; return Val_unit; } - (int)outlineView:(NSOutlineView *)outlineView numberOfChildrenOfItem:(id)item { if (item == nil) item = rootItem; return [[item children] count]; } - (BOOL)outlineView:(NSOutlineView *)outlineView isItemExpandable:(id)item { return [item isKindOfClass:[ParentReconItem class]]; } - (id)outlineView:(NSOutlineView *)outlineView child:(int)index ofItem:(id)item { if (item == nil) item = rootItem; return [[item children] objectAtIndex:index]; } - (id)outlineView:(NSOutlineView *)outlineView objectValueForTableColumn:(NSTableColumn *)tableColumn byItem:(id)item { NSString *identifier = [tableColumn identifier]; if (item == nil) item = rootItem; if ([identifier isEqualToString:@"percentTransferred"] && (!duringSync && !afterSync)) return nil; return [item valueForKey:identifier]; } static NSDictionary *_SmallGreyAttributes = nil; - (void)outlineView:(NSOutlineView *)outlineView willDisplayCell:(NSCell *)cell forTableColumn:(NSTableColumn *)tableColumn item:(id)item { NSString *identifier = [tableColumn identifier]; if ([identifier isEqualToString:@"path"]) { // The file icon [(ImageAndTextCell*)cell setImage:[item fileIcon]]; // For parents, format the file count into the text int fileCount = [item fileCount]; if (fileCount > 1) { NSString *countString = [NSString stringWithFormat:@" (%i files)", fileCount]; NSString *fullString = [(NSString *)[cell objectValue] stringByAppendingString:countString]; NSMutableAttributedString *as = [[NSMutableAttributedString alloc] initWithString:fullString]; if (!_SmallGreyAttributes) { NSColor *txtColor = [NSColor grayColor]; NSFont *txtFont = [NSFont systemFontOfSize:9.0]; _SmallGreyAttributes = [[NSDictionary dictionaryWithObjectsAndKeys:txtFont, NSFontAttributeName, txtColor, NSForegroundColorAttributeName, nil] retain]; } [as setAttributes:_SmallGreyAttributes range:NSMakeRange([fullString length] - [countString length], [countString length])]; [cell setAttributedStringValue:as]; [as release]; } } else if ([identifier isEqualToString:@"percentTransferred"]) { [(ProgressCell*)cell setIcon:[item direction]]; [(ProgressCell*)cell setStatusString:[item progressString]]; [(ProgressCell*)cell setIsActive:[item isKindOfClass:[LeafReconItem class]]]; } } - (void)outlineView:(NSOutlineView *)outlineView sortDescriptorsDidChange:(NSArray *)oldDescriptors { NSArray *originalSelection = [outlineView selectedObjects]; // do we want to catch case of object changes to allow resort in same direction for progress / direction? // Could check if our objects change and if the first item at the head of new and old were the same [rootItem sortUsingDescriptors:[outlineView sortDescriptors]]; [outlineView reloadData]; [outlineView setSelectedObjects:originalSelection]; } // Delegate methods - (BOOL)outlineView:(NSOutlineView *)outlineView shouldEditTableColumn:(NSTableColumn *)tableColumn item:(id)item { return NO; } - (NSMutableArray *)reconItems // used in ReconTableView only { return reconItems; } - (int)tableMode { return [tableModeSelector selectedSegment]; } - (IBAction)tableModeChanged:(id)sender { [[NSUserDefaults standardUserDefaults] setInteger:[self tableMode]+1 forKey:@"TableLayout"]; [self updateForChangedItems]; } - (void)initTableMode { int mode = [[NSUserDefaults standardUserDefaults] integerForKey:@"TableLayout"] - 1; if (mode == -1) mode = 1; [tableModeSelector setSelectedSegment:mode]; } - (void)updateReconItems:(OCamlValue *)caml_reconItems { [reconItems release]; reconItems = [[NSMutableArray alloc] init]; int i, n =[caml_reconItems count]; for (i=0; i0) { [tableView setEditable:YES]; // reconItems table gets keyboard input [mainWindow makeFirstResponder:tableView]; syncable = YES; } else { [tableView setEditable:NO]; afterSync = YES; // rescan should be enabled // reconItems table no longer gets keyboard input [mainWindow makeFirstResponder:nil]; } [self updateToolbar]; } - (id)updateForIgnore:(id)item { int j = (int)ocamlCall("ii", "unisonUpdateForIgnore", [reconItems indexOfObjectIdenticalTo:item]); NSLog(@"Updating for ignore..."); [self updateReconItems:(OCamlValue *)ocamlCall("@", "unisonState")]; return [reconItems objectAtIndex:j]; } // A function called from ocaml CAMLprim value displayStatus(value s) { NSString *str = [[NSString alloc] initWithUTF8String:String_val(s)]; // NSLog(@"displayStatus: %@", str); [me performSelectorOnMainThread:@selector(statusTextSet:) withObject:str waitUntilDone:FALSE]; [str release]; return Val_unit; } - (void)statusTextSet:(NSString *)s { /* filter out strings with # reconitems, and empty strings */ if (!NSEqualRanges([s rangeOfString:@"reconitems"], NSMakeRange(NSNotFound,0))) return; [statusText setStringValue:s]; } // Called from ocaml to dislpay progress bar CAMLprim value displayGlobalProgress(value p) { NSNumber *num = [[NSNumber alloc] initWithDouble:Double_val(p)]; [me performSelectorOnMainThread:@selector(updateProgressBar:) withObject:num waitUntilDone:FALSE]; [num release]; return Val_unit; } // Called from ocaml to display diff CAMLprim value displayDiff(value s, value s2) { [me performSelectorOnMainThread:@selector(diffViewTextSet:) withObject:[NSArray arrayWithObjects:[NSString stringWithUTF8String:String_val(s)], [NSString stringWithUTF8String:String_val(s2)], nil] waitUntilDone:FALSE]; return Val_unit; } // Called from ocaml to display diff error messages CAMLprim value displayDiffErr(value s) { NSString * str = [NSString stringWithUTF8String:String_val(s)]; str = [[str componentsSeparatedByString:@"\n"] componentsJoinedByString:@" "]; [me->statusText performSelectorOnMainThread:@selector(setStringValue:) withObject:str waitUntilDone:FALSE]; return Val_unit; } - (void)diffViewTextSet:(NSArray *)args { [self diffViewTextSet:[args objectAtIndex:0] bodyText:[args objectAtIndex:1]]; } - (void)diffViewTextSet:(NSString *)title bodyText:(NSString *)body { if ([body length]==0) return; [diffWindow setTitle:title]; [diffView setFont:[NSFont fontWithName:@"Monaco" size:10]]; [diffView setString:body]; if (!doneFirstDiff) { /* On first open, position the diff window to the right of the main window, but without going off the mainwindow's screen */ float screenOriginX = [[mainWindow screen] visibleFrame].origin.x; float screenWidth = [[mainWindow screen] visibleFrame].size.width; float mainOriginX = [mainWindow frame].origin.x; float mainOriginY = [mainWindow frame].origin.y; float mainWidth = [mainWindow frame].size.width; float mainHeight = [mainWindow frame].size.height; float diffWidth = [diffWindow frame].size.width; float diffX = mainOriginX+mainWidth; float maxX = screenOriginX+screenWidth-diffWidth; if (diffX > maxX) diffX = maxX; float diffY = mainOriginY + mainHeight; NSPoint diffOrigin = NSMakePoint(diffX,diffY); [diffWindow cascadeTopLeftFromPoint:diffOrigin]; doneFirstDiff = YES; } [diffWindow orderFront:nil]; } - (void)displayDetails:(ReconItem *)item { [detailsTextView setFont:[NSFont fontWithName:@"Monaco" size:10]]; NSString *text = [item details]; if (!text) text = @""; [detailsTextView setString:text]; } - (void)clearDetails { [detailsTextView setString:@""]; } - (IBAction)raiseCltoolWindow:(id)sender { int pref = [[NSUserDefaults standardUserDefaults] integerForKey:@"CheckCltool"]; if (pref==doAsk) [cltoolPref setState:NSOffState]; else [cltoolPref setState:NSOnState]; [self raiseWindow: cltoolWindow]; } - (IBAction)cltoolYesButton:(id)sender; { if ([cltoolPref state]==NSOnState) [[NSUserDefaults standardUserDefaults] setInteger:dontAsk forKey:@"CheckCltool"]; else [[NSUserDefaults standardUserDefaults] setInteger:doAsk forKey:@"CheckCltool"]; [self installCommandLineTool:self]; [cltoolWindow close]; } - (IBAction)cltoolNoButton:(id)sender; { if ([cltoolPref state]==NSOnState) [[NSUserDefaults standardUserDefaults] setInteger:dontAsk forKey:@"CheckCltool"]; else [[NSUserDefaults standardUserDefaults] setInteger:doAsk forKey:@"CheckCltool"]; [cltoolWindow close]; } - (IBAction)raiseAboutWindow:(id)sender { [self raiseWindow: aboutWindow]; } - (void)raiseWindow:(NSWindow *)theWindow { NSRect screenFrame = [[mainWindow screen] visibleFrame]; NSRect mainWindowFrame = [mainWindow frame]; NSRect theWindowFrame = [theWindow frame]; float winX = mainWindowFrame.origin.x + (mainWindowFrame.size.width - theWindowFrame.size.width)/2; float winY = mainWindowFrame.origin.y + (mainWindowFrame.size.height + theWindowFrame.size.height)/2; if (winXmaxX) winX=maxX; float minY = screenFrame.origin.y+theWindowFrame.size.height; if (winYmaxY) winY=maxY; [theWindow cascadeTopLeftFromPoint: NSMakePoint(winX,winY)]; [theWindow makeKeyAndOrderFront:nil]; } - (IBAction)onlineHelp:(id)sender { [[NSWorkspace sharedWorkspace] openURL:[NSURL URLWithString:@"http://www.cis.upenn.edu/~bcpierce/unison/docs.html"]]; } /* from http://developer.apple.com/documentation/Security/Conceptual/authorization_concepts/index.html */ #include #include - (IBAction)installCommandLineTool:(id)sender { /* Install the command-line tool in /usr/bin/unison. Requires root privilege, so we ask for it and pass the task off to /bin/sh. */ OSStatus myStatus; AuthorizationFlags myFlags = kAuthorizationFlagDefaults; AuthorizationRef myAuthorizationRef; myStatus = AuthorizationCreate(NULL, kAuthorizationEmptyEnvironment, myFlags, &myAuthorizationRef); if (myStatus != errAuthorizationSuccess) return; { AuthorizationItem myItems = {kAuthorizationRightExecute, 0, NULL, 0}; AuthorizationRights myRights = {1, &myItems}; myFlags = kAuthorizationFlagDefaults | kAuthorizationFlagInteractionAllowed | kAuthorizationFlagPreAuthorize | kAuthorizationFlagExtendRights; myStatus = AuthorizationCopyRights(myAuthorizationRef,&myRights,NULL,myFlags,NULL); } if (myStatus == errAuthorizationSuccess) { NSBundle *bundle = [NSBundle mainBundle]; NSString *bundle_path = [bundle bundlePath]; NSString *exec_path = [bundle_path stringByAppendingString:@"/Contents/MacOS/cltool"]; // Not sure why but this doesn't work: // [bundle pathForResource:@"cltool" ofType:nil]; if (exec_path == nil) return; char *args[] = { "-f", (char *)[exec_path UTF8String], "/usr/bin/unison", NULL }; myFlags = kAuthorizationFlagDefaults; myStatus = AuthorizationExecuteWithPrivileges (myAuthorizationRef, "/bin/cp", myFlags, args, NULL); } AuthorizationFree (myAuthorizationRef, kAuthorizationFlagDefaults); /* if (myStatus == errAuthorizationCanceled) NSLog(@"The attempt was canceled\n"); else if (myStatus) NSLog(@"There was an authorization error: %ld\n", myStatus); */ } - (BOOL)validateItem:(IBAction *) action { if (action == @selector(syncButton:)) return syncable; // FIXME Restarting during sync is disabled because it causes UI corruption else if (action == @selector(restartButton:)) return !duringSync; else if (action == @selector(rescan:)) return ((syncable && !duringSync) || afterSync); else return YES; } - (BOOL)validateMenuItem:(NSMenuItem *)menuItem { return [self validateItem:[menuItem action]]; } - (BOOL)validateToolbarItem:(NSToolbarItem *)toolbarItem { return [self validateItem:[toolbarItem action]]; } - (void)resizeWindowToSize:(NSSize)newSize { NSRect aFrame; float newHeight = newSize.height+[self toolbarHeightForWindow:mainWindow]; float newWidth = newSize.width; aFrame = [NSWindow contentRectForFrameRect:[mainWindow frame] styleMask:[mainWindow styleMask]]; aFrame.origin.y += aFrame.size.height; aFrame.origin.y -= newHeight; aFrame.size.height = newHeight; aFrame.size.width = newWidth; aFrame = [NSWindow frameRectForContentRect:aFrame styleMask:[mainWindow styleMask]]; [mainWindow setFrame:aFrame display:YES animate:YES]; } - (float)toolbarHeightForWindow:(NSWindow *)window { NSToolbar *aToolbar; float toolbarHeight = 0.0; NSRect windowFrame; aToolbar = [window toolbar]; if(aToolbar && [aToolbar isVisible]) { windowFrame = [NSWindow contentRectForFrameRect:[window frame] styleMask:[window styleMask]]; toolbarHeight = NSHeight(windowFrame) - NSHeight([[window contentView] frame]); } return toolbarHeight; } @end @implementation NSString (_UnisonUtil) - (NSString *)trim { NSCharacterSet *ws = [NSCharacterSet whitespaceCharacterSet]; int len = [self length], i = len; while (i && [ws characterIsMember:[self characterAtIndex:i-1]]) i--; return (i == len) ? self : [self substringToIndex:i]; } @end unison-2.32.52/uimacnew/NotificationController.h0000644000076500000000000000103711176730177021320 0ustar bcpiercewheel// // NotificationController.h // uimac // // Created by Alan Schmitt on 02/02/06. // Copyright 2006, see file COPYING for details. All rights reserved. // #import #import @interface NotificationController : NSObject { } - (void)updateFinishedFor: (NSString *)profile; - (void)syncFinishedFor: (NSString *)profile; /* Implement the GrowlApplicationBridgeDelegate protocol */ - (NSDictionary *)registrationDictionaryForGrowl; - (NSString *)applicationNameForGrowl; @end unison-2.32.52/uimacnew/NotificationController.m0000644000076500000000000000332511176730177021327 0ustar bcpiercewheel// // NotificationController.m // uimac // // Created by Alan Schmitt on 02/02/06. // Copyright 2006, see file COPYING for details. All rights reserved. // #import "NotificationController.h" #define NOTIFY_UPDATE @"Scan finished" #define NOTIFY_SYNC @"Synchronization finished" /* Show a simple notification */ static void simpleNotify(NSString *name, NSString *descFmt, NSString *profile); @implementation NotificationController - (void)awakeFromNib { [GrowlApplicationBridge setGrowlDelegate:self]; } - (void)updateFinishedFor: (NSString *)profile { simpleNotify(NOTIFY_UPDATE, @"Profile '%@' is finished scanning for updates", profile); } - (void)syncFinishedFor: (NSString *)profile { simpleNotify(NOTIFY_SYNC, @"Profile '%@' is finished synchronizing", profile); } - (NSDictionary *)registrationDictionaryForGrowl { NSArray* notifications = [NSArray arrayWithObjects: NOTIFY_UPDATE, NOTIFY_SYNC, nil]; return [NSDictionary dictionaryWithObjectsAndKeys: notifications, GROWL_NOTIFICATIONS_ALL, notifications, GROWL_NOTIFICATIONS_DEFAULT, nil]; } - (NSString *)applicationNameForGrowl { return @"Unison"; } @end static void simpleNotify(NSString *name, NSString *descFmt, NSString *profile) { [GrowlApplicationBridge notifyWithTitle:name description:[NSString stringWithFormat:descFmt, profile] notificationName:name iconData:nil priority:0 isSticky:false clickContext:nil]; }unison-2.32.52/uimacnew/PreferencesController.h0000644000076500000000000000104411176730177021131 0ustar bcpiercewheel/* PreferencesController */ #import @interface PreferencesController : NSObject { IBOutlet NSTextField *firstRootText; IBOutlet NSButtonCell *localButtonCell; IBOutlet NSTextField *profileNameText; IBOutlet NSButtonCell *remoteButtonCell; IBOutlet NSTextField *secondRootHost; IBOutlet NSTextField *secondRootText; IBOutlet NSTextField *secondRootUser; } - (IBAction)anyEnter:(id)sender; - (IBAction)localClick:(id)sender; - (IBAction)remoteClick:(id)sender; - (BOOL)validatePrefs; - (void)reset; @end unison-2.32.52/uimacnew/PreferencesController.m0000644000076500000000000000545311176730177021146 0ustar bcpiercewheel#import "PreferencesController.h" #import "Bridge.h" @implementation PreferencesController - (void)reset { [profileNameText setStringValue:@""]; [firstRootText setStringValue:@""]; [secondRootUser setStringValue:@""]; [secondRootHost setStringValue:@""]; [secondRootText setStringValue:@""]; [remoteButtonCell setState:NSOnState]; [localButtonCell setState:NSOffState]; [secondRootUser setSelectable:YES]; [secondRootUser setEditable:YES]; [secondRootHost setSelectable:YES]; [secondRootHost setEditable:YES]; } - (BOOL)validatePrefs { NSString *profileName = [profileNameText stringValue]; if (profileName == nil | [profileName isEqualTo:@""]) { // FIX: should check for already existing names too NSRunAlertPanel(@"Error",@"You must enter a profile name",@"OK",nil,nil); return NO; } NSString *firstRoot = [firstRootText stringValue]; if (firstRoot == nil | [firstRoot isEqualTo:@""]) { NSRunAlertPanel(@"Error",@"You must enter a first root",@"OK",nil,nil); return NO; } NSString *secondRoot; if ([remoteButtonCell state] == NSOnState) { NSString *user = [secondRootUser stringValue]; if (user == nil | [user isEqualTo:@""]) { NSRunAlertPanel(@"Error",@"You must enter a user",@"OK",nil,nil); return NO; } NSString *host = [secondRootHost stringValue]; if (host == nil | [host isEqualTo:@""]) { NSRunAlertPanel(@"Error",@"You must enter a host",@"OK",nil,nil); return NO; } NSString *file = [secondRootText stringValue]; // OK for empty file, e.g., ssh://foo@bar/ secondRoot = [NSString stringWithFormat:@"ssh://%@@%@/%@",user,host,file]; } else { secondRoot = [secondRootText stringValue]; if (secondRoot == nil | [secondRoot isEqualTo:@""]) { NSRunAlertPanel(@"Error",@"You must enter a second root file",@"OK",nil,nil); return NO; } } ocamlCall("xSSS", "unisonProfileInit", profileName, firstRoot, secondRoot); return YES; } /* The target when enter is pressed in any of the text fields */ // FIX: this is broken, it takes tab, mouse clicks, etc. - (IBAction)anyEnter:(id)sender { NSLog(@"enter"); [self validatePrefs]; } - (IBAction)localClick:(id)sender { NSLog(@"local"); [secondRootUser setStringValue:@""]; [secondRootHost setStringValue:@""]; [secondRootUser setSelectable:NO]; [secondRootUser setEditable:NO]; [secondRootHost setSelectable:NO]; [secondRootHost setEditable:NO]; } - (IBAction)remoteClick:(id)sender { NSLog(@"remote"); [secondRootUser setSelectable:YES]; [secondRootUser setEditable:YES]; [secondRootHost setSelectable:YES]; [secondRootHost setEditable:YES]; } @end unison-2.32.52/uimacnew/ProfileController.h0000644000076500000000000000114311176730177020270 0ustar bcpiercewheel/* ProfileController */ /* Copyright (c) 2003, see file COPYING for details. */ #import @interface ProfileController : NSObject { IBOutlet NSTableView *tableView; NSMutableArray *profiles; int defaultIndex; // -1 if no default, else the index in profiles of @"default" } - (void)initProfiles; - (int)numberOfRowsInTableView:(NSTableView *)aTableView; - (id)tableView:(NSTableView *)aTableView objectValueForTableColumn:(NSTableColumn *)aTableColumn row:(int)rowIndex; - (NSString *)selected; - (NSTableView *)tableView; // allows MyController to set up firstResponder @end unison-2.32.52/uimacnew/ProfileController.m0000644000076500000000000000403411176730177020277 0ustar bcpiercewheel/* Copyright (c) 2003, see file COPYING for details. */ #import "ProfileController.h" #import "Bridge.h" @implementation ProfileController NSString *unisonDirectory() { return (NSString *)ocamlCall("S", "unisonDirectory"); } - (void)initProfiles { NSString *directory = unisonDirectory(); NSArray *files = [[NSFileManager defaultManager] directoryContentsAtPath:directory]; unsigned int count = [files count]; unsigned int i,j; [profiles release]; profiles = [[NSMutableArray alloc] init]; defaultIndex = -1; for (i = j = 0; i < count; i++) { NSString *file = [files objectAtIndex:i]; if ([[file pathExtension] isEqualTo:@"prf"]) { NSString *withoutExtension = [file stringByDeletingPathExtension]; [profiles insertObject:withoutExtension atIndex:j]; if ([@"default" isEqualTo:withoutExtension]) defaultIndex = j; j++; } } if (j > 0) [tableView selectRow:0 byExtendingSelection:NO]; } - (void)awakeFromNib { // start with the default profile selected [self initProfiles]; if (defaultIndex >= 0) [tableView selectRow:defaultIndex byExtendingSelection:NO]; // on awake the scroll bar is inactive, but after adding profiles we might need it; // reloadData makes it happen. Q: is setNeedsDisplay more efficient? [tableView reloadData]; } - (int)numberOfRowsInTableView:(NSTableView *)aTableView { if (!profiles) return 0; else return [profiles count]; } - (id)tableView:(NSTableView *)aTableView objectValueForTableColumn:(NSTableColumn *)aTableColumn row:(int)rowIndex { if (rowIndex >= 0 && rowIndex < [profiles count]) return [profiles objectAtIndex:rowIndex]; else return @"[internal error!]"; } - (NSString *)selected { int rowIndex = [tableView selectedRow]; if (rowIndex >= 0 && rowIndex < [profiles count]) return [profiles objectAtIndex:rowIndex]; else return @"[internal error!]"; } - (NSTableView *)tableView { return tableView; } @end unison-2.32.52/uimacnew/ProfileTableView.h0000644000076500000000000000024311176730177020027 0ustar bcpiercewheel/* ProfileTableView */ #import @class MyController; @interface ProfileTableView : NSTableView { IBOutlet MyController *myController; } @end unison-2.32.52/uimacnew/ProfileTableView.m0000644000076500000000000000160111176730177020033 0ustar bcpiercewheel#import "MyController.h" #import "ProfileTableView.h" @implementation ProfileTableView - (void)keyDown:(NSEvent *)event { /* some keys return zero-length strings */ if ([[event characters] length] == 0) { [super keyDown:event]; return; } unichar c = [[event characters] characterAtIndex:0]; switch (c) { case '\r': [myController openButton:self]; break; default: [super keyDown:event]; break; } } /* Override default highlight colour to match ReconTableView */ - (id)_highlightColorForCell:(NSCell *)cell { if(([[self window] firstResponder] == self) && [[self window] isMainWindow] && [[self window] isKeyWindow]) return [NSColor colorWithCalibratedRed:0.7 green:0.75 blue:0.8 alpha:1.0]; else return [NSColor colorWithCalibratedRed:0.8 green:0.8 blue:0.8 alpha:1.0]; } @end unison-2.32.52/uimacnew/ProgressCell.h0000644000076500000000000000056111176730177017233 0ustar bcpiercewheel#import @interface ProgressCell : NSCell { float _minVal, _maxVal; // defaults to 0.0, 100.0 BOOL _isActive; BOOL _useFullView; // default: NO BOOL _isError; // default: NO NSImage *_icon; NSString *_statusString; } - (void)setStatusString:(NSString *)string; - (void)setIcon:(NSImage *)image; - (void)setIsActive:(BOOL)yn; @end unison-2.32.52/uimacnew/ProgressCell.m0000644000076500000000000001417611176730177017247 0ustar bcpiercewheel/****************************************************************************** * Copyright 2008 (see file COPYING for more information) * * Loosely based on TorrentCell from Transmission (.png files are from * the original). *****************************************************************************/ #import "ProgressCell.h" #define BAR_HEIGHT 12.0 static NSImage *_ProgressWhite, *_ProgressBlue, *_ProgressGray, *_ProgressGreen, *_ProgressAdvanced, *_ProgressEndWhite, *_ProgressEndBlue, *_ProgressEndGray, *_ProgressEndGreen, *_ProgressLightGreen, *_ProgressEndAdvanced, * _ErrorImage; static NSSize ZeroSize; @implementation ProgressCell + (void) initialize { NSSize startSize = NSMakeSize(100.0, BAR_HEIGHT); ZeroSize = NSMakeSize(0.0, 0.0); _ProgressWhite = [NSImage imageNamed: @"ProgressBarWhite.png"]; [_ProgressWhite setScalesWhenResized: YES]; _ProgressBlue = [NSImage imageNamed: @"ProgressBarBlue.png"]; [_ProgressBlue setScalesWhenResized: YES]; [_ProgressBlue setSize: startSize]; _ProgressGray = [NSImage imageNamed: @"ProgressBarGray.png"]; [_ProgressGray setScalesWhenResized: YES]; [_ProgressGray setSize: startSize]; _ProgressGreen = [NSImage imageNamed: @"ProgressBarGreen.png"]; [_ProgressGreen setScalesWhenResized: YES]; _ProgressLightGreen = [NSImage imageNamed: @"ProgressBarLightGreen.png"]; [_ProgressLightGreen setScalesWhenResized: YES]; _ProgressAdvanced = [NSImage imageNamed: @"ProgressBarAdvanced.png"]; [_ProgressAdvanced setScalesWhenResized: YES]; _ProgressEndWhite = [NSImage imageNamed: @"ProgressBarEndWhite.png"]; _ProgressEndBlue = [NSImage imageNamed: @"ProgressBarEndBlue.png"]; _ProgressEndGray = [NSImage imageNamed: @"ProgressBarEndGray.png"]; _ProgressEndGreen = [NSImage imageNamed: @"ProgressBarEndGreen.png"]; _ProgressEndAdvanced = [NSImage imageNamed: @"ProgressBarEndAdvanced.png"]; _ErrorImage = [[NSImage imageNamed: @"Error.tiff"] copy]; [_ErrorImage setFlipped: YES]; } - (id)init { self = [super init]; _minVal = 0.0; _maxVal = 100.0; _isActive = YES; return self; } - (void)dealloc { [_icon release]; [_statusString release]; [super dealloc]; } - (void)setStatusString:(NSString *)string { [_statusString autorelease]; _statusString = [string retain]; } - (void)setIcon:(NSImage *)image { [_icon autorelease]; _icon = [image retain]; } - (void)setIsActive:(BOOL)yn { _isActive = yn; } - (void)drawBarImage:(NSImage *)barImage width:(float)width point:(NSPoint)point { if (width <= 0.0) return; if ([barImage size].width < width) [barImage setSize: NSMakeSize(width * 2.0, BAR_HEIGHT)]; [barImage compositeToPoint: point fromRect: NSMakeRect(0, 0, width, BAR_HEIGHT) operation: NSCompositeSourceOver]; } - (void)drawBar:(float)width point:(NSPoint)point { id objectValue = [self objectValue]; if (!objectValue) return; float value = [objectValue floatValue]; float progress = (value - _minVal)/ (_maxVal - _minVal); width -= 2.0; float completedWidth, remainingWidth = 0.0; //bar images and widths NSImage * barLeftEnd, * barRightEnd, * barComplete, * barRemaining; if (progress >= 1.0) { completedWidth = width; barLeftEnd = _ProgressEndGreen; barRightEnd = _ProgressEndGreen; barComplete = _ProgressGreen; barRemaining = _ProgressLightGreen; } else { completedWidth = progress * width; remainingWidth = width - completedWidth; barLeftEnd = (remainingWidth == width) ? _ProgressEndWhite : ((_isActive) ? _ProgressEndBlue : _ProgressEndGray); barRightEnd = (completedWidth < width) ? _ProgressEndWhite : ((_isActive) ? _ProgressEndBlue : _ProgressEndGray); barComplete = _isActive ? _ProgressBlue : _ProgressGray; barRemaining = _ProgressWhite; } [barLeftEnd compositeToPoint: point operation: NSCompositeSourceOver]; point.x += 1.0; [self drawBarImage: barComplete width: completedWidth point: point]; point.x += completedWidth; [self drawBarImage: barRemaining width: remainingWidth point: point]; point.x += remainingWidth; [barRightEnd compositeToPoint: point operation: NSCompositeSourceOver]; } - (void)drawWithFrame:(NSRect)cellFrame inView:(NSView *)view { NSPoint pen = cellFrame.origin; const float PADDING = 3.0; // progress bar pen.y += PADDING + BAR_HEIGHT; float mainWidth = cellFrame.size.width; float barWidth = mainWidth; [self drawBar: barWidth point: pen]; //icon NSImage * image = _isError ? _ErrorImage : _icon; if (image) { NSSize imageSize = [image size]; NSRect imageFrame; imageFrame.origin = cellFrame.origin; imageFrame.size = imageSize; imageFrame.origin.x += ceil((cellFrame.size.width - imageSize.width) / 2); imageFrame.origin.y += [view isFlipped] ? ceil((cellFrame.size.height + imageSize.height) / 2) : ceil((cellFrame.size.height - imageSize.height) / 2); [image compositeToPoint:imageFrame.origin operation:NSCompositeSourceOver]; } // status string if (_statusString) { BOOL highlighted = [self isHighlighted] && [[self highlightColorWithFrame: cellFrame inView: view] isEqual: [NSColor alternateSelectedControlColor]]; NSMutableParagraphStyle * paragraphStyle = [[NSParagraphStyle defaultParagraphStyle] mutableCopy]; [paragraphStyle setLineBreakMode: NSLineBreakByTruncatingTail]; NSDictionary * statusAttributes = [[NSDictionary alloc] initWithObjectsAndKeys: highlighted ? [NSColor whiteColor] : [NSColor darkGrayColor], NSForegroundColorAttributeName, [NSFont boldSystemFontOfSize: 9.0], NSFontAttributeName, paragraphStyle, NSParagraphStyleAttributeName, nil]; [paragraphStyle release]; NSSize statusSize = [_statusString sizeWithAttributes: statusAttributes]; pen = cellFrame.origin; pen.x += (cellFrame.size.width - statusSize.width) * 0.5; pen.y += (cellFrame.size.height - statusSize.height) * 0.5; [_statusString drawInRect: NSMakeRect(pen.x, pen.y, statusSize.width, statusSize.height) withAttributes: statusAttributes]; [statusAttributes release]; } } @end unison-2.32.52/uimacnew/progressicons/0000755000076500000000000000000011222164527017344 5ustar bcpiercewheelunison-2.32.52/uimacnew/progressicons/ProgressBarAdvanced.png0000644000076500000000000000021611176730177023740 0ustar bcpiercewheelPNG  IHDR  gAMAOX2tEXtSoftwareAdobe ImageReadyqe< IDATc`PcR1Wbo? nIENDB`unison-2.32.52/uimacnew/progressicons/ProgressBarBlue.png0000644000076500000000000000022711176730177023124 0ustar bcpiercewheelPNG  IHDR ,@gAMAOX2tEXtSoftwareAdobe ImageReadyqe<)IDATcpzǐ _CO Qk2d @(g+XIENDB`unison-2.32.52/uimacnew/progressicons/ProgressBarEndAdvanced.png0000644000076500000000000000017311176730177024371 0ustar bcpiercewheelPNG  IHDR  gAMAOX2tEXtSoftwareAdobe ImageReadyqe< IDATc`Pc PIENDB`unison-2.32.52/uimacnew/progressicons/ProgressBarEndBlue.png0000644000076500000000000000017511176730177023555 0ustar bcpiercewheelPNG  IHDR ,@gAMAOX2tEXtSoftwareAdobe ImageReadyqe<IDATcpz@?IENDB`unison-2.32.52/uimacnew/progressicons/ProgressBarEndGray.png0000644000076500000000000000017311176730177023566 0ustar bcpiercewheelPNG  IHDR gAMAOX2tEXtSoftwareAdobe ImageReadyqe< IDATc€SXIIENDB`unison-2.32.52/uimacnew/progressicons/ProgressBarEndGreen.png0000644000076500000000000000017511176730177023726 0ustar bcpiercewheelPNG  IHDR ,@gAMAOX2tEXtSoftwareAdobe ImageReadyqe<IDATcZg@/o mCkIENDB`unison-2.32.52/uimacnew/progressicons/ProgressBarEndWhite.png0000644000076500000000000000017511176730177023746 0ustar bcpiercewheelPNG  IHDR ,@gAMAOX2tEXtSoftwareAdobe ImageReadyqe<IDATc8q, uL{1IENDB`unison-2.32.52/uimacnew/progressicons/ProgressBarGray.png0000644000076500000000000000021011176730177023127 0ustar bcpiercewheelPNG  IHDR gAMAOX2tEXtSoftwareAdobe ImageReadyqe<IDATc° 0`ǰa=N`5{~IENDB`unison-2.32.52/uimacnew/progressicons/ProgressBarGreen.png0000644000076500000000000000022711176730177023275 0ustar bcpiercewheelPNG  IHDR ,@gAMAOX2tEXtSoftwareAdobe ImageReadyqe<)IDATcZgP8gbf`rșH0{))IENDB`unison-2.32.52/uimacnew/progressicons/ProgressBarLightGreen.png0000644000076500000000000000542411176730177024271 0ustar bcpiercewheelPNG  IHDR ,@ pHYs   OiCCPPhotoshop ICC profilexڝSgTS=BKKoR RB&*! J!QEEȠQ, !{kּ> H3Q5 B.@ $pd!s#~<<+"x M0B\t8K@zB@F&S`cbP-`'{[! eDh;VEX0fK9-0IWfH  0Q){`##xFW<+*x<$9E[-qWW.(I+6aa@.y24x6_-"bbϫp@t~,/;m%h^ uf@Wp~<5j>{-]cK'Xto(hw?G%fIq^D$.Tʳ?D*A, `6B$BB dr`)B(Ͱ*`/@4Qhp.U=pa( Aa!ڈbX#!H$ ɈQ"K5H1RT UH=r9\F;2G1Q= C7F dt1r=6Ыhڏ>C03l0.B8, c˱" VcϱwE 6wB aAHXLXNH $4 7 Q'"K&b21XH,#/{C7$C2'ITFnR#,4H#dk9, +ȅ3![ b@qS(RjJ4e2AURݨT5ZBRQ4u9̓IKhhitݕNWGw Ljg(gwLӋT071oUX**| J&*/Tު UUT^S}FU3S ԖUPSSg;goT?~YYLOCQ_ cx,!k u5&|v*=9C3J3WRf?qtN (~))4L1e\kXHQG6EYAJ'\'GgSSݧ M=:.kDwn^Loy}/TmG X $ <5qo</QC]@Caaᄑ.ȽJtq]zۯ6iܟ4)Y3sCQ? 0k߬~OCOg#/c/Wװwa>>r><72Y_7ȷOo_C#dz%gA[z|!?:eAAA!h쐭!ΑiP~aa~ 'W?pX15wCsDDDޛg1O9-J5*>.j<74?.fYXXIlK9.*6nl {/]py.,:@LN8A*%w% yg"/6шC\*NH*Mz쑼5y$3,幄'L Lݛ:v m2=:1qB!Mggfvˬen/kY- BTZ(*geWf͉9+̳ې7ᒶKW-X潬j9(xoʿܔĹdff-[n ڴ VE/(ۻCɾUUMfeI?m]Nmq#׹=TR+Gw- 6 U#pDy  :v{vg/jBFS[b[O>zG499?rCd&ˮ/~јѡ򗓿m|x31^VwwO| (hSЧc3-gAMA|Q cHRMz%u0`:o_F/IDATxbZgư ^!uC U1h3 ,IENDB`unison-2.32.52/uimacnew/progressicons/ProgressBarWhite.png0000644000076500000000000000023011176730177023307 0ustar bcpiercewheelPNG  IHDR ,@gAMAOX2tEXtSoftwareAdobe ImageReadyqe<*IDATc8q,ϟQOΞpM{2yj fyIENDB`unison-2.32.52/uimacnew/ReconItem.h0000644000076500000000000000354311176730177016517 0ustar bcpiercewheel/* ReconItem */ #import @class OCamlValue; @interface ReconItem : NSObject { ReconItem *parent; NSString *path; NSString *fullPath; BOOL selected; NSImage *direction; NSString *directionSortString; int fileSize; int bytesTransferred; BOOL resolved; } - (BOOL)selected; - (void)setSelected:(BOOL)x; - (NSString *)path; - (NSString *)fullPath; - (NSString *)left; - (NSString *)right; - (NSImage *)direction; - (NSImage *)fileIcon; - (int)fileCount; - (int)fileSize; - (NSString *)fileSizeString; - (int)bytesTransferred; - (NSString *)bytesTransferredString; - (void)setDirection:(char *)d; - (void) doAction:(unichar)action; - (void) doIgnore:(unichar)action; - (NSString *)progress; - (NSString *)progressString; - (void)resetProgress; - (NSString *)details; - (NSString *)updateDetails; - (BOOL)isConflict; - (BOOL)changedFromDefault; - (void)revertDirection; - (BOOL)canDiff; - (void)showDiffs; - (NSString *)leftSortKey; - (NSString *)rightSortKey; - (NSString *)replicaSortKey:(NSString *)sortString; - (NSString *)directionSortKey; - (NSString *)progressSortKey; - (NSString *)pathSortKey; - (NSArray *)children; - (ReconItem *)collapseParentsWithSingleChildren:(BOOL)isRoot; - (ReconItem *)parent; - (void)setPath:(NSString *)aPath; - (void)setFullPath:(NSString *)p; - (void)setParent:(ReconItem *)p; - (void)willChange; @end @interface LeafReconItem : ReconItem { NSString *left; NSString *right; NSString *progress; NSString *details; OCamlValue *ri; // an ocaml Common.reconItem int index; // index in Ri list } - initWithRiAndIndex:(OCamlValue *)v index:(int)i; @end @interface ParentReconItem : ReconItem { NSMutableArray *_children; int fileCount; } - (void)addChild:(ReconItem *)item nested:(BOOL)useNesting; - (void)sortUsingDescriptors:(NSArray *)sortDescriptors; - (BOOL)hasConflictedChildren; @end unison-2.32.52/uimacnew/ReconItem.m0000644000076500000000000004330611176730177016525 0ustar bcpiercewheel#import "ReconItem.h" #import "Bridge.h" #import @implementation ReconItem - init { [super init]; selected = NO; // NB only used/updated during sorts. Not a // reliable indicator of whether item is selected fileSize = -1; bytesTransferred = -1; return self; } - (void)dealloc { [path release]; [fullPath release]; // [direction release]; // assuming retained by cache, so not retained // [directionSortString release]; // no retain/release necessary because is constant [super dealloc]; } - (ReconItem *)parent { return parent; } - (void)setParent:(ReconItem *)p { parent = p; } - (void)willChange { // propagate up parent chain [parent willChange]; } - (NSArray *)children { return nil; } - (BOOL)selected { return selected; } - (void)setSelected:(BOOL)x { selected = x; } - (NSString *)path { return path; } - (void)setPath:(NSString *)aPath { [path autorelease]; path = [aPath retain]; // invalidate [fullPath autorelease]; fullPath = nil; } - (NSString *)fullPath { if (!fullPath) { NSString *parentPath = [parent fullPath]; [self setFullPath:(([parentPath length] > 0) ? [parentPath stringByAppendingFormat:@"/%@", path] : path)]; } return fullPath; } - (void)setFullPath:(NSString *)p { [fullPath autorelease]; fullPath = [p retain]; } - (NSString *)left { return nil; } - (NSString *)right { return nil; } static NSMutableDictionary *_ChangeIconsByType = nil; - (NSImage *)changeIconFor:(NSString *)type other:(NSString *)other { if (![type length]) { if ([other isEqual:@"Created"]) { type = @"Absent"; } else if ([other length]) { type = @"Unmodified"; } else return nil; } NSImage *result = [_ChangeIconsByType objectForKey:type]; if (!result) { NSString *imageName = [NSString stringWithFormat:@"Change_%@.png", type]; result = [NSImage imageNamed:imageName]; if (!_ChangeIconsByType) _ChangeIconsByType = [[NSMutableDictionary alloc] init]; [_ChangeIconsByType setObject:result forKey:type]; } return result; } - (NSImage *)leftIcon { return [self changeIconFor:[self left] other:[self right]]; } - (NSImage *)rightIcon { return [self changeIconFor:[self right] other:[self left]]; } - (int)computeFileSize { return 0; } - (int)bytesTransferred { return 0; } - (int)fileCount { return 1; } - (int)fileSize { if (fileSize == -1) fileSize = [self computeFileSize]; return fileSize; } - (NSString *)formatFileSize:(int)intSize { float size = (float)intSize; if (size == 0) return @"--"; if (size < 1024) return @"< 1KB"; // return [NSString stringWithFormat:@"%i bytes", size]; size /= 1024; if (size < 1024) return [NSString stringWithFormat:@"%i KB", (int)size]; size /= 1024; if (size < 1024) return [NSString stringWithFormat:@"%1.1f MB", size]; size = size / 1024; return [NSString stringWithFormat:@"%1.1f GB", size]; } - (NSString *)fileSizeString { return [self formatFileSize:[self fileSize]]; } - (NSString *)bytesTransferredString { return [self formatFileSize:[self bytesTransferred]]; } - (NSNumber *)percentTransferred { int size = [self computeFileSize]; return (size > 0) ? [NSNumber numberWithFloat:(((float)[self bytesTransferred]) / (float)size) * 100.0] : nil; } static NSMutableDictionary *_iconsByExtension = nil; - (NSImage *)iconForExtension:(NSString *)extension { NSImage *icon = [_iconsByExtension objectForKey:extension]; if (!_iconsByExtension) _iconsByExtension = [[NSMutableDictionary alloc] init]; if (!icon) { icon = [[NSWorkspace sharedWorkspace] iconForFileType:extension]; [icon setSize:NSMakeSize(16.0, 16.0)]; [_iconsByExtension setObject:icon forKey:extension]; } return icon; } - (NSImage *)fileIcon { return [self iconForExtension:NSFileTypeForHFSTypeCode(kOpenFolderIcon)]; } - (NSString *)dirString { return @"<-?->"; } - (NSImage *)direction { if (direction) return direction; NSString * dirString = [self dirString]; BOOL changedFromDefault = [self changedFromDefault]; if ([dirString isEqual:@"<-?->"]) { if (changedFromDefault | resolved) { direction = [NSImage imageNamed: @"table-skip.tif"]; directionSortString = @"3"; } else { direction = [NSImage imageNamed: @"table-conflict.tif"]; directionSortString = @"2"; } } else if ([dirString isEqual:@"---->"]) { if (changedFromDefault) { direction = [NSImage imageNamed: @"table-right-blue.tif"]; directionSortString = @"6"; } else { direction = [NSImage imageNamed: @"table-right-green.tif"]; directionSortString = @"8"; } } else if ([dirString isEqual:@"<----"]) { if (changedFromDefault) { direction = [NSImage imageNamed: @"table-left-blue.tif"]; directionSortString = @"5"; } else { direction = [NSImage imageNamed: @"table-left-green.tif"]; directionSortString = @"7"; } } else if ([dirString isEqual:@"<-M->"]) { direction = [NSImage imageNamed: @"table-merge.tif"]; directionSortString = @"4"; } else if ([dirString isEqual:@"<--->"]) { direction = [NSImage imageNamed: @"table-mixed.tif"]; directionSortString = @"9"; } else { direction = [NSImage imageNamed: @"table-error.tif"]; directionSortString = @"1"; } [direction retain]; return direction; } - (void)setDirection:(char *)d { [direction autorelease]; direction = nil; } - (void)doAction:(unichar)action { switch (action) { case '>': [self setDirection:"unisonRiSetRight"]; break; case '<': [self setDirection:"unisonRiSetLeft"]; break; case '/': [self setDirection:"unisonRiSetConflict"]; resolved = YES; break; case '-': [self setDirection:"unisonRiForceOlder"]; break; case '+': [self setDirection:"unisonRiForceNewer"]; break; case 'm': [self setDirection:"unisonRiSetMerge"]; break; case 'd': [self showDiffs]; break; case 'R': [self revertDirection]; break; default: NSLog(@"ReconItem.doAction : unknown action"); break; } } - (void)doIgnore:(unichar)action { switch (action) { case 'I': ocamlCall("xS", "unisonIgnorePath", [self fullPath]); break; case 'E': ocamlCall("xS", "unisonIgnoreExt", [self path]); break; case 'N': ocamlCall("xS", "unisonIgnoreName", [self path]); break; default: NSLog(@"ReconItem.doIgnore : unknown ignore"); break; } } /* Sorting functions. These have names equal to column identifiers + "SortKey", and return NSStrings that can be automatically sorted with their compare method */ - (NSString *) leftSortKey { return [self replicaSortKey:[self left]]; } - (NSString *) rightSortKey { return [self replicaSortKey:[self right]]; } - (NSString *) replicaSortKey:(NSString *)sortString { /* sort order for left and right replicas */ if ([sortString isEqualToString:@"Created"]) return @"1"; else if ([sortString isEqualToString:@"Deleted"]) return @"2"; else if ([sortString isEqualToString:@"Modified"]) return @"3"; else if ([sortString isEqualToString:@""]) return @"4"; else return @"5"; } - (NSString *) directionSortKey { /* Since the direction indicators are unsortable images, use directionSortString instead */ if ([directionSortString isEqual:@""]) [self direction]; return directionSortString; } - (NSString *) progressSortKey { /* Percentages, "done" and "" are sorted OK without help, but "start " should be sorted after "" and before "0%" */ NSString * progressString = [self progress]; if ([progressString isEqualToString:@"start "]) progressString = @" "; return progressString; } - (NSString *) pathSortKey { /* default alphanumeric sort is fine for paths */ return [self path]; } - (NSString *)progress { return nil; } - (BOOL)transferInProgress { int soFar = [self bytesTransferred]; return (soFar > 0) && (soFar != [self fileSize]); } - (void)resetProgress { } - (NSString *)progressString { NSString *progress = [self progress]; if ([progress length] == 0 || [progress hasSuffix:@"%"]) progress = [self transferInProgress] ? [self bytesTransferredString] : @""; else if ([progress isEqual:@"done"]) progress = @""; return progress; } - (NSString *)details { return nil; } - (NSString *)updateDetails { return [self details]; } - (BOOL)isConflict { return NO; } - (BOOL)changedFromDefault { return NO; } - (void)revertDirection { [self willChange]; [direction release]; direction = nil; resolved = NO; } - (BOOL)canDiff { return NO; } - (void)showDiffs { } - (ReconItem *)collapseParentsWithSingleChildren:(BOOL)isRoot { return self; } @end // --- Leaf items -- actually corresponding to ReconItems in OCaml @implementation LeafReconItem - initWithRiAndIndex:(OCamlValue *)v index:(int)i { [super init]; ri = [v retain]; index = i; resolved = NO; directionSortString = @""; return self; } -(void)dealloc { [ri release]; [left release]; [right release]; [progress release]; [details release]; [super dealloc]; } - (NSString *)path { if (!path) path = [(NSString *)ocamlCall("S@", "unisonRiToPath", ri) retain]; return path; } - (NSString *)left { if (!left) left = [(NSString *)ocamlCall("S@", "unisonRiToLeft", ri) retain]; return left; } - (NSString *)right { if (!right) right = [(NSString *)ocamlCall("S@", "unisonRiToRight", ri) retain]; return right; } - (int)computeFileSize { return (int)ocamlCall("i@", "unisonRiToFileSize", ri); } - (int)bytesTransferred { if (bytesTransferred == -1) { // need to force to fileSize if done, otherwise may not match up to 100% bytesTransferred = ([[self progress] isEqual:@"done"]) ? [self fileSize] : (int)ocamlCall("i@", "unisonRiToBytesTransferred", ri); } return bytesTransferred; } - (NSImage *)fileIcon { NSString *extension = [[self path] pathExtension]; if ([@"" isEqual:extension]) { NSString *type = (NSString *)ocamlCall("S@", "unisonRiToFileType", ri); extension = [type isEqual:@"dir"] ? NSFileTypeForHFSTypeCode(kGenericFolderIcon) : NSFileTypeForHFSTypeCode(kGenericDocumentIcon); } return [self iconForExtension:extension]; } - (NSString *)dirString { return (NSString *)ocamlCall("S@", "unisonRiToDirection", ri); } - (void)setDirection:(char *)d { [self willChange]; [super setDirection:d]; ocamlCall("x@", d, ri); } - (NSString *)progress { if (!progress) { progress = [(NSString *)ocamlCall("S@", "unisonRiToProgress", ri) retain]; if ([progress isEqual:@"FAILED"]) [self updateDetails]; } return progress; } - (void)resetProgress { // Get rid of the memoized progress because we expect it to change [self willChange]; bytesTransferred = -1; [progress release]; // Force update now so we get the result while the OCaml thread is available // [self progress]; // [self bytesTransferred]; progress = nil; } - (NSString *)details { if (details) return details; return [self updateDetails]; } - (NSString *)updateDetails { [details autorelease]; details = [(NSString *)ocamlCall("S@", "unisonRiToDetails", ri) retain]; return details; } - (BOOL)isConflict { return ((int)ocamlCall("i@", "unisonRiIsConflict", ri) ? YES : NO); } - (BOOL)changedFromDefault { return ((int)ocamlCall("i@", "changedFromDefault", ri) ? YES : NO); } - (void)revertDirection { ocamlCall("x@", "unisonRiRevert", ri); [super revertDirection]; } - (BOOL)canDiff { return ((int)ocamlCall("i@", "canDiff", ri) ? YES : NO); } - (void)showDiffs { ocamlCall("x@i", "runShowDiffs", ri, index); } @end @interface NSImage (TintedImage) - (NSImage *)tintedImageWithColor:(NSColor *) tint operation:(NSCompositingOperation) op; @end @implementation NSImage (TintedImage) - (NSImage *)tintedImageWithColor:(NSColor *) tint operation:(NSCompositingOperation) op { NSSize size = [self size]; NSRect imageBounds = NSMakeRect(0, 0, size.width, size.height); NSImage *newImage = [[NSImage alloc] initWithSize:size]; [newImage lockFocus]; [self compositeToPoint:NSZeroPoint operation:NSCompositeSourceOver]; [tint set]; NSRectFillUsingOperation(imageBounds, op); [newImage unlockFocus]; return [newImage autorelease]; } @end // ---- Parent nodes in grouped items @implementation ParentReconItem - init { [super init]; _children = [[NSMutableArray alloc] init]; return self; } - initWithPath:(NSString *)aPath { [self init]; path = [aPath retain]; return self; } - (void)dealloc { [_children release]; [super dealloc]; } - (NSArray *)children; { return _children; } - (void)addChild:(ReconItem *)item pathArray:(NSArray *)pathArray level:(int)level { NSString *element = [pathArray count] ? [pathArray objectAtIndex:level] : @""; // if we're at the leaf of the path, then add the item if (((0 == [pathArray count]) && (0 == level)) || (level == [pathArray count]-1)) { [item setParent:self]; [item setPath:element]; [_children addObject:item]; return; } // find / add matching parent node ReconItem *last = [_children lastObject]; if (last == nil || ![last isKindOfClass:[ParentReconItem class]] || ![[last path] isEqual:element]) { last = [[ParentReconItem alloc] initWithPath:element]; [last setParent:self]; [_children addObject:last]; [last release]; } [(ParentReconItem *)last addChild:item pathArray:pathArray level:level+1]; } - (void)addChild:(ReconItem *)item nested:(BOOL)nested { [item setPath:nil]; // invalidate/reset if (nested) { [self addChild:item pathArray:[[item path] pathComponents] level:0]; } else { [item setParent:self]; [_children addObject:item]; } } - (void)sortUsingDescriptors:(NSArray *)sortDescriptors { // sort our children [_children sortUsingDescriptors:sortDescriptors]; // then have them sort theirs int i = [_children count]; while (i--) { id child = [_children objectAtIndex:i]; if ([child isKindOfClass:[ParentReconItem class]]) [child sortUsingDescriptors:sortDescriptors]; } } - (ReconItem *)collapseParentsWithSingleChildren:(BOOL)isRoot { // replace ourselves? if (!isRoot && [_children count] == 1) { ReconItem *child = [_children lastObject]; [child setPath:[path stringByAppendingFormat:@"/%@", [child path]]]; return [child collapseParentsWithSingleChildren:NO]; } // recurse int i = [_children count]; while (i--) { ReconItem *child = [_children objectAtIndex:i]; ReconItem *replacement = [child collapseParentsWithSingleChildren:NO]; if (child != replacement) { [_children replaceObjectAtIndex:i withObject:replacement]; [replacement setParent:self]; } } return self; } - (void)willChange { // invalidate child-based state // Assuming caches / constant, so not retained / released // [direction autorelease]; // [directionSortString autorelease]; direction = nil; directionSortString = nil; bytesTransferred = -1; // fileSize = -1; // resolved = NO; // propagate up parent chain [parent willChange]; } // Propagation methods - (void)doAction:(unichar)action { int i = [_children count]; while (i--) { ReconItem *child = [_children objectAtIndex:i]; [child doAction:action]; } } - (void)doIgnore:(unichar)action { // handle Path ignores at this level, name and extension at the child nodes if (action == 'I') { [super doIgnore:'I']; } else { int i = [_children count]; while (i--) { ReconItem *child = [_children objectAtIndex:i]; [child doIgnore:action]; } } } // Rollup methods - (int)fileCount { if (fileCount == 0) { int i = [_children count]; while (i--) { ReconItem *child = [_children objectAtIndex:i]; fileCount += [child fileCount]; } } return fileCount; } - (int)computeFileSize { int size = 0; int i = [_children count]; while (i--) { ReconItem *child = [_children objectAtIndex:i]; size += [child fileSize]; } return size; } - (int)bytesTransferred { if (bytesTransferred == -1) { bytesTransferred = 0; int i = [_children count]; while (i--) { ReconItem *child = [_children objectAtIndex:i]; bytesTransferred += [child bytesTransferred]; } } return bytesTransferred; } - (NSString *)dirString { NSString *rollup = nil; int i = [_children count]; while (i--) { ReconItem *child = [_children objectAtIndex:i]; NSString *dirString = [child dirString]; if (!rollup || [dirString isEqual:rollup]) { rollup = dirString; } else { // conflict if ([dirString isEqual:@"---->"] || [dirString isEqual:@"<----"] || [dirString isEqual:@"<--->"]) { if ([rollup isEqual:@"---->"] || [rollup isEqual:@"<----"] || [rollup isEqual:@"<--->"]) { rollup = @"<--->"; } } else { rollup = @"<-?->"; } } } // NSLog(@"dirString for %@: %@", path, rollup); return rollup; } - (BOOL)hasConflictedChildren { NSString *dirString = [self dirString]; BOOL result = [dirString isEqual:@"<--->"] || [dirString isEqual:@"<-?->"]; // NSLog(@"hasConflictedChildren (%@): %@: %i", [self path], dirString, result); return result; } static NSMutableDictionary *_parentImages = nil; static NSColor *_veryLightGreyColor = nil; - (NSImage *)direction { if (!_parentImages) { _parentImages = [[NSMutableDictionary alloc] init]; _veryLightGreyColor = [[NSColor colorWithCalibratedRed:0.9 green:0.9 blue:0.9 alpha:1.0] retain]; // [NSColor lightGrayColor] } NSImage *baseImage = [super direction]; NSImage *parentImage = [_parentImages objectForKey:baseImage]; if (!parentImage) { // make parent images a grey version of the leaf images parentImage = [baseImage tintedImageWithColor:_veryLightGreyColor operation:NSCompositeSourceIn]; [_parentImages setObject:parentImage forKey:baseImage]; } return parentImage; } @end unison-2.32.52/uimacnew/ReconTableView.h0000644000076500000000000000223711176730177017502 0ustar bcpiercewheel// // ReconTableView.h // // NSTableView extended to handle additional keyboard events for the reconcile window. // The keyDown: method is redefined. // // Created by Trevor Jim on Wed Aug 27 2003. // Copyright (c) 2003, licensed under GNU GPL. // #import @interface ReconTableView : NSOutlineView { BOOL editable; } - (BOOL)editable; - (void)setEditable:(BOOL)x; - (BOOL)validateItem:(IBAction *) action; - (BOOL)validateMenuItem:(NSMenuItem *)menuItem; - (BOOL)validateToolbarItem:(NSToolbarItem *)toolbarItem; - (IBAction)ignorePath:(id)sender; - (IBAction)ignoreExt:(id)sender; - (IBAction)ignoreName:(id)sender; - (IBAction)copyLR:(id)sender; - (IBAction)copyRL:(id)sender; - (IBAction)leaveAlone:(id)sender; - (IBAction)forceOlder:(id)sender; - (IBAction)forceNewer:(id)sender; - (IBAction)selectConflicts:(id)sender; - (IBAction)revert:(id)sender; - (IBAction)merge:(id)sender; - (IBAction)showDiff:(id)sender; - (BOOL)canDiffSelection; @end @interface NSOutlineView (_UnisonExtras) - (NSArray *)selectedObjects; - (NSEnumerator *)selectedObjectEnumerator; - (void)setSelectedObjects:(NSArray *)selection; - (void)expandChildrenIfSpace; @end unison-2.32.52/uimacnew/ReconTableView.m0000644000076500000000000001545111176730177017511 0ustar bcpiercewheel// // ReconTableView.m // Unison // // Created by Trevor Jim on Wed Aug 27 2003. // Copyright (c) 2003. See file COPYING for details. // #import "ReconTableView.h" #import "ReconItem.h" #import "MyController.h" @implementation NSOutlineView (_UnisonExtras) - (NSArray *)selectedObjects { NSMutableArray *result = [NSMutableArray array]; NSEnumerator *e = [self selectedRowEnumerator]; NSNumber *n; while (n = [e nextObject]) [result addObject:[self itemAtRow:[n intValue]]]; return result; } - (void)setSelectedObjects:(NSArray *)selectedObjects { NSMutableIndexSet *set = [NSMutableIndexSet indexSet]; int i = [selectedObjects count]; while (i--) { int index = [self rowForItem:[selectedObjects objectAtIndex:i]]; if (index >= 0) [set addIndex:index]; } [self selectRowIndexes:set byExtendingSelection:NO]; } - (NSEnumerator *)selectedObjectEnumerator { return [[self selectedObjects] objectEnumerator]; } - (int)rowCapacityWithoutScrolling { float bodyHeight = [self visibleRect].size.height; bodyHeight -= [[self headerView] visibleRect].size.height; return bodyHeight / ([self rowHeight] + 2.0); } - (BOOL)_canAcceptRowCountWithoutScrolling:(int)rows { return ([self numberOfRows] + rows) <= [self rowCapacityWithoutScrolling]; } - (BOOL)_expandChildrenIfSpace:(id)parent level:(int)level { BOOL didExpand = NO; id dataSource = [self dataSource]; int count = [dataSource outlineView:self numberOfChildrenOfItem:parent]; if (level == 0) { if (count && ([self isItemExpanded:parent] || [self _canAcceptRowCountWithoutScrolling:count])) { [self expandItem:parent expandChildren:NO]; didExpand = YES; } } else { // try expanding each of our children. If all expand, then return YES, // indicating that it may be worth trying the next level int i; for (i=0; i < count; i++) { id child = [dataSource outlineView:self child:i ofItem:parent]; didExpand = [self _expandChildrenIfSpace:child level:level-1] || didExpand; } } return didExpand; } - (void)expandChildrenIfSpace { int level = 1; while ([self _expandChildrenIfSpace:nil level:level]) level++; } @end @implementation ReconTableView - (BOOL)editable { return editable; } - (void)setEditable:(BOOL)x { editable = x; } - (BOOL)validateItem:(IBAction *) action { if (action == @selector(selectAll:) || action == @selector(selectConflicts:) || action == @selector(copyLR:) || action == @selector(copyRL:) || action == @selector(leaveAlone:) || action == @selector(forceNewer:) || action == @selector(forceOlder:) || action == @selector(revert:) || action == @selector(ignorePath:) || action == @selector(ignoreExt:) || action == @selector(ignoreName:)) return editable; else if (action == @selector(merge:)) { if (!editable) return NO; else return [self canDiffSelection]; } else if (action == @selector(showDiff:)) { if ((!editable) || (!([self numberOfSelectedRows]==1))) return NO; else return [self canDiffSelection]; } else return YES; } - (BOOL)validateMenuItem:(NSMenuItem *)menuItem { return [self validateItem:[menuItem action]]; } - (BOOL)validateToolbarItem:(NSToolbarItem *)toolbarItem { return [self validateItem:[toolbarItem action]]; } - (void)doIgnore:(unichar)c { NSEnumerator *e = [self selectedObjectEnumerator]; ReconItem *item, *last = nil; while (item = [e nextObject]) { [item doIgnore:c]; last = item; } if (last) { // something was selected last = [[self dataSource] updateForIgnore:last]; [self selectRow:[self rowForItem:last] byExtendingSelection:NO]; [self reloadData]; } } - (IBAction)ignorePath:(id)sender { [self doIgnore:'I']; } - (IBAction)ignoreExt:(id)sender { [self doIgnore:'E']; } - (IBAction)ignoreName:(id)sender { [self doIgnore:'N']; } - (void)doAction:(unichar)c { int numSelected = 0; NSEnumerator *e = [self selectedObjectEnumerator]; ReconItem *item, *last = nil; while (item = [e nextObject]) { numSelected++; [item doAction:c]; last = item; } if (numSelected>0) { int nextRow = [self rowForItem:last] + 1; if (numSelected == 1 && [self numberOfRows] > nextRow && c!='d') { // Move to next row, unless already at last row, or if more than one row selected [self selectRow:nextRow byExtendingSelection:NO]; [self scrollRowToVisible:nextRow]; } [self reloadData]; } } - (IBAction)copyLR:(id)sender { [self doAction:'>']; } - (IBAction)copyRL:(id)sender { [self doAction:'<']; } - (IBAction)leaveAlone:(id)sender { [self doAction:'/']; } - (IBAction)forceOlder:(id)sender { [self doAction:'-']; } - (IBAction)forceNewer:(id)sender { [self doAction:'+']; } - (IBAction)selectConflicts:(id)sender { [self deselectAll:self]; NSMutableArray *reconItems = [[self dataSource] reconItems]; int i = 0; for (; i < [reconItems count]; i++) { ReconItem *item = [reconItems objectAtIndex:i]; if ([item isConflict]) [self selectRow:[self rowForItem:item] byExtendingSelection:YES]; } } - (IBAction)revert:(id)sender { [self doAction:'R']; } - (IBAction)merge:(id)sender { [self doAction:'m']; } - (IBAction)showDiff:(id)sender { [self doAction:'d']; } /* There are menu commands for these, but we add some shortcuts so you don't have to press the Command key */ - (void)keyDown:(NSEvent *)event { /* some keys return zero-length strings */ if ([[event characters] length] == 0) { [super keyDown:event]; return; } /* actions are disabled when when menu items are */ if (!editable) { [super keyDown:event]; return; } unichar c = [[event characters] characterAtIndex:0]; switch (c) { case '>': case NSRightArrowFunctionKey: [self doAction:'>']; break; case '<': case NSLeftArrowFunctionKey: [self doAction:'<']; break; case '?': case '/': [self doAction:'/']; break; default: [super keyDown:event]; break; } } - (BOOL)canDiffSelection { BOOL canDiff = YES; NSEnumerator *e = [self selectedObjectEnumerator]; ReconItem *item; while (item = [e nextObject]) { if (![item canDiff]) canDiff= NO; } return canDiff; } /* Override default highlight colour because it's hard to see the conflict/resolution icons */ - (id)_highlightColorForCell:(NSCell *)cell { if(([[self window] firstResponder] == self) && [[self window] isMainWindow] && [[self window] isKeyWindow]) return [NSColor colorWithCalibratedRed:0.7 green:0.75 blue:0.8 alpha:1.0]; else return [NSColor colorWithCalibratedRed:0.8 green:0.8 blue:0.8 alpha:1.0]; } @end unison-2.32.52/uimacnew/tableicons/0000755000076500000000000000000011222164527016567 5ustar bcpiercewheelunison-2.32.52/uimacnew/tableicons/Change_Absent.png0000644000076500000000000000105311176730177021765 0ustar bcpiercewheelPNG  IHDRagAMAOX2tEXtSoftwareAdobe ImageReadyqe<IDATxb?% (cڹY\貔ziIFFƏLLLǁx!Pn/L;@`1MJXXߢ?~T{(А@꾁@ӥTUUbx;w2   0jaG ll *** ZZ $@pͫ77h ///τ0l@uPu` 013 ( {!AlbB2u 2^/^`x-333(M0r, QLY9ᮓf{["P fco;KXP#@A gU o~Ub@L,("@p3ecf<TrdPT˯' b q o wn?f~)0:1 822cE/28@c.ߜ=e`Vo7#|lrvRk3-:a奍@1| \*J~=H@$$` P&g>jP k2EWY7L@1R`X:RIENDB`unison-2.32.52/uimacnew/tableicons/Change_Deleted.png0000644000076500000000000000144711176730177022126 0ustar bcpiercewheelPNG  IHDRagAMAOX2tEXtSoftwareAdobe ImageReadyqe<IDATxb?% (ct20033aea`SZo=ؾ哰7Rka?bbA6?ȓQWn4MчϜop;7,>aw^;xnjv@pp}˩s~gWQd```m oпTA7?v`800|:xӮ(OO0  Ad3 'A0ďA 5pr24V0[ & qscڜ l y×g MFPˏK@bKy>HK~eP,góI99 `2ϊ>xG_/_DJ pBק/y_Ma bacej3oNvA_~qel߾a;PSx )͍Dqn0F$Ԁ5 IENDB`unison-2.32.52/uimacnew/tableicons/Change_Modified.png0000644000076500000000000000140511176730177022272 0ustar bcpiercewheelPNG  IHDRagAMAOX2tEXtSoftwareAdobe ImageReadyqe<IDATxb?% )5 ԶLd^?/p$edIQ nAC}u@c<X*v~?5lj?ﾱV 1h߿'SϿLt`-dddaU VVG/>3y 20K3۷o@| xprrZ98433'/o.H@! (dafb`j >H*&&x"H@b3P|K؀@@H䙘AH@ (! cg3@Y  ^*:   4_iT/@n?&(] ?ӿT[@p~R/@M?@i/@9˺@ ?SLǏxxxzϠtrP{>A-i]PVn$`, /t+YLXa@F*[:IENDB`unison-2.32.52/uimacnew/tableicons/Outline-Deep.png0000644000076500000000000000073311176730177021602 0ustar bcpiercewheelPNG  IHDR $ pHYs  gAMA cHRMn rIm?m1JQIDATxb?-@`|ӿ@Y\BBbV â]ӧO @3b@1b Oz|ϟ _`S􏃃77ii, FBqp0ZA) *j.^gff$ Fb͛7`aXYY>"^^^ @0h 8D8H[[{.}HjN>qd (0accHUUm6D|||T@,fv"g4| i]@s%dIENDB`unison-2.32.52/uimacnew/tableicons/Outline-Flat.png0000644000076500000000000000101211176730177021602 0ustar bcpiercewheelPNG  IHDR $ pHYs  gAMA cHRMn rIm?m1JIDATxb?-1@0o޼q3LLL@XDDd@ϟ?,;7ot&@8-/өSBȻ耑z  accbC-`b?ff?XYY`3 pZrFl.ǦX pZr3g (p ]qr5(@A L@8-x򥘕Jbr;xϞ=T "AA ?P*PRH011-`666 XD{{ѩӧ fCG2H@R hn@*?DNIENDB`unison-2.32.52/uimacnew/tableicons/Outline-Flattened.png0000644000076500000000000000076711176730177022642 0ustar bcpiercewheelPNG  IHDR $ pHYs  gAMA cHRMn rIm?m1JmIDATxb?-@xӿ@ ], E]]}'>?~d$d@1 Oz|ϟ _`S􏃃77iij_~= h 133cgg9HL$U q@8-x(~_ ,Y@D֭[A@(h899闀tDګ̲y\?f^"N.o(?$x0accƆ=QAG0N>] ݻS- v# ;bb1 [`[&IENDB`unison-2.32.52/uimacnew/tableicons/table-conflict.tif0000644000076500000000000001217011176730177022172 0ustar bcpiercewheelMM*yz@Ae("bd |ACa9%WY-.N9*_`UV  /*ef|~DEo%GHm<=u #%"=>fR 1}~%WXPRx  FGKRRRDEI73 ln  ps /0\45d;*+M####34a"tv6  "(1:*2dLR./table-conflict.tifHHImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org2006:04:01 17:06:34unison-2.32.52/uimacnew/tableicons/table-error.tif0000644000076500000000000001220611176730177021522 0ustar bcpiercewheelMM*<jlde'(7?{}su'(:mo{}suXY{}}~rsce{}suoqce}cdprabmoprrs}suacqs{} sucd}~|} gice{}ac()9ce{} 3''7WX_` /6  $(0(1:82rLRtable3-smallerfiles/table-error.tifHHImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org2006:04:09 19:39:02unison-2.32.52/uimacnew/tableicons/table-left-blue.tif0000644000076500000000000001217011176730177022250 0ustar bcpiercewheelMM* 8 \D. ]:'y[>ݗԑٔ@,} EuܗяяҏÆxwwwwvrrrrrxyxxyvߦrW< ,L4ٕՒяяяяҐӑӑӑӑӑԑԑԑԑԑԑҐҐҐҐҐӐӑwQ -O6ڕՒяяяяҐӐҐҐҐҐҐҐҐҐҐҐҐҐҐҐҐҐӐ~V GuܖяяяŇtO^@ݗԑٔ@,}"^9'y!]C. >6  "(1:*2dLR./table-left-blue.tifHHImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org2006:04:01 20:53:25unison-2.32.52/uimacnew/tableicons/table-left-green.tif0000644000076500000000000001217211176730177022423 0ustar bcpiercewheelMM*5 >N)3Z8Fwd|>M{$BߢSh)Yps+Xnz$Dqg=L{+6[7Ew @O #;6  $(1:,2fLR./table-left-green.tifHHImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org2006:04:01 20:53:31unison-2.32.52/uimacnew/tableicons/table-merge.tif0000644000076500000000000001216411176730177021473 0ustar bcpiercewheelMM* B9[^7%iA^\ + =kI`B 4$a֒ؔlW<ݗؔ ImJkIaCk >1"[֒Ց֓ ?zדؔ EKwaBfEڕד֒:(2"[ԑpޘF0[Ӑ}ۖ E J2ٕՒדbCsڶ|~ɊҏяҐޘ[)3#[ٔI2…prN]Wߘ D 5fݗҏяҏƈ|}kLjӐӐҏяяяяٔ̌(g(V&cpM ?͌-iySܗ D1!x֒דяяяяҏӐՑ~ŇҐӐҏяяяяؔ͌)i(V W%f?+]͌]ܖ D3"z֒דяяяяҏӐԑ~vݹʊяяҐݗ]*3#[ޘ'_͌ogkIdݗ D 6iݗяяҐLj}nfEڕדד<)2"[ݘ-fwQݗޘYcݗ E L4ڕՒדdCaCl ?1"[ޘ. g(obޗ ELwaBkI`A 2"\ݘ.h&l Nbݗ FoLkIK %W#C%WE6  (1:&2`LR./table-merge.tifHHImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org2006:04:01 17:05:15unison-2.32.52/uimacnew/tableicons/table-mixed.tif0000644000076500000000000004612011176730177021501 0ustar bcpiercewheelMM*6<0(124RHI'iL$ ' 'Adobe Photoshop Elements 2.02007:04:28 15:25:55 Adobe Photoshop Elements for Macintosh, version 2.0 adobe:docid:photoshop:e59d3026-f72e-11db-955e-fba283ce9e55 8BIM%8BIM com.apple.print.PageFormat.PMHorizontalRes com.apple.print.ticket.creator com.apple.printingmanager com.apple.print.ticket.itemArray com.apple.print.PageFormat.PMHorizontalRes 72 com.apple.print.ticket.client com.apple.printingmanager com.apple.print.ticket.modDate 2007-04-28T22:24:34Z com.apple.print.ticket.stateFlag 0 com.apple.print.PageFormat.PMOrientation com.apple.print.ticket.creator com.apple.printingmanager com.apple.print.ticket.itemArray com.apple.print.PageFormat.PMOrientation 1 com.apple.print.ticket.client com.apple.printingmanager com.apple.print.ticket.modDate 2007-04-28T22:24:34Z com.apple.print.ticket.stateFlag 0 com.apple.print.PageFormat.PMScaling com.apple.print.ticket.creator com.apple.printingmanager com.apple.print.ticket.itemArray com.apple.print.PageFormat.PMScaling 1 com.apple.print.ticket.client com.apple.printingmanager com.apple.print.ticket.modDate 2007-04-28T22:24:34Z com.apple.print.ticket.stateFlag 0 com.apple.print.PageFormat.PMVerticalRes com.apple.print.ticket.creator com.apple.printingmanager com.apple.print.ticket.itemArray com.apple.print.PageFormat.PMVerticalRes 72 com.apple.print.ticket.client com.apple.printingmanager com.apple.print.ticket.modDate 2007-04-28T22:24:34Z com.apple.print.ticket.stateFlag 0 com.apple.print.PageFormat.PMVerticalScaling com.apple.print.ticket.creator com.apple.printingmanager com.apple.print.ticket.itemArray com.apple.print.PageFormat.PMVerticalScaling 1 com.apple.print.ticket.client com.apple.printingmanager com.apple.print.ticket.modDate 2007-04-28T22:24:34Z com.apple.print.ticket.stateFlag 0 com.apple.print.subTicket.paper_info_ticket com.apple.print.PageFormat.PMAdjustedPageRect com.apple.print.ticket.creator com.apple.printingmanager com.apple.print.ticket.itemArray com.apple.print.PageFormat.PMAdjustedPageRect 0.0 0.0 734 576 com.apple.print.ticket.client com.apple.printingmanager com.apple.print.ticket.modDate 2007-04-28T22:24:37Z com.apple.print.ticket.stateFlag 0 com.apple.print.PageFormat.PMAdjustedPaperRect com.apple.print.ticket.creator com.apple.printingmanager com.apple.print.ticket.itemArray com.apple.print.PageFormat.PMAdjustedPaperRect -18 -18 774 594 com.apple.print.ticket.client com.apple.printingmanager com.apple.print.ticket.modDate 2007-04-28T22:24:37Z com.apple.print.ticket.stateFlag 0 com.apple.print.PaperInfo.PMPaperName com.apple.print.ticket.creator com.apple.print.pm.PostScript com.apple.print.ticket.itemArray com.apple.print.PaperInfo.PMPaperName na-letter com.apple.print.ticket.client com.apple.print.pm.PostScript com.apple.print.ticket.modDate 2003-07-01T17:49:36Z com.apple.print.ticket.stateFlag 1 com.apple.print.PaperInfo.PMUnadjustedPageRect com.apple.print.ticket.creator com.apple.print.pm.PostScript com.apple.print.ticket.itemArray com.apple.print.PaperInfo.PMUnadjustedPageRect 0.0 0.0 734 576 com.apple.print.ticket.client com.apple.printingmanager com.apple.print.ticket.modDate 2007-04-28T22:24:34Z com.apple.print.ticket.stateFlag 0 com.apple.print.PaperInfo.PMUnadjustedPaperRect com.apple.print.ticket.creator com.apple.print.pm.PostScript com.apple.print.ticket.itemArray com.apple.print.PaperInfo.PMUnadjustedPaperRect -18 -18 774 594 com.apple.print.ticket.client com.apple.printingmanager com.apple.print.ticket.modDate 2007-04-28T22:24:34Z com.apple.print.ticket.stateFlag 0 com.apple.print.PaperInfo.ppd.PMPaperName com.apple.print.ticket.creator com.apple.print.pm.PostScript com.apple.print.ticket.itemArray com.apple.print.PaperInfo.ppd.PMPaperName US Letter com.apple.print.ticket.client com.apple.print.pm.PostScript com.apple.print.ticket.modDate 2003-07-01T17:49:36Z com.apple.print.ticket.stateFlag 1 com.apple.print.ticket.APIVersion 00.20 com.apple.print.ticket.privateLock com.apple.print.ticket.type com.apple.print.PaperInfoTicket com.apple.print.ticket.APIVersion 00.20 com.apple.print.ticket.privateLock com.apple.print.ticket.type com.apple.print.PageFormatTicket 8BIMxHH@Rg(HH(dh 8BIMHH8BIM&?8BIM Transparency8BIM Transparency8BIMd8BIM8BIM 8BIM8BIM 8BIM 8BIM' 8BIMH/fflff/ff2Z5-8BIMp8BIM8BIM8BIM@@8BIM8BIMK6 table-mixed6nullboundsObjcRct1Top longLeftlongBtomlongRghtlong6slicesVlLsObjcslicesliceIDlonggroupIDlongoriginenum ESliceOrigin autoGeneratedTypeenum ESliceTypeImg boundsObjcRct1Top longLeftlongBtomlongRghtlong6urlTEXTnullTEXTMsgeTEXTaltTagTEXTcellTextIsHTMLboolcellTextTEXT horzAlignenumESliceHorzAligndefault vertAlignenumESliceVertAligndefault bgColorTypeenumESliceBGColorTypeNone topOutsetlong leftOutsetlong bottomOutsetlong rightOutsetlong8BIM8BIM8BIM 6 fJFIFHH Adobe_CMAdobed            6"?   3!1AQa"q2B#$Rb34rC%Scs5&DTdE£t6UeuF'Vfv7GWgw5!1AQaq"2B#R3$brCScs4%&5DTdEU6teuFVfv'7GWgw ?Ui{ƉsJԺn'S~[K鳐 ij R7Z&<&C83GVkE4qʱsuo[vY]L6Z78?lV3.ہu?p-w~s]m]W݁k[.$ms_@Ώףw&!$9Jik`eyBC2iykZH}SUttv*3?@=g-\]Z0I'O9,fDz,qr93e]$Oj?Tʩ$ꤗʩ$ꤗʩ$ꤗʩ$8BIM!yAdobe Photoshop ElementsAdobe Photoshop Elements 2.0% (  3% |7)H#N59)"!7* z0#t1%!   5(! *",/'*/#  !-$(#% ty  ! !!f/$o"%d+ m!  !!   !! 2%#% "^,"f!      !  !!   ! ! /$#%2$! ! !   !    s."m."x !    B KH R@ I"! )"37/3*" 7) 2%   6' 7) G%M!#Z0%a "6unison-2.32.52/uimacnew/tableicons/table-right-blue.tif0000644000076500000000000001217211176730177022435 0ustar bcpiercewheelMM* 8D.\ :'y ]@,}ٔԑݗ[>W<rެv߱yxxyxrrrrrvwwwwxÆҏяяܗu EwQӑӐҐҐҐҐҐԑԑԑԑԑԑӑӑӑӑӑҐяяяяՒٕL4 ,~VӐҐҐҐҐҐҐҐҐҐҐҐҐҐҐҐҐӐҐяяяяՒڕO6 -tOŇяяяܖu G@,}ٔԑݗ^@9'y"^C.]! >6  $(1:,2fLR./table-right-blue.tifHHImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org2006:04:01 20:53:21unison-2.32.52/uimacnew/tableicons/table-right-green.tif0000644000076500000000000001217211176730177022606 0ustar bcpiercewheelMM*5>N 8Fw)3Z>M{d|Shݩ߬$BsYp)zXn+q$D=L{g7Ew+6[@O #; 6  $(1:,2fLR./table-right-green.tifHHImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org2006:04:01 20:53:20unison-2.32.52/uimacnew/tableicons/table-skip.tif0000644000076500000000000001216411176730177021342 0ustar bcpiercewheelMM* .+)83#=,:- 'crOmչ~ŇａnyS:'u ;)ܗדӑҐяҏӐ֒ۖЏX<!cޘӐяדۖ֒яԑڕٔяяܗ} C sۖЎՒדuQ,f 4 " -#X]@ύؓЎ֓Ў FzSݘЎדz E (^ەЎؔzVܗяՒ+ `ٕяߙ?+iHܖяܗ,u ?ӑҐדo ȉܗܖ֓ &eؔӐ͌.t>*A,2"v 2lKfF|ԑяҐ{ToL0!{I2ҐяяяߙyjHݗяяՒÆ2fڕҐٔU*4#Y[? @6  (1:&2`LR./table-skip.tifHHImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org2006:04:01 17:06:46unison-2.32.52/uimacnew/toolbar/0000755000076500000000000000000011222164527016106 5ustar bcpiercewheelunison-2.32.52/uimacnew/toolbar/add.tif0000644000076500000000000001256011176730177017356 0ustar bcpiercewheelMM*&FO6^@_AaB`A]@Y=E0$F:'hjI\?Z=qM^fgaxR_AW<Z>1"f2rNeFtPzٔߘۖۖޘܗ[`B`B 0"R_nL}֓nc^^cnՒƈ{UoL(OQc\ӑڕ}`zSwQxRySySxRwQzT`}ؔڕiYM /jdהҐnXX[[[[[[[[XXoяܖpY ,}VʘiяҐl\````adda````\mяؔphG,fuؔtaddddhpM,,oLhddddauՒ͌q(baرzؓgiiiiiocDbCoiiiiigؔXEŇӑtlmmmmmsjHiGsmmmmmktҐ΍|AT9ѐƈpqqqqqqwnKmJwqqqqqqpLjՑĆK3]ƈԑsuuy{{{wRvQ{{{yuusՒˋWtʊӑxyz\tOtOtOzSM4L4zStOtOtO]zyxӑ͍p̌Ґ{|2"6%|{ҏЎώҏ~„3#7%…~яҐxҐҐĆc|U}U}UZR8R8Z}U}U|UdÆЎӑt^֓ЎLjȉˋˋˋ֓\[֓ˋˋˋȉƈ̌ד[Q7ۖ̋ÅƇćŇŇŇŇŇώYXώŇŇŇŇŇŇƇĆˋۖM5DדЏɉȉljljljljljҐZZҐljljljljljljɉЎד?hڕ΍ʊʊʊʊʊ֒YX֒ʊʊʊʊʊ΍ەf(dݗЎoƇώ̌̌̌̌ԑlC.C.lԑ̌̌̌̌ώLjoύݗ$`\ޘďҐ΍΍΍΍яדדя΍΍΍΍ҐΌeߙW ,ۖyZĆؔЏώЎЎЎЎЎЎώЏؔƇ[xݗ)Nӑܖ{rNjҐۖ֓ӐҐҐӐ֒ۖӑlrNyݗˋJ'OޘɉZfF\wĆ͌͌Ňx]fFXȉߘK /^ۖޘ…akI_A^@^@_AjH`ߘܖ] ,"&6%}i דޘӑʊʊӑޘؔg0!{ #11333327"&hV;] ʫuῃￂt^ U: &h263333.. ))&&     3(1:"2\LR./add.tif% % ImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org2006:03:24 23:55:37unison-2.32.52/uimacnew/toolbar/diff.tif0000644000076500000000000001256211176730177017540 0ustar bcpiercewheelMM*&FO6^@_AaB`A]@Y=E0$F:'hjI\?Z=qM^fgaxR_AW<Z>1"f2rNeFtPzٔߘۖۖޘܗ[`B`B 0"R_nL}֓nc^^cnՒƈ{UoL(OQc\ӑڕ}`zSwQxRySySxRwQzT`}ؔڕiYM /jdהҐnXZ_a`][[[[XXoяܖpY ,}VʘiяҐl\d[cDS9^@Wea````\mяؔphG,fuؔtajeE R8heddddauՒ͌q(baرzؓgnmJ8&Z=C.R8niiiiigؔXEŇӑtmkiHutvX `pmmmmktҐ΍|AT9ѐƈpvX/ xrqq{O6dExqqqqqpLjՑĆK3]ƈԑs{vQL4}uuu|qMU;|uuuuusՒˋWtʊӑx}^0!yyyS9kJyyyyyxӑ͍p̌Ґ{}{sO……Æa  r|||||{ҏЎώҏ~…]=*fFJ3 fŇ~яҐxҐҐĆLj\ jȉÆЎӑt^֓ЎLjˋbyS]~tp̌ƈ̌ד[Q7ۖ̋ÅƇćŇŇĆLj͌ώ΍ȉώruύĆŇƇĆˋۖM5DדЏɉȉljljljljljljljljLjӐr zώLjɉЎד?hڕ΍ʊʊʊʊʊʊʊʊʊʊ֒n Ґەf(dݗЎoƇώ̌̌̌̌̌̌̌̌̌̌ٔl >+ȉʊoύݗ$`\ޘďҐ΍΍΍΍΍΍΍΍΍΍֓tˋҐeߙW ,ۖyZĆؔЏώЎЎЎЎЎЎώЎߙȉZxݗ)Nӑܖ{rNjҐۖ֓ӐҐҐӐ֒ۖӑlrNyݗˋJ'OޘɉZfF\wĆ͌͌Ňx]fFXȉߘK /^ۖޘ…akI_A^@^@_AjH`ߘܖ] ,"&6%}i דޘӑʊʊӑޘؔg0!{ #11333327"&hV;] ʫuῃￂt^ U: &h263333.. ))&&     3(1:$2^LR./diff.tif% % ImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org2006:03:25 21:56:38unison-2.32.52/uimacnew/toolbar/go.tif0000644000076500000000000001256011176730177017233 0ustar bcpiercewheelMM*&/HN`\q^s_u]t[qWkDT#,G9GjiZpXknu]rUjYo1>h3qc|r^v]u0"*Tlyl(2Q"SwtuvvutwO 1}~~} -{̕g,7h'1c٭#FThM`BShI["mJ\Nb.9|QdCTSh SgUj YoWlK^Yo6CPcVk$-L_Ekd~A(1f#,a~ . * PpoL'1Pc{d{~%M0h]s\q\q\rg-"&5B~ 0;| #11333327"+%iVi ˨ Th (&i273333.. ))&&     3(1:"2\LR./go.tif% % ImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org2006:03:24 23:54:39unison-2.32.52/uimacnew/toolbar/left.tif0000644000076500000000000001256211176730177017562 0ustar bcpiercewheelMM*&FO6^@_AaB`A]@Y=E0$F:'hjI\?Z=qM^fgaxR_AW<Z>1"f2rNeFtPzٔߘۖۖޘܗ[`B`B 0"R_nL}֓nc^^cnՒƈ{UoL(OQc\ӑڕ}`zSwQxRySySxRwQzT`}ؔڕiYM /jdהҐnXX[[[[[[[[XXoяܖpY ,}VʘiяҐl\````````````\mяؔphG,fuؔtaddddddddedddddauՒ͌q(baرzؓgiiiiiiijnihiiiiigؔXEŇӑtlmmmmmnsn[>I2qmmmmmktҐ΍|AT9ѐƈpqqqqqvwzS%6$wqqqqqqpLjՑĆK3]ƈԑsuuux|c:'@+}}}|uusՒˋWtʊӑxyyqQ8]@Y=Y=Y=gFwyxӑ͍p̌Ґ{}|cD  y}{ҏЎώҏ~~jI  |~яҐxҐҐĆɉyZ> "gGcCcCbCqMÆЎӑt^֓ЎLjƇ͌rD/H1ד͌͌͌ˋ…ƈ̌ד[Q7ۖ̋ÅƇćŇŇĆĆ̋͌e0 ?+΍ŇŇŇŇŇŇƇĆˋۖM5DדЏɉȉljljljljLjȉяʊvQ_@͌ljljljljljljɉЎד?hڕ΍ʊʊʊʊʊʊʊ̋ԑʊʊʊʊʊʊʊ΍ەf(dݗЎoƇώ͍̌̌̌̌̌̌̌̌̌̌̌̌̌ώLjoύݗ$`\ޘďҐ΍΍΍΍΍΍΍΍΍΍΍΍ҐΌeߙW ,ۖyZĆؔЏώЎЎЎЎЎЎώЏؔƇ[xݗ)Nӑܖ{rNjҐۖ֓ӐҐҐӐ֒ۖӑlrNyݗˋJ'OޘɉZfF\wĆ͌͌Ňx]fFXȉߘK /^ۖޘ…akI_A^@^@_AjH`ߘܖ] ,"&6%}i דޘӑʊʊӑޘؔg0!{ #11333327"&hV;] ʫuῃￂt^ U: &h263333.. ))&&     3(1:$2^LR./left.tif% % ImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org2006:03:24 23:55:51unison-2.32.52/uimacnew/toolbar/merge.tif0000644000076500000000000001256211176730177017727 0ustar bcpiercewheelMM*&FO6^@_AaB`A]@Y=E0$F:'hjI\?Z=qM^fgaxR_AW<Z>1"f2rNeFtPzٔߘۖۖޘܗ[`B`B 0"R_nL}֓nc^^cnՒƈ{UoL(OQc\ӑڕ}`zSwQxRySySxRwQzT`}ؔڕiYM /jdהҐnXX[[[[[[[[XXoяܖpY ,}VʘiяҐl\````````````\mяؔphG,fuؔtbddddddddddddddauՒ͌q(baرzؓghnjiiiiiiiiiijnigؔXEŇӑtqT9R8ltnmmmmmmnspaCB-ntҐ΍|AT9ѐƈpxG1rNuwrqqquwX+)vqLjՑĆK3]ƈԑ{R82"^|xw}gA,3#|ÆԑˋWtʊדsX=^A(H2nuY= ]@X<`͍ٔp̌ٔe  U:ޘЎώٔg V;ݘҐxҐ֓ybChH,Q7v~cC fFbCdՒӑt^֓ώʊٕ̌\?:(ľLjŇ͍vM59'Ւ͍̌̋ד\Q7ۖ̋ÅƈЏT9&^ʊ͌ŇĆĆĆˋ΍j7%/!̌ƈĆˋۖN5DדЏȉЏkIjIŇӐȉLjljljljljLjȉЏ͌~VU:ˋɊЎד@hڕ΍ɉӑ͌ʊʊʊʊʊʊʊʊʊʊˋԑˋ͌ۖf(dݗЎoŇЏ̌̌̌̌̌̌̌̌̌̌̌̌̌̌ЎLjoύݗ$`\ޘďҐ΍΍΍΍΍΍΍΍΍΍΍΍ҐΌeߙW ,ۖyZĆؔЏώЎЎЎЎЎЎώЏؔƇ[xݗ)Nӑܖ{rNjҐۖ֓ӐҐҐӐ֒ۖӑlrNyݗˋJ'OޘɉZfF\wĆ͌͌Ňx]fFXȉߘK /^ۖޘ…akI_A^@^@_AjH`ߘۖ] ,"&6%}i דޘӑʊʊӑޘؔg0!{ #11333327"&hV;] ʫuῃￂt^ U: &h263333.. ))&&     3(1:$2^LR./merge.tif% % ImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org2006:03:24 23:56:07unison-2.32.52/uimacnew/toolbar/quit.tif0000644000076500000000000001256211176730177017612 0ustar bcpiercewheelMM*/0H_`qqssturtpqjkST+,GFGjnpjkqrhjmo<=h3z|tvtv0**T12Q!"SO 1 -~77h01dvxuw##FrtprBfhwxuw[\{}}~bc^_E"#$$A01f+,a - * PL01Pz{z{$%M0rspqprqr~-"&AB~ :;| #11333327*+%iii  gh((&i273333.. ))&&     3(1:$2^LR./quit.tif% % ImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org2006:03:24 23:56:18unison-2.32.52/uimacnew/toolbar/rescan.tif0000644000076500000000000001261011176730177020075 0ustar bcpiercewheelMM*&FO6^@_AaB`A]@Y=E0$F:'hjI\?Z=qM^fgaxR_AW<Z>1"f2rNeFtPzٔߘۖۖޘܗ[`B`B 0"R_nL}֓nc^^cnՒƈ{UoL(OQc\ӑڕ}`zSwQxRySySxRwQzT`}ؔڕiYM /jdהҐnXX[[]^^][[XXoяܖpY ,}VʘiяҐl\``ddZvQvQZdd`_\mяؔphG,fuؔtadejqM1"  2"qMjedauՒ͌q(baرzؓgijlJ2K3ljigؔXEŇӑtlmsN6 1"1! O6smktҐ΍|AT9ѐƈpqvWT:mvvlS9YvqpLjՑĆK3]ƈԑsuz7&V;~wuux~S9;(zusՒˋWtʊӑx{q  t{yyyx}y x~wӑ͍p̌Ґ{h7&||||XI2 >*nK~ҏЎώҏ~k8&…s bяҐxҐҐĆz |…ȉ_jIʊÆЎӑt^֓ЎLj…ʊ?,_Aяƈ…„͌[>7&LjÆƈ̌ד[Q7ۖ̋ÅƇĆ͌haB͌LjĆĆȉ?+rˋĆƇĆˋۖM5DדЏȉȉȉҐeE8&v͌ljLjʊljʊLjljɉЎד?hڕ΍ʊ̌яfEnӐʊʊʊ̋ʊʊ΍ەf(dݗЎoƇώ̌΍דmI2qԑ̌̌̌̌̌ώLjoύݗ$`\ޘďҐ΍΍֓דĆzljώ΍΍΍΍ҐΌeߙW ,ۖyZĆؔЏώЎӐՒяώЎώЏؔƇ[xݗ)NҐܖ{rNjҐۖ֓ӐҐҐӐ֒ۖӑlrNyݗˋJ(OޘɉZfF\wĆ͌͌Ňx]fFXȉߘK /]ۖޘ…akI_A^@^A_AjH`ߘۖ\ ,"&6%}i דޘӑʊʊӑޘؔg2"{ #11333327"&hV;] ʫuῂￃt] W;!&h263333.. ))&&    !3*2(1::2tLR../final-smallerfiles/rescan.tif% % ImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org2006:04:04 22:31:24unison-2.32.52/uimacnew/toolbar/restart.tif0000644000076500000000000001256411176730177020316 0ustar bcpiercewheelMM*&FO6^@_AaB`A]@Y=E0$F:'hjI\?Z=qM^fgaxR_AW<Z>1"f2rNeFtPzٔߘۖۖޘܗ[`B`B 0"R_nL}֓nc^^cnՒƈ{UoL(OQc\ӑڕ}`zSwQxRySySxRwQzT`}ؔڕiYM /jdהҐnXX[[]^^][[XXoяܖpY ,}VʘiяҐl\``ddZvQvQZdd`_\mяؔphG,fuؔtadejqM1"  2"qMjedauՒ͌q(baرzؓgijlJ2K3ljigؔXEŇӑtlmsN6 1"1! O6smktҐ΍|AT9ѐƈpqvWT:mvvlS9YvqpLjՑĆK3]ƈԑsuz7&V;~wuux~S9;(zusՒˋWtʊӑwx |~xyyy{r  r{xӑ͍p̌Ґ}rOH1W;\||||4#j{ҏЎώҏ[ p„5$m~яҐxҐҐĆʊ^@\ȉ…{  {ÆЎӑt^֓ЎLjĆÆ-T:͌„…ƈя\?C.ʋ…ƈ̌ד[Q7ۖ̋ÅƇĆ͌m5$ȉĆĆLj͌_AǰĆƇĆˋۖM5DדЏɉȉLjʊÅʋLjlj͌v8& fFҐȈljɉЎד?hڕ΍ʊʊ̌ʊʊʊӐlgGя̋ʊ΍ەf(dݗЎoƇώ̌̌̌̌̌ԑpJ3oד΍̌ώLjoύݗ$`\ޘďҐ΍΍΍΍ώLjzĆה֓΍΍ҐΌeߙW ,ۖyZĆؔЏώЎώяՒӐЎώЏؔƇ[xݗ)Nӑܖ{rNjҐۖ֓ӐҐҐӐ֒ۖӑlrNyݗˋJ'OޘɉZfF\wĆ͌͌Ňx]fFXȉߘK /^ۖޘ…akI_A^@^@_AjH`ߘܖ] ,"&6%}i דޘӑʊʊӑޘؔg0!{ #11333327"&hV;] ʫuῃￂt^ U: &h263333.. ))&&    3(1:&2`LR./restart.tif% % ImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org2006:03:24 23:56:31unison-2.32.52/uimacnew/toolbar/right.tif0000644000076500000000000001256211176730177017745 0ustar bcpiercewheelMM*&FO6^@_AaB`A]@Y=E0$F:'hjI\?Z=qM^fgaxR_AW<Z>1"f2rNeFtPzٔߘۖۖޘܗ[`B`B 0"R_nL}֓nc^^cnՒƈ{UoL(OQc\ӑڕ}`zSwQxRySySxRwQzT`}ؔڕiYM /jdהҐnXX[[[[[[[[XXoяܖpY ,}VʘiяҐl\````````````\mяؔphG,fuؔtadddddeedddddddauՒ͌q(baرzؓgiiiiiiglliiiiiiigؔXEŇӑtlmmmmmq}V9'^tpmmmmmktҐ΍|AT9ѐƈpqqqqqqwX Q8lxsqqqqpLjՑĆK3]ƈԑsuux}}}bjHv{uuusՒˋVtʊӑxy|_Y=Y=Y=]@F0(Z~|xxӑ͍p̌Ґ{|bC5$i{ҏЎώҏ~ŇeE;)m~яҐxҐҐĆÆgbCcCcCgFM4. aLjÅÆЎӑt^֓ЎLjLj͌͌͌֒n|UĆˋ…ƈ̌ד[Q7ۖ̋ÅƇćŇŇŇŇŇ͌h eEЏƈĆŇŇŇƇĆˋۖM5DדЏɉȉljljljljljΎlK4xԑˋLjljljljljljɉЎד?hڕ΍ʊʊʊʊʊʊȉяЎʊʊʊʊʊʊʊ΍ەf(dݗЎoƇώ̌̌̌̌̌͌͌̌̌̌̌̌̌̌ώLjoύݗ$`\ޘďҐ΍΍΍΍΍΍΍΍΍΍΍΍ҐΌeߙW ,ۖyZĆؔЏώЎЎЎЎЎЎώЏؔƇ[xݗ)Nӑܖ{rNjҐۖ֓ӐҐҐӐ֒ۖӑlrNyݗˋJ'OޘɉZfF\wĆ͌͌Ňx]fFXȉߘK /^ۖޘ…akI_A^@^@_AjH`ߘܖ] ,"&6%}i דޘӑʊʊӑޘؔg0!{ #11333327"&hV;] ʫuῃￂt^ U: &h263333.. ))&&     3(1:$2^LR./right.tif% % ImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org2006:03:24 23:56:45unison-2.32.52/uimacnew/toolbar/save.tif0000644000076500000000000001256211176730177017566 0ustar bcpiercewheelMM*/0H_`qqssturtpqjkST+,GFGjnpjkqrhjmo<=h3z|tvtv0**T12Q!"SO 1 -~77h01dcece##F###$Bfh[\ !!!z|xz}{|%&%&bc ^_E/000A01f+,a - * PL01Pz{z{$%M0rspqprqr~-"&AB~ :;| #11333327*+%iii  gh((&i273333.. ))&&     3(1:$2^LR./save.tif% % ImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org2006:03:24 23:57:01unison-2.32.52/uimacnew/toolbar/skip.tif0000644000076500000000000001256211176730177017576 0ustar bcpiercewheelMM*&FO6^@_AaB`A]@Y=E0$F:'hjI\?Z=qM^fgaxR_AW<Z>1"f2rNeFtPzٔߘۖۖޘܗ[`B`B 0"R_nL}֓nc^^cnՒƈ{UoL(OQc\ӑڕ}`zSwQxRySySxRwQzT`}ؔڕiYM /jdהҐnXX[[[[[[[[XXoяܖpY ,}VʘiяҐl\````acca````\mяؔphG,fuؔtadddhjbXXbjhdddauՒ͌q(baرzؓgiiio\A-B-\oiiigؔXEŇӑtlmmslI  mJsmmktҐ΍|AT9ѐƈpqqwxRyRwqqpLjՑĆK3]ƈԑsuwnqMhhpMowusՒˋWtʊӑxy_Ap||obCyxӑ͍p̌Ґ{}}&\{||{Ň_){ҏЎώҏ~s p^ [d}яҐxҐҐĆÆn @,ƈÅl V;ĆÆЎӑt^֓ЎLj…sry…͍tP(Æƈ̌ד[Q7ۖ̋ÅƇĆŇʊʊȉĆŇŇŇŇŇƈ̌A- o͍ƇĆˋۖM5DדЏɉȉljljljljljljljljljljLj΍~ mKՒLjɉЎד?hڕ΍ʊʊʊʊʊʊʊʊʊʊʊʊЎtŇ̋΍ەf(dݗЎoƇώ̌̌̌̌̌̌̌̌̌̌̌̌Ґ΍ύLjoύݗ$`\ޘďҐ΍΍΍΍΍΍΍΍΍΍΍΍ҐΌeߙW ,ۖyZĆؔЏώЎЎЎЎЎЎώЏؔƇ[xݗ)Nӑܖ{rNjҐۖ֓ӐҐҐӐ֒ۖӑlrNyݗˋJ'OޘɉZfF\wĆ͌͌Ňx]fFXȉߘK /^ۖޘ…akI_A^@^@_AjH`ߘܖ] ,"&6%}i דޘӑʊʊӑޘؔg0!{ #11333327"&hV;] ʫuῃￂt^ U: &h263333.. ))&&     3(1:$2^LR./skip.tif% % ImageMagick 6.1.8 04/01/06 Q16 http://www.imagemagick.org2006:03:24 23:57:11unison-2.32.52/uimacnew/TrevorsUnison.icns0000644000076500000000000005774411176730177020213 0ustar bcpiercewheelicns_it32!!!!####!##!!##!#11##11#!##!!##!#11##11#!##!!##! #11# #11#!##!!##!#11##11#!##!!##!#11##11#!##!!##!#11##11#"##!!##!#11##11#"##""##"#11##11#"##""##"#11##11#"##""##"#11##11#"##""##"#11##11#"##""##"#11##11#"##""##"#11##11#"##""##"#11##11#"##""##"#11##11#"##""##"#11##11#"##""##"#11##11#"##""##"#11##11#"##""##"#11##11#"#1ZւZ1#""#1ZZ1#"######################################################################################################################################################################################################################################################################################################################################################################################J##J##"#c##c#"!##!!##!!#####ד#!!#c#!!#c#!#V####V##0c#!!#p0#"#ʔ0#!!#0#"!#0#!!#0ʕ#!#V0#!!#0V###0##!!##0ʖ##!#c#!!#c#!#Ic#cI###֖c=#=c֚##!#pp#!####!#cc#!####!#II#!"##"##Ȼ##!#<<#!"#bb#"##||######!####!!####!!##||##!!##bb##!##<ȩ<##"####"!##<<##!"##VԟV##"!#bb#!!#II#!!"#VǏǕV#"!!#0VV0#!!"#"!!#!,,,,,,,, ,, ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,ޙ,,ޙ,+כ++כ++ҝ++ҝ+}}}}+̟++̟+*MM**MՃM*҆҇}}{{yywwttrrppnnlljjggeeccaa_++_M]22]MKZDDZKCXQQX?;W00W;,TGGT,"R/2R"GPM""MPG9NE""EN9*L;""@L*GJA""AJG8HE,,EH8&F<++|>|<<<<<<<<<<<<>|?8>|>|<<<<<<<<<<<<>|?is32fwi-ݙҿ:ߚ:|/ 7S Uc Uc Uc Ui Ud ؇ס̶ּ- Uc ?L66$fwhi-3ymNxvN%_g/ /H됁 ESꚁ ݹU^ޚ ů\cɚ dn wv ud}|dq~`9CliB:ZUh   `ieX Qi ZfNAAKd\BJKF}-E.fq2CH'dk.Eg9"PU5g F*oc&B G)si&A G+si'C G-sc*C H!.sc,C H#/wd-!D L$,pi+"ET+4KK2'NU<!! 7ZK6" 2I C>2..1݉XK݅b=߂R`ӭr*=_lofH"y}zzwwfu҅uzxsq uքw zwsf wՅw zwts{{s|xwKz`;kߍWRz':f ^߂6 Dm a6 Kq a6 Ks cތ- Kv cَ-Kw eґ- Kz gʒ- K| i-K l-Kn- K p- K r% B~ toqqp~A [wpqqn n`abaa ^abb]IWNOOLhwfco_MOMhd5: 6VN6:8M8l,12+tN+<K4bTD*nH{*i\!jl[XXYfx2IjuwqS(oUbmu/I].s t0I ]0q t/I ]0q~5 Xa1zTL2[+K]%@^b0S@PH b i1Qm fH"f l1Qm sH"h l1Qm sH"h l1Qm sH"h l2Qm sH#h l2Qm sH$h l3QmsH%h l4QmsH&hl4QmsH'hl4PmsI'hl4PmsI'hl4 PgkI (fp5 P{}E (fn< 9{1 .hcI KƯE ;j3\ 9PSUO5 NVd9  *a7[! MPSL @]WL @] MV1)LV3WP=/),8JX?.JVWUVO6  l8mk\( h4  h4  i4 i4 B)y)/Ge$w4v3v3v3v3v3v3v3v3v3v3v2t#=fsEs n;7Yw*!2cy$+b¡p7 0=@A@6 ich#H><~???><~???ih32|rm{yUowng}ҾtU ouo i}tU owp g|t\xoj}рtbuni}tUz|uw~yxqsM\vw[v3Qo" V.Gx,<z&`3I3hJ~2kJ2kJ~2kJ2kJ2kJ2kJ2kJ2kJ2kJ2kJ2kJ2kJ2kJ2kH2kH2kH3kK3>lKSbd>ofyV-lfhqIkphjnkp+O߃ ɼi)߄ ߄EWݕs'yݔ@AݒZ QݐiUݍl% K݉ a" 6r߅ ҊI3 Ew ޿X)  7TubB$ #*)(    ~z|}j~}xz|{} xu |y~̹x|j yv y~y~s~xv z~x}uxuy~x|j|x|z{}~{yyM\yzayЂo5Xuуm"azq4Uup.H}p.ugXt$@xmZu'DyoWv'D{oWx'?|oWx'?~oWz?oU܀߸{?܂ܧoUցٺ|?ك֩oUЁҺ|?҄qUɀ˻}?ɃqU~;ðqU;qU;qU;qU;qU;qU;rU|}7{~rUquq3Bput{rTfjf[igjitkDZ`]r{wd^`]s`-NTOwfs|NTO|OtKEFEG|uw|x{BF@/Vd2875la387?q) ' ('!(p&mM!o<^`+q7WY%q!:h=q3jW$r-Rf* #3Ngg4 Ibkgc`_`^_dihU0 .795$    h8mk j v*ߵ v* u) v* w+ v) z-s x3h<S~- :n~6W(e; c8c8c8c8c8c8c8c8c8c8c8c8c8c8c8c8c7b=[=jJ3 dуd`\a@!J| < T!7 :WLlRo&J`%9pʇJ!GrԱW. !;Unx_E*!/8:;;;94) it32;ڕnj_ppqxrqmovvo:qrtpf orrp_qoroH nssoc qpsp_nrqo_ qnroxnrspxqorpknrro_qnrp:orrpfrorpHorrpfqnrp_nrspxrorpfnqroxqnqo:ntspkrotpcnrrpHqoro_nsspxqosp_nrrpxqorofnsrpcqpspcnqroHqoqp:ostpkrosp_otvpsqnrpHorooErsvpWtq{qvp{o gun vp{ trm [sn vow noo j}% \sn wot pqr lx> Ytn vos oor prZ Zun nu wqw wqj in rV yo kx dorY zp ng  for`  zpnk hore  {pnn hoqhypnp  ioql  |pns  ioql  |pns ioql  |pns ioql  |pns ioql  |pns ioql  |pns ioql  |pns ioql  |pns ioql  |pns ioql  |pns ioql  |pns ioql  |pns ioql  |pns ipql  |pns ipql  |pns ipql  |pns ipql  |pns ipql  |pns ipql  |pns ipql  |pns ipql  |pns iprl  |pns iprl  |pns iprl  |pns iprl  |pns iprl  |pns iprl  |pns iprl  |qns iprl  |qns iprl  |qns iprl  |qns iprl  |qns iprl  |qns iprl  |qns iprl  |qns iprl  |qns iprl  |qns iprl  |qns iprl  |qns iprl  |qns iprl  |qns iprl  |qns iprl  |qns iprl  |qns iprl  |qns iprl  |qns iprl  |pns iprf  {pns qnnx  )xsm~ {ml atyop ymmnpc opxs{ mpd jpm tr~sT _ror mvuBMuxmUqqq|zqwptmm}{lqpxznlywmqpjsnpg  _r~ tnu frnxuF  |o!ԋootw|rntm| }l rnoprt rqnnvmw aq ̤|{z |ߗ{tM+zolz  ylޘޚoo Msuޘ߁އ߀ޚrz1lls \rwrvC}lk| Vrupx= ymls 2xml} gpursU {l lt +zl k| Nun߼ lx> apoߺ nrR nqq pqb qor pqf  osp orf iooް mqa ^vl ׈lxO Dxmx wmz< &rsnߦגnpp" ]wlvvlwP   -uro|ߜ }lss$  Dsrmzߔ۩{mqx<  LtsmsݼtmsuK =nwoltǭumoxq9  #WpxrmowzompxqW&  H`svrpoppqrqpooqrvtfL"   .CU_elgfjdYJ3              љvj_w}yxzymx}z}y:y|}xf x}wlw|y_z|zw}yH w}wlokw}yc z|zmkw}y_w}wh~hw}y_ y}zktzjw}yxw}wi}~iw}yxy}ylq}iw|ykw}wi}~iv|y_y}zkp}iw}y:x}wi{{iw}yfz}zlq{iw}yHx}wi{|iw}yfy}zkp{iw}y_w}xi|~iw}yxy}zlp|ix}yfw}wi|{hw|yxy}zlp|iw}y:w}wi|~iv}ykz}zlq|iw|ycw}wh{}hw}yHy|ylp{hw}y_w}wi}iw}yxy}zkq}iw}y_w}wh|{hw}yxy|zkp|hw}yfw}wiz|hw|ycy|zlpziw|ycw}vh{|hw|yHy}zkp{hv}y:x}wi}}iw|ykz}zlr}iw}z_w}wj|~kv}xsy}zkp|iw|yHw}vk{oky|wEz|yntՁlv}x_{{xmu܈ku|z|z|njjr}x i|{ymr ބiu|z}  {{zmznq{x _z{{nu ߈kv|yw ny|ym~ wo|y% \z{|px ܊mx}yv rz|zn ݃p{z}> Z{{|sxnz}yv py|zp p{{y[ Z}|}q u}{v z{}yu r{}zk k|~t w||W {{y u}z} h|~wy}|Z z||w~zj  j|z|~|b  z~zzn k||~~|g  z|zp n|~은|h z~zt m|쟂|l  zzu n|졄|l  zzw n|좆|l  zzw n|꤈|l  zzw n|ꥊ|l  zzw n|꧌|l  zzw n{꩏|l  zyw n{ꪐ|l  zyw n{ꬔ|l  zyw n{ꮕ|l  zyw n{鯘{l  z칗yw n{簙{l  z鹙yw n{屛{l  z纛yw nz㲟{l  z仞yw nz᳠{l  y㼠yw nz߳{l  yߑἢyw nzߐݴ{l  yݑ޼yw nzܐ۶{l  yۑܽyw nzڐٷ{l  yّڽyw nzאַ{l  y֑׽yw nzՑ{l  y̒սyw nzҐѹ{l  yёҽyw nzϑ{l  yɒϽyw nz̹͐{l  y̑ͽxw nzɐɹ{l  yɑɽxw nzƐƺ{l  yƑƽxw nzÑ{l  yüxw nz{l  yxw ny{l  yxw ny{l  yxw ny{l  yxw nyķ{l  yÐxw nyƷˆ{l  yijőxw nyǵĈ{l  yŰƒxw nyɳƈ{l  yǮɒww nyʳƈ{l  yǪʓww nyͱȉzl  yɧ˓ww nyίʉzl  yʥ͓ww nyЮˊzl  y̢ϓww nyѬ̊zl  y͟Дww nyҪΊzl  y͛єww nyթЊzl  yЙӔww nyզъzl  yіՔww nyפъzl  yѓ֕ww nyآӊzl  yӐוww ny٠{}Ԋzl  yԍ}|ؕww ny۞x|zՊzl  xԊz|xٕww nyۛtxu֋zh  yԆuxtڕww twݚotpڐxz  )zӀrtpەv ~vޛkpkޘv  a|wnpkܔwr {vޞflhݫv vֻkklhܑyc rxܣdifu~z{vޝcieًyf lxح_ebڎv {z`eddσzT  azҷ^_`Z߮y{vؽ`_`_d}|B  M{~`[][_ٍv^yyކV]YoԺy ynTXQܾ~w|vܽXWXQެv~v߃LTSOzxxwsMTKvzyvݛFOK\ݥzxj{vߍGOI؇xi  _zNHI Cbި{v| fywDHIGT~|F  xd?E!=_໋xw{zyw|ߒBCE=tߪv  u6@ 8Nթzwwxy{| zxww}ԁ9=@7vz  dy=9: 5:ֶ ܭ\/:7IȀ|P(xh*5 3)?Ё́Ӧf/.5(tv |vߥ%/ +!1\{sN'%./-.ۍwr  M{|L(&"&()*("!'(b޸y1u!  ! ݒvv ^z~LYݻz}C u  ܎t} Xy|ftx}= }v4?Ӈvv 2~v u  iw|szzW vU`ȃvw )uCOՍt O{w5 Dޘv}< bxy5 @ޢxyT oyz: Cyyc uwzS Zޣyyg  qzyg uڠxzi jww& *ϔvyb _|vV _佉v}P D}v~8 <۩}v}< &uzwχ59住xys ^}v}ύ>>͝|v{Q  -wzwץ_++_ʤvzw$  DxzvϪoG'#Envy|< Lv{vz˥scULECBFP_nëzvzzN =r|xvzބʳ|vx}s: "Xs|{vw}xvy}tX% Hbv{yxyz yyxxyz}xfL"   .EVbfnki kleZJ3              ў}j_xm^:f GE_WEH HFq [H_EC_ XExHFxWHxGD_ZG:HEf[HHEFfXE_JFx\JfHEx[H:FDxXFqHFHWH_FDxXF_FExYFfFIqYFqHGH[H:GExZG_GCZFH~FZ~EVD_S9}p -~ mW <  T$q _W ;z tM d% _W >{ uI VD ]U :y sC G_ ]G oz |/ 6n pS nY ; b~ kRn\ 9 bm  oRnf  :bo pSni  :bs rRnm :bw  sSnn  :bysSon  :bz sSon  :cz sSon  :cz sTon  ;cz sTon  ;dz sTon  ;dz sTon  ;dz sUpn  ;ez sUpn  <ez sUpn  <ez sUpn  <ez sVpn  <ez sVpn  <ez sVqn  =fz sVqn  =fz sVqn  =fz sWqn  =fz sWqn  =fz sWqn  =fz sWqn  =fz sXqn  >gz sXqn  >gz sXrn  >gz sXrn  >gz sYrn  >gz sYrn  >gz sYrn  >hz sYrn  >hz sYrn  ?hz sYrn  ?hz sYrn  ?hz sZrn  ?hz sZrn  ?iz sZrn  ?iz sZrn  ?iz sZsn  @iz sZsn  @iz sZsn  @iz sZsn  @iz sZsn  @iz s[sn  @iz s[sn  @iz s[sn  @iz s[sn  @iz s[sn  @iz s[tq  Aiz s[tk  @iz z]o~  -6j `h  d*kv hT xog vq-j th pws D }Y f|Mw0E  O.t^F> B7iQ` Pxxf}}pZj{/yk  c}"Ufw./K  J;ub Tf Tzo:o} fyCes{}~zp^3+R+I"&(+'X  msu Q5A1h mz a2 O|qU6 1Ro}Q >tvbN0(H_sx< #[wxpha[UQPQLHJNT\dmv~w[&  Kd{}hO"   /HYdjrnqi^M5               t8mk@      Yb H f 31 3{F( f2  ;ZkK,#@`=! 6Ur}bC&%Dd\30l% 8,/l%7*/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/l%7)/p%7)/%=)/& V).( {(-U p(-Td',sK U&)` qD$'J M@! #DR;  >9 6 82 _f11W̗pXMFGH@;<! 2QplL-!=]wX9 +IhcD' 4RplN0 !Qdt͡tcP<* !2CUfuӵtfUB1! %4DUdq|í|qcTD4% &3AP]it|ƺ}ti]PA3%  #.:FR]gpw~~xph]SG:.#  '/9CLU^ekortuvvvwwwwwwvvvusplf_VMD90'  #*29@EKNQSSTTTTTTTTTTSRPLHB;3,$  !%),-//0000000000//-*'# unison-2.32.52/uimacnew/UnisonToolbar.h0000644000076500000000000000166311176730177017431 0ustar bcpiercewheel// // UnisonToolbar.h // // Extended NSToolbar with several views // // Created by Ben Willmore on Sun March 12 2006. // Copyright (c) 2006, licensed under GNU GPL. // #import @class ReconTableView, MyController; @interface UnisonToolbar : NSToolbar { ReconTableView* tableView; MyController* myController; NSString* currentView; NSView* tableModeView; } - initWithIdentifier:(NSString *) identifier :(MyController *) aController :(ReconTableView *) aTableView; - (NSToolbarItem *) toolbar: (NSToolbar *)toolbar itemForItemIdentifier: (NSString *) itemIdent willBeInsertedIntoToolbar:(BOOL) willBeInserted; - (NSArray *) itemIdentifiersForView: (NSString *) whichView; - (NSArray *) toolbarDefaultItemIdentifiers: (NSToolbar *) toolbar; - (NSArray *) toolbarAllowedItemIdentifiers: (NSToolbar *) toolbar; - (void) setView: (NSString *) whichView; - (void)takeTableModeView:(NSView *)view; @end unison-2.32.52/uimacnew/UnisonToolbar.m0000644000076500000000000002010011176730177017421 0ustar bcpiercewheel// // UnisonToolbar.h // // Extended NSToolbar with several views // // Created by Ben Willmore on Sun March 12 2006. // Copyright (c) 2006, licensed under GNU GPL. // #import "UnisonToolbar.h" #import "MyController.h" static NSString* QuitItemIdentifier = @"Quit"; static NSString* OpenItemIdentifier = @"Open"; static NSString* NewItemIdentifier = @"New"; static NSString* GoItemIdentifier = @"Go"; static NSString* CancelItemIdentifier = @"Cancel"; static NSString* SaveItemIdentifier = @"Save"; static NSString* RestartItemIdentifier = @"Restart"; static NSString* RescanItemIdentifier = @"Rescan"; static NSString* RToLItemIdentifier = @"RToL"; static NSString* MergeItemIdentifier = @"Merge"; static NSString* LToRItemIdentifier = @"LToR"; static NSString* SkipItemIdentifier = @"Skip"; static NSString* DiffItemIdentifier = @"Diff"; static NSString* TableModeIdentifier = @"TableMode"; @implementation UnisonToolbar - initWithIdentifier:(NSString *) identifier :(MyController *) aController :(ReconTableView *) aTableView { if ((self = [super initWithIdentifier: identifier])) { [self setAllowsUserCustomization: NO]; [self setAutosavesConfiguration: NO]; [self setDelegate: self]; myController = aController; tableView = aTableView; currentView = @""; } return self; } - (void)takeTableModeView:(NSView *)view { tableModeView = [view retain]; [view setHidden:YES]; } - (NSToolbarItem *) toolbar: (NSToolbar *)toolbar itemForItemIdentifier: (NSString *) itemIdent willBeInsertedIntoToolbar:(BOOL) willBeInserted { NSToolbarItem *toolbarItem = [[[NSToolbarItem alloc] initWithItemIdentifier: itemIdent] autorelease]; if ([itemIdent isEqual: QuitItemIdentifier]) { [toolbarItem setLabel: @"Quit"]; [toolbarItem setImage: [NSImage imageNamed: @"quit.tif"]]; [toolbarItem setTarget:NSApp]; [toolbarItem setAction:@selector(terminate:)]; } else if ([itemIdent isEqual: OpenItemIdentifier]) { [toolbarItem setLabel: @"Open"]; [toolbarItem setImage: [NSImage imageNamed: @"go.tif"]]; [toolbarItem setTarget:myController]; [toolbarItem setAction:@selector(openButton:)]; } else if ([itemIdent isEqual: NewItemIdentifier]) { [toolbarItem setLabel: @"New"]; [toolbarItem setImage: [NSImage imageNamed: @"add.tif"]]; [toolbarItem setTarget:myController]; [toolbarItem setAction:@selector(createButton:)]; } else if ([itemIdent isEqual: CancelItemIdentifier]) { [toolbarItem setLabel: @"Cancel"]; [toolbarItem setImage: [NSImage imageNamed: @"restart.tif"]]; [toolbarItem setTarget:myController]; [toolbarItem setAction:@selector(chooseProfiles)]; } else if ([itemIdent isEqual: SaveItemIdentifier]) { [toolbarItem setLabel: @"Save"]; [toolbarItem setImage: [NSImage imageNamed: @"save.tif"]]; [toolbarItem setTarget:myController]; [toolbarItem setAction:@selector(saveProfileButton:)]; } else if ([itemIdent isEqual: GoItemIdentifier]) { [toolbarItem setLabel: @"Go"]; [toolbarItem setImage: [NSImage imageNamed: @"go.tif"]]; [toolbarItem setTarget:myController]; [toolbarItem setAction:@selector(syncButton:)]; } else if ([itemIdent isEqual: RestartItemIdentifier]) { [toolbarItem setLabel: @"Restart"]; [toolbarItem setImage: [NSImage imageNamed: @"restart.tif"]]; [toolbarItem setTarget:myController]; [toolbarItem setAction:@selector(restartButton:)]; } else if ([itemIdent isEqual: RescanItemIdentifier]) { [toolbarItem setLabel: @"Rescan"]; [toolbarItem setImage: [NSImage imageNamed: @"rescan.tif"]]; [toolbarItem setTarget:myController]; [toolbarItem setAction:@selector(rescan:)]; } else if ([itemIdent isEqual: RToLItemIdentifier]) { [toolbarItem setLabel: @"Right to left"]; [toolbarItem setImage: [NSImage imageNamed: @"left.tif"]]; [toolbarItem setTarget:tableView]; [toolbarItem setAction:@selector(copyRL:)]; } else if ([itemIdent isEqual: MergeItemIdentifier]) { [toolbarItem setLabel: @"Merge"]; [toolbarItem setImage: [NSImage imageNamed: @"merge.tif"]]; [toolbarItem setTarget:tableView]; [toolbarItem setAction:@selector(merge:)]; } else if ([itemIdent isEqual: LToRItemIdentifier]) { [toolbarItem setLabel: @"Left to right"]; [toolbarItem setImage: [NSImage imageNamed: @"right.tif"]]; [toolbarItem setTarget:tableView]; [toolbarItem setAction:@selector(copyLR:)]; } else if ([itemIdent isEqual: SkipItemIdentifier]) { [toolbarItem setLabel: @"Skip"]; [toolbarItem setImage: [NSImage imageNamed: @"skip.tif"]]; [toolbarItem setTarget:tableView]; [toolbarItem setAction:@selector(leaveAlone:)]; } else if ([itemIdent isEqual: DiffItemIdentifier]) { [toolbarItem setLabel: @"Diff"]; [toolbarItem setImage: [NSImage imageNamed: @"diff.tif"]]; [toolbarItem setTarget:tableView]; [toolbarItem setAction:@selector(showDiff:)]; } else if ([itemIdent isEqual: TableModeIdentifier]) { [toolbarItem setLabel:@"Layout"]; [toolbarItem setToolTip:@"Switch table nesting"]; [tableModeView setHidden:NO]; [toolbarItem setView:tableModeView]; [toolbarItem setMinSize:NSMakeSize(NSWidth([tableModeView frame]),NSHeight([tableModeView frame])+10)]; [toolbarItem setMaxSize:NSMakeSize(NSWidth([tableModeView frame]),NSHeight([tableModeView frame])+10)]; } return toolbarItem; } - (NSArray *) itemIdentifiersForView: (NSString *) whichView { if ([whichView isEqual: @"chooseProfileView"]) { return [NSArray arrayWithObjects: QuitItemIdentifier, NewItemIdentifier, OpenItemIdentifier, nil]; } else if ([whichView isEqual: @"preferencesView"]) { return [NSArray arrayWithObjects: QuitItemIdentifier, SaveItemIdentifier, CancelItemIdentifier, nil]; } else if ([whichView isEqual: @"ConnectingView"]) { return [NSArray arrayWithObjects: QuitItemIdentifier, nil]; } else if ([whichView isEqual: @"updatesView"]) { return [NSArray arrayWithObjects: QuitItemIdentifier, RestartItemIdentifier, NSToolbarSeparatorItemIdentifier, GoItemIdentifier, RescanItemIdentifier, NSToolbarSeparatorItemIdentifier, RToLItemIdentifier, MergeItemIdentifier, LToRItemIdentifier, SkipItemIdentifier, NSToolbarSeparatorItemIdentifier, DiffItemIdentifier, TableModeIdentifier, nil]; } else { return [NSArray arrayWithObjects: QuitItemIdentifier, Nil]; } } - (NSArray *) toolbarDefaultItemIdentifiers: (NSToolbar *) toolbar { return [NSArray arrayWithObjects: QuitItemIdentifier, NewItemIdentifier, OpenItemIdentifier, nil]; } - (NSArray *) toolbarAllowedItemIdentifiers: (NSToolbar *) toolbar { return [NSArray arrayWithObjects: QuitItemIdentifier, OpenItemIdentifier, NewItemIdentifier, CancelItemIdentifier, SaveItemIdentifier, GoItemIdentifier, RestartItemIdentifier, RescanItemIdentifier, RToLItemIdentifier, MergeItemIdentifier, LToRItemIdentifier, SkipItemIdentifier, DiffItemIdentifier, NSToolbarSeparatorItemIdentifier, nil]; } - (void) setView: (NSString *) whichView { if ([whichView isEqual:currentView]) return; currentView = whichView; int i; NSArray *identifiers; NSString *oldIdentifier; NSString *newIdentifier; identifiers=[self itemIdentifiersForView:whichView]; for (i=0; i<[identifiers count]; i++) { newIdentifier = [identifiers objectAtIndex:i]; if (i<[[self items] count]) { oldIdentifier = [[[self items] objectAtIndex:i] itemIdentifier]; if ([newIdentifier isEqual: oldIdentifier] ) { [[[self items] objectAtIndex:i] setEnabled:YES]; } else { [self removeItemAtIndex:i]; [self insertItemWithItemIdentifier:newIdentifier atIndex:i]; } } else { [self insertItemWithItemIdentifier:newIdentifier atIndex:i]; } } while ([[self items] count] > [identifiers count]) { [self removeItemAtIndex:[identifiers count]]; } } @end unison-2.32.52/uitext.ml0000644000076500000000000006623211207755401014521 0ustar bcpiercewheel(* Unison file synchronizer: src/uitext.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) open Common open Lwt module Body : Uicommon.UI = struct let debug = Trace.debug "ui" let dumbtty = Prefs.createBool "dumbtty" (match Util.osType with `Unix -> (try (Unix.getenv "EMACS" <> "") with Not_found -> false) | _ -> true) "!do not change terminal settings in text UI" ("When set to \\verb|true|, this flag makes the text mode user " ^ "interface avoid trying to change any of the terminal settings. " ^ "(Normally, Unison puts the terminal in `raw mode', so that it can " ^ "do things like overwriting the current line.) This is useful, for " ^ "example, when Unison runs in a shell inside of Emacs. " ^ "\n\n" ^ "When \\verb|dumbtty| is set, commands to the user interface need to " ^ "be followed by a carriage return before Unison will execute them. " ^ "(When it is off, Unison " ^ "recognizes keystrokes as soon as they are typed.)\n\n" ^ "This preference has no effect on the graphical user " ^ "interface.") let silent = Prefs.createBool "silent" false "print nothing except error messages" ("When this preference is set to {\\tt true}, the textual user " ^ "interface will print nothing at all, except in the case of errors. " ^ "Setting \\texttt{silent} to true automatically sets the " ^ "\\texttt{batch} preference to {\\tt true}.") let cbreakMode = ref None let rawTerminal () = match !cbreakMode with None -> () | Some state -> let newstate = { state with Unix.c_icanon = false; Unix.c_echo = false; Unix.c_vmin = 1 } in Unix.tcsetattr Unix.stdin Unix.TCSANOW newstate let defaultTerminal () = match !cbreakMode with None -> () | Some state -> Unix.tcsetattr Unix.stdin Unix.TCSANOW state let restoreTerminal() = if Util.osType = `Unix && not (Prefs.read dumbtty) then Sys.set_signal Sys.sigcont Sys.Signal_default; defaultTerminal (); cbreakMode := None let setupTerminal() = if Util.osType = `Unix && not (Prefs.read dumbtty) then try cbreakMode := Some (Unix.tcgetattr Unix.stdin); let suspend _ = defaultTerminal (); Sys.set_signal Sys.sigtstp Sys.Signal_default; Unix.kill (Unix.getpid ()) Sys.sigtstp in let resume _ = Sys.set_signal Sys.sigtstp (Sys.Signal_handle suspend); rawTerminal () in Sys.set_signal Sys.sigcont (Sys.Signal_handle resume); resume () with Unix.Unix_error _ -> restoreTerminal () let alwaysDisplay message = print_string message; flush stdout let alwaysDisplayAndLog message = (* alwaysDisplay message;*) Trace.log (message ^ "\n") let display message = if not (Prefs.read silent) then alwaysDisplay message let displayWhenInteractive message = if not (Prefs.read Globals.batch) then alwaysDisplay message let getInput () = if !cbreakMode = None then let l = input_line stdin in if l="" then "" else String.sub l 0 1 else let c = input_char stdin in let c = if c='\n' then "" else String.make 1 c in display c; c let newLine () = if !cbreakMode <> None then display "\n" let overwrite () = if !cbreakMode <> None then display "\r" let rec selectAction batch actions tryagain = let formatname = function "" -> "" | " " -> "" | n -> n in let summarizeChoices() = display "["; Safelist.iter (fun (names,doc,action) -> if (Safelist.nth names 0) = "" then display (formatname (Safelist.nth names 1))) actions; display "] " in let tryagainOrLoop() = tryagain (); selectAction batch actions tryagain in let rec find n = function [] -> raise Not_found | (names,doc,action)::rest -> if Safelist.mem n names then action else find n rest in let doAction a = if a="?" then (newLine (); display "Commands:\n"; Safelist.iter (fun (names,doc,action) -> let n = Util.concatmap " or " formatname names in let space = String.make (max 2 (22 - String.length n)) ' ' in display (" " ^ n ^ space ^ doc ^ "\n")) actions; tryagainOrLoop()) else try find a actions () with Not_found -> newLine (); if a="" then display ("No default command [type '?' for help]\n") else display ("Unrecognized command '" ^ String.escaped a ^ "': try again [type '?' for help]\n"); tryagainOrLoop() in doAction (match batch with None -> summarizeChoices(); getInput () | Some i -> i) let alwaysDisplayDetails ri = alwaysDisplay ((Uicommon.details2string ri " ") ^ "\n") let displayDetails ri = if not (Prefs.read silent) then alwaysDisplayDetails ri let displayri ri = let s = Uicommon.reconItem2string Path.empty ri "" ^ " " in let s = match ri.replicas with Different(_,_,d,def) when !d<>def -> let s = Util.replacesubstring s "<-?->" "<=?=>" in let s = Util.replacesubstring s "---->" "====>" in let s = Util.replacesubstring s "<----" "<====" in s | _ -> s in match ri.replicas with Problem _ -> alwaysDisplay s | Different (_,_,d,_) when !d=Conflict -> alwaysDisplay s | _ -> display s type proceed = ConfirmBeforeProceeding | ProceedImmediately let interact rilist = let (r1,r2) = Globals.roots() in let (host1, host2) = root2hostname r1, root2hostname r2 in if not (Prefs.read Globals.batch) then display ("\n" ^ Uicommon.roots2string() ^ "\n"); let rec loop prev = function [] -> (ConfirmBeforeProceeding, Safelist.rev prev) | ri::rest as ril -> let next() = loop (ri::prev) rest in let repeat() = loop prev ril in let ignore pat rest what = if !cbreakMode <> None then display "\n"; display " "; Uicommon.addIgnorePattern pat; display (" Permanently ignoring " ^ what ^ "\n"); begin match !Prefs.profileName with None -> assert false | Some(n) -> display (" To un-ignore, edit " ^ (Prefs.profilePathname n) ^ " and restart " ^ Uutil.myName ^ "\n") end; let nukeIgnoredRis = Safelist.filter (fun ri -> not (Globals.shouldIgnore ri.path)) in loop (nukeIgnoredRis (ri::prev)) (nukeIgnoredRis ril) in (* This should work on most terminals: *) let redisplayri() = overwrite (); displayri ri; display "\n" in displayri ri; match ri.replicas with Problem s -> display "\n"; display s; display "\n"; next() | Different(rc1,rc2,dir,_) -> if Prefs.read Uicommon.auto && !dir<>Conflict then begin display "\n"; next() end else let (descr, descl) = if host1 = host2 then "left to right", "right to left" else "from "^host1^" to "^host2, "from "^host2^" to "^host1 in if Prefs.read Globals.batch then begin display "\n"; if not (Prefs.read Trace.terse) then displayDetails ri end; selectAction (if Prefs.read Globals.batch then Some " " else None) [((if !dir=Conflict && not (Prefs.read Globals.batch) then ["f"] (* Offer no default behavior if we've got a conflict and we're in interactive mode *) else ["";"f";" "]), ("follow " ^ Uutil.myName ^ "'s recommendation (if any)"), fun ()-> newLine (); if !dir = Conflict && not (Prefs.read Globals.batch) then begin display "No default action [type '?' for help]\n"; repeat() end else next()); (["I"], ("ignore this path permanently"), (fun () -> ignore (Uicommon.ignorePath ri.path) rest "this path")); (["E"], ("permanently ignore files with this extension"), (fun () -> ignore (Uicommon.ignoreExt ri.path) rest "files with this extension")); (["N"], ("permanently ignore paths ending with this name"), (fun () -> ignore (Uicommon.ignoreName ri.path) rest "files with this name")); (["m"], ("merge the versions"), (fun () -> dir := Merge; redisplayri(); next())); (["d"], ("show differences"), (fun () -> newLine (); Uicommon.showDiffs ri (fun title text -> try let pager = Sys.getenv "PAGER" in restoreTerminal (); let out = Unix.open_process_out pager in Printf.fprintf out "\n%s\n\n%s\n\n" title text; let _ = Unix.close_process_out out in setupTerminal () with Not_found -> Printf.printf "\n%s\n\n%s\n\n" title text) (fun s -> Printf.printf "%s\n" s) Uutil.File.dummy; repeat())); (["x"], ("show details"), (fun () -> display "\n"; displayDetails ri; repeat())); (["L"], ("list all suggested changes tersely"), (fun () -> display "\n"; Safelist.iter (fun ri -> displayri ri; display "\n ") ril; display "\n"; repeat())); (["l"], ("list all suggested changes with details"), (fun () -> display "\n"; Safelist.iter (fun ri -> displayri ri; display "\n "; alwaysDisplayDetails ri) ril; display "\n"; repeat())); (["p";"b"], ("go back to previous item"), (fun () -> newLine(); match prev with [] -> repeat() | prevri::prevprev -> loop prevprev (prevri :: ril))); (["g"], ("proceed immediately to propagating changes"), (fun() -> (ProceedImmediately, Safelist.rev_append prev ril))); (["q"], ("exit " ^ Uutil.myName ^ " without propagating any changes"), fun () -> raise Sys.Break); (["/"], ("skip"), (fun () -> dir := Conflict; redisplayri(); next())); ([">";"."], ("propagate from " ^ descr), (fun () -> dir := Replica1ToReplica2; redisplayri(); next())); (["<";","], ("propagate from " ^ descl), (fun () -> dir := Replica2ToReplica1; redisplayri(); next())) ] (fun () -> displayri ri) in loop [] rilist let verifyMerge title text = Printf.printf "%s\n" text; if Prefs.read Globals.batch then true else begin if Prefs.read Uicommon.confirmmerge then begin display "Commit results of merge? "; selectAction None (* Maybe better: (Some "n") *) [(["y";"g"], "Yes: commit", (fun() -> true)); (["n"], "No: leave this file unchanged", (fun () -> false)); ] (fun () -> display "Commit results of merge? ") end else true end let doTransport reconItemList = let totalBytesToTransfer = ref (Safelist.fold_left (fun l ri -> Uutil.Filesize.add l (Common.riLength ri)) Uutil.Filesize.zero reconItemList) in let totalBytesTransferred = ref Uutil.Filesize.zero in let t0 = Unix.gettimeofday () in let showProgress _ b _ = totalBytesTransferred := Uutil.Filesize.add !totalBytesTransferred b; let v = (Uutil.Filesize.percentageOfTotalSize !totalBytesTransferred !totalBytesToTransfer) in let t1 = Unix.gettimeofday () in let remTime = if v <= 0. then "--:--" else if v >= 100. then "00:00" else let t = truncate ((t1 -. t0) *. (100. -. v) /. v +. 0.5) in Format.sprintf "%02d:%02d" (t / 60) (t mod 60) in Util.set_infos (Format.sprintf "%s %s ETA" (Util.percent2string v) remTime) in if not (Prefs.read Trace.terse) && (Prefs.read Trace.debugmods = []) then Uutil.setProgressPrinter showProgress; Transport.logStart (); let fFailedPaths = ref [] in let uiWrapper ri f = catch f (fun e -> match e with Util.Transient s -> let m = "[" ^ (Path.toString ri.path) ^ "]: " ^ s in alwaysDisplay ("Failed " ^ m ^ "\n"); fFailedPaths := ri.path :: !fFailedPaths; return () | _ -> fail e) in let counter = ref 0 in let rec loop ris actions pRiThisRound = match ris with [] -> actions | ri :: rest when pRiThisRound ri -> loop rest (uiWrapper ri (fun () -> (* We need different line numbers so that transport operations are aborted independently *) incr counter; Transport.transportItem ri (Uutil.File.ofLine !counter) verifyMerge) :: actions) pRiThisRound | _ :: rest -> loop rest actions pRiThisRound in Lwt_unix.run (let actions = loop reconItemList [] (fun ri -> not (Common.isDeletion ri)) in Lwt_util.join actions); Lwt_unix.run (let actions = loop reconItemList [] Common.isDeletion in Lwt_util.join actions); Transport.logFinish (); Uutil.setProgressPrinter (fun _ _ _ -> ()); Util.set_infos ""; (Safelist.rev !fFailedPaths) let setWarnPrinterForInitialization()= Util.warnPrinter := Some(fun s -> alwaysDisplay "Error: "; alwaysDisplay s; alwaysDisplay "\n"; exit Uicommon.fatalExit) let setWarnPrinter() = Util.warnPrinter := Some(fun s -> alwaysDisplay "Warning: "; alwaysDisplay s; if not (Prefs.read Globals.batch) then begin display "Press return to continue."; selectAction None [(["";" ";"y"], ("Continue"), fun()->()); (["n";"q";"x"], ("Exit"), fun()-> alwaysDisplay "\n"; restoreTerminal (); Lwt_unix.run (Update.unlockArchives ()); exit Uicommon.fatalExit)] (fun()-> display "Press return to continue.") end) let lastMajor = ref "" let formatStatus major minor = let s = if major = !lastMajor then " " ^ minor else major ^ (if minor="" then "" else "\n " ^ minor) in lastMajor := major; s let rec interactAndPropagateChanges reconItemList : bool * bool * (Path.t list) (* anySkipped?, anyFailures?, failingPaths *) = let (proceed,newReconItemList) = interact reconItemList in let (updatesToDo, skipped) = Safelist.fold_left (fun (howmany, skipped) ri -> if problematic ri then (howmany, skipped + 1) else (howmany + 1, skipped)) (0, 0) newReconItemList in let doit() = if not (Prefs.read Globals.batch || Prefs.read Trace.terse) then newLine(); if not (Prefs.read Trace.terse) then Trace.status "Propagating updates"; let timer = Trace.startTimer "Transmitting all files" in let failedPaths = doTransport newReconItemList in let failures = Safelist.length failedPaths in Trace.showTimer timer; if not (Prefs.read Trace.terse) then Trace.status "Saving synchronizer state"; Update.commitUpdates (); let trans = updatesToDo - failures in let summary = Printf.sprintf "Synchronization %s at %s (%d item%s transferred, %d skipped, %d failed)" (if failures=0 then "complete" else "incomplete") (let tm = Util.localtime (Util.time()) in Printf.sprintf "%02d:%02d:%02d" tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec) trans (if trans=1 then "" else "s") skipped failures in Trace.log (summary ^ "\n"); if skipped>0 then Safelist.iter (fun ri -> if problematic ri then alwaysDisplayAndLog (" skipped: " ^ (Path.toString ri.path))) newReconItemList; if failures>0 then Safelist.iter (fun p -> alwaysDisplayAndLog (" failed: " ^ (Path.toString p))) failedPaths; (skipped > 0, failures > 0, failedPaths) in if updatesToDo = 0 then begin display "No updates to propagate\n"; (* BCP (3/09): We need to commit the archives even if there are no updates to propagate because some files (in fact, if we've just switched to DST on windows, a LOT of files) might have new modtimes in the archive. *) (* JV (5/09): Don't save the archive in repeat mode as it has some costs and its unlikely there is much change to the archives in this mode. *) if Prefs.read Uicommon.repeat = "" then Update.commitUpdates (); (skipped > 0, false, []) end else if proceed=ProceedImmediately then begin doit() end else begin displayWhenInteractive "\nProceed with propagating updates? "; selectAction (* BCP: I find it counterintuitive that every other prompt except this one would expect as a default. But I got talked out of offering a default here, because of safety considerations (too easy to press one time too many). *) (if Prefs.read Globals.batch then Some "y" else None) [(["y";"g"], "Yes: proceed with updates as selected above", doit); (["n"], "No: go through selections again", (fun () -> Prefs.set Uicommon.auto false; newLine(); interactAndPropagateChanges reconItemList)); (["q"], ("exit " ^ Uutil.myName ^ " without propagating any changes"), fun () -> raise Sys.Break) ] (fun () -> display "Proceed with propagating updates? ") end let checkForDangerousPath dangerousPaths = if Prefs.read Globals.confirmBigDeletes then begin if dangerousPaths <> [] then begin alwaysDisplayAndLog (Uicommon.dangerousPathMsg dangerousPaths); if Prefs.read Globals.batch then begin alwaysDisplay "Aborting...\n"; restoreTerminal (); exit Uicommon.fatalExit end else begin displayWhenInteractive "Do you really want to proceed? "; selectAction None [(["y"], "Continue", (fun() -> ())); (["n"; "q"; "x"; ""], "Exit", (fun () -> alwaysDisplay "\n"; restoreTerminal (); exit Uicommon.fatalExit))] (fun () -> display "Do you really want to proceed? ") end end end let synchronizeOnce() = let showStatus path = if path = "" then Util.set_infos "" else let max_len = 70 in let mid = (max_len - 3) / 2 in let path = let l = String.length path in if l <= max_len then path else String.sub path 0 (max_len - mid - 3) ^ "..." ^ String.sub path (l - mid) mid in let c = "-\\|/".[truncate (mod_float (4. *. Unix.gettimeofday ()) 4.)] in Util.set_infos (Format.sprintf "%c %s" c path) in Trace.status "Looking for changes"; if not (Prefs.read Trace.terse) && (Prefs.read Trace.debugmods = []) then Uutil.setUpdateStatusPrinter (Some showStatus); let updates = Update.findUpdates() in Uutil.setUpdateStatusPrinter None; Util.set_infos ""; let (reconItemList, anyEqualUpdates, dangerousPaths) = Recon.reconcileAll updates 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 unison-2.32.52/uitext.mli0000644000076500000000000000022211176730177014665 0ustar bcpiercewheel(* Unison file synchronizer: src/uitext.mli *) (* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *) module Body : Uicommon.UI unison-2.32.52/unison.hgr0000644000076500000000000000057711176730177014672 0ustar bcpiercewheel# Hungarian convention for the unison project # The convention applies to a bunch of types in the module Common ui.* : Common.updateItem ui.* : updateItem uc.* : Common.updateContent uc.* : updateContent rc.* : Common.replicaContent rc.* : replicaContent rplc.* : Common.replicas rplc.* : replicas ri.* : Common.reconItem ri.* : reconItem <> : Prop.t # The end unison-2.32.52/update.ml0000644000076500000000000023337611207755401014466 0ustar bcpiercewheel(* Unison file synchronizer: src/update.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) open Common let (>>=) = Lwt.(>>=) let debug = Trace.debug "update" let debugverbose = Trace.debug "update+" let debugalias = Trace.debug "rootalias" let debugignore = Trace.debug "ignore" (*****************************************************************************) (* ARCHIVE DATATYPE *) (*****************************************************************************) (* Remember to increment archiveFormat each time the representation of the archive changes: old archives will then automatically be discarded. (We do not use the unison version number for this because usually the archive representation does not change between unison versions.) *) (*FIX: Use similar_correct in props.ml next time the format is modified (see file props.ml for the new function) *) (*FIX: use Case.normalize next time the format is modified *) (*FIX: also change Fileinfo.stamp to drop the info.ctime component, next time the format is modified *) (*FIX: also make Jerome's suggested change about file times (see his mesg in unison-pending email folder). *) let archiveFormat = 22 module NameMap = MyMap.Make (Name) type archive = ArchiveDir of Props.t * archive NameMap.t | ArchiveFile of Props.t * Os.fullfingerprint * Fileinfo.stamp * Osx.ressStamp | ArchiveSymlink of string | NoArchive (* For directories, only the permissions part of the file description (desc) is used for synchronization at the moment. *) let archive2string = function ArchiveDir(_) -> "ArchiveDir" | ArchiveFile(_) -> "ArchiveFile" | ArchiveSymlink(_) -> "ArchiveSymlink" | NoArchive -> "NoArchive" (*****************************************************************************) (* ARCHIVE NAMING *) (*****************************************************************************) (* DETERMINING THE ARCHIVE NAME *) (* The canonical name of a root consists of its canonical host name and canonical fspath. The canonical name of a set of roots consists of the canonical names of the roots in sorted order. There is one archive for each root to be synchronized. The canonical name of the archive is the canonical name of the root plus the canonical name of the set of all roots to be synchronized. Because this is a long string we store the archive in a file whose name is the hash of the canonical archive name. For example, suppose we are synchronizing roots A and B, with canonical names A' and B', where A' < B'. Then the canonical archive name for root A is A' + A' + B', and the canonical archive name for root B is B' + A' + B'. Currently, we determine A' + B' during startup and store this in the ref cell rootsName, below. This rootsName is passed as an argument to functions that need to determine a canonical archive name. Note, since we have a client/server architecture, there are TWO rootsName ref cells (one in the client's address space, one in the server's). It is vital therefore that the rootsName be determined on the client and passed to the server. This is not good and we should get rid of the ref cell in the future; we have implemented it this way at first for historical reasons. *) let rootsName : string Prefs.t = Prefs.createString "rootsName" "" "*Canonical root names" "" let getRootsName () = Prefs.read rootsName let foundArchives = ref true (*****************************************************************************) (* COMMON DEFINITIONS *) (*****************************************************************************) let rootAliases : string list Prefs.t = Prefs.createStringList "rootalias" "!register alias for canonical root names" ("When calculating the name of the archive files for a given pair of roots," ^ " Unison replaces any roots matching the left-hand side of any rootalias" ^ " rule by the corresponding right-hand side.") (* [root2stringOrAlias root] returns the string form of [root], taking into account the preference [rootAliases], whose items are of the form ` -> ' *) let root2stringOrAlias (root: Common.root): string = let r = Common.root2string root in let aliases : (string * string) list = Safelist.map (fun s -> match Util.splitIntoWordsByString s " -> " with [n;n'] -> (Util.trimWhitespace n, Util.trimWhitespace n') | _ -> raise (Util.Fatal (Printf.sprintf "rootalias %s should be two strings separated by ' -> '" s))) (Prefs.read rootAliases) in let r' = try Safelist.assoc r aliases with Not_found -> r in if r<>r' then debugalias (fun()-> Util.msg "Canonical root name %s is aliased to %s\n" r r'); r' (* (Called from the UI startup sequence...) `normalize' root names, sort them, get their string form, and put into the preference [rootsname] as a comma-separated string *) let storeRootsName () = let n = String.concat ", " (Safelist.sort compare (Safelist.map root2stringOrAlias (Safelist.map (function (Common.Local,f) -> (Common.Remote Os.myCanonicalHostName,f) | r -> r) (Globals.rootsInCanonicalOrder())))) in Prefs.set rootsName n (* How many characters of the filename should be used for the unique id of the archive? On Unix systems, we use the full fingerprint (32 bytes). On windows systems, filenames longer than 8 bytes can cause problems, so we chop off all but the first 6 from the fingerprint. *) let significantDigits = match Util.osType with `Win32 -> 6 | `Unix -> 32 let thisRootsGlobalName (fspath: Fspath.t): string = root2stringOrAlias (Common.Remote Os.myCanonicalHostName, fspath) (* ----- *) (* The status of an archive *) type archiveVersion = MainArch | NewArch | ScratchArch | Lock let showArchiveName = Prefs.createBool "showarchive" false "!show 'true names' (for rootalias) of roots and archive" ("When this preference is set, Unison will print out the 'true names'" ^ "of the roots, in the same form as is expected by the {\\tt rootalias}" ^ "preference.") let _ = Prefs.alias showArchiveName "showArchiveName" let archiveHash fspath = (* Conjoin the canonical name of the current host and the canonical presentation of the current fspath with the list of names/fspaths of all the roots and the current archive format *) let thisRoot = thisRootsGlobalName fspath in let r = Prefs.read rootsName in let n = Printf.sprintf "%s;%s;%d" thisRoot r archiveFormat in let d = Fingerprint.toString (Fingerprint.string n) in debugverbose (fun()-> Util.msg "Archive name is %s; hashcode is %s\n" n d); if Prefs.read showArchiveName then Util.msg "Archive name is %s; hashcode is %s\n" n d; (String.sub d 0 significantDigits) (* We include the hash part of the archive name in the names of temp files created by this run of Unison. The reason for this is that, during update detection, we are going to silently delete any old temp files that we find along the way, and we want to prevent ourselves from deleting temp files belonging to other instances of Unison that may be running in parallel, e.g. synchronizing with a different host. *) let addHashToTempNames fspath = Os.includeInTempNames (archiveHash fspath) (* [archiveName fspath] returns a pair (arcName, thisRootsGlobalName) *) let archiveName fspath (v: archiveVersion): string * string = let n = archiveHash fspath in let temp = match v with MainArch -> "ar" | NewArch -> "tm" | ScratchArch -> "sc" | Lock -> "lk" in (Printf.sprintf "%s%s" temp n, thisRootsGlobalName fspath) (*****************************************************************************) (* SANITY CHECKS *) (*****************************************************************************) (* [checkArchive] checks the sanity of an archive, and returns its hash-value. 'Sanity' means (1) no repeated name under any path, and (2) NoArchive appears only at root-level (indicated by [top]). Property: Two archives of the same labeled-tree structure have the same hash-value. NB: [h] is the hash accumulator *) let rec checkArchive (top: bool) (path: Path.t) (arch: archive) (h: int): int = match arch with ArchiveDir (desc, children) -> begin match NameMap.validate children with `Ok -> () | `Duplicate nm -> raise (Util.Fatal (Printf.sprintf "Corrupted archive: \ the file %s occurs twice in path %s" (Name.toString nm) (Path.toString path))); | `Invalid -> raise (Util.Fatal (Printf.sprintf "Corrupted archive: the files are not \ correctely ordered in directory %s" (Path.toString path))); end; NameMap.fold (fun n a h -> Uutil.hash2 (Name.hash n) (checkArchive false (Path.child path n) a h)) children (Props.hash desc h) | ArchiveFile (desc, dig, _, ress) -> Uutil.hash2 (Hashtbl.hash dig) (Props.hash desc h) | ArchiveSymlink content -> Uutil.hash2 (Hashtbl.hash content) h | NoArchive -> 135 (* [archivesIdentical l] returns true if all elements in [l] are the same and distinct from None *) let archivesIdentical l = match l with h::r -> h <> None && Safelist.for_all (fun h' -> h = h') r | _ -> true let (archiveNameOnRoot : Common.root -> archiveVersion -> (string * string * bool) Lwt.t) = Remote.registerRootCmd "archiveName" (fun (fspath, v) -> let (name,_) = archiveName fspath v in Lwt.return (name, Os.myCanonicalHostName, Sys.file_exists (Fspath.toString (Os.fileInUnisonDir name)))) let checkArchiveCaseSensitivity l = match l with Some (_, magic) :: _ -> begin try let archMode = String.sub magic 0 (String.index magic '\000') in let curMode = Case.modeDescription () in if curMode <> archMode then begin (* We cannot compute the archive name locally as it currently depends on the os type *) Globals.allRootsMap (fun r -> archiveNameOnRoot r MainArch) >>= fun names -> let l = List.map (fun (name, host, _) -> Format.sprintf " archive %s on host %s" name host) names in Lwt.fail (Util.Fatal (String.concat "\n" ("Warning: incompatible case sensitivity settings." :: Format.sprintf "Unison is currently in %s mode," curMode :: Format.sprintf "while the archives assume %s mode." archMode :: "You should either change Unison's setup " :: "or delete the following archives:" :: l @ ["Then, try again."]))) end else Lwt.return () with Not_found -> Lwt.return () end | _ -> Lwt.return () (*****************************************************************************) (* LOADING AND SAVING ARCHIVES *) (*****************************************************************************) (* [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"; (* This third line is purely informative *) output_string c (Printf.sprintf "Written at %s - %s mode\n" (Util.time2string (Util.time())) (Case.modeDescription ())); Marshal.to_channel c (archive, hash, magic) [Marshal.No_sharing]; close_out c) (* 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@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")); checkArchiveCaseSensitivity checksums >>= fun () -> 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 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 **) 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 Uutil.showUpdateStatus (Path.toString path); (*Trace.statusDetail ("scanning... " ^ Path.toString path);*) t0 := t end end end let showStatusDir path = () (* BCP (4/09) The code above tries to be smart about showing status messages at regular intervals, but people seem to find this confusing. I tried replace all this with something simpler -- just show directories as they are scanned -- but this seems worse: it prints far too much stuff. So I'm going to revert to the old version. *) (* let showStatus path = () let showStatusAddLength info = () let showStatusDir path = if not !Trace.runningasserver then begin Trace.statusDetail ("scanning... " ^ Path.toString path); end *) (* ------- *) 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 here; 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 _ -> Uutil.showUpdateStatus ""; 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 "%s\000%.f.%d" (Case.modeDescription ()) (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@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) unison-2.32.52/update.mli0000644000076500000000000000555511176730177014643 0ustar bcpiercewheel(* 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 unison-2.32.52/uutil.ml0000644000076500000000000001142011207755401014326 0ustar bcpiercewheel(* Unison file synchronizer: src/uutil.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) (*****************************************************************************) (* Unison name and version *) (*****************************************************************************) let myName = ProjectInfo.myName let myVersion = ProjectInfo.myVersion let myMajorVersion = ProjectInfo.myMajorVersion let myNameAndVersion = myName ^ " " ^ myVersion (*****************************************************************************) (* HASHING *) (*****************************************************************************) let hash2 x y = (17 * x + 257 * y) land 0x3FFFFFFF (*****************************************************************************) (* File sizes *) (*****************************************************************************) module type FILESIZE = sig type t val zero : t val dummy : t val add : t -> t -> t val sub : t -> t -> t val toFloat : t -> float val toString : t -> string val ofInt : int -> t val ofInt64 : int64 -> t val toInt : t -> int val toInt64 : t -> int64 val fromStats : Unix.LargeFile.stats -> t val hash : t -> int val percentageOfTotalSize : t -> t -> float end module Filesize : FILESIZE = struct type t = int64 let zero = Int64.zero let dummy = Int64.minus_one let add = Int64.add let sub = Int64.sub let toFloat = Int64.to_float let toString = Int64.to_string let ofInt x = Int64.of_int x let ofInt64 x = x let toInt x = Int64.to_int x let toInt64 x = x let fromStats st = st.Unix.LargeFile.st_size let hash x = hash2 (Int64.to_int x) (Int64.to_int (Int64.shift_right_logical x 31)) let percentageOfTotalSize current total = let total = toFloat total in if total = 0. then 100.0 else toFloat current *. 100.0 /. total end (*****************************************************************************) (* File tranfer progress display *) (*****************************************************************************) module File = struct type t = int let dummy = -1 let ofLine l = l let toLine l = assert (l <> dummy); l let toString l = if l=dummy then "" else string_of_int l end let progressPrinter = ref (fun _ _ _ -> ()) let setProgressPrinter p = progressPrinter := p let showProgress i bytes ch = if i <> File.dummy then !progressPrinter i bytes ch let statusPrinter = ref None let setUpdateStatusPrinter p = statusPrinter := p let showUpdateStatus path = match !statusPrinter with Some f -> f path | None -> Trace.statusDetail path (*****************************************************************************) (* Copy bytes from one file_desc to another *) (*****************************************************************************) 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) unison-2.32.52/uutil.mli0000644000076500000000000000370411207755401014505 0ustar bcpiercewheel(* 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 val setUpdateStatusPrinter : (string -> unit) option -> unit val showUpdateStatus : 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 unison-2.32.52/win32rc/0000755000076500000000000000000011222164527014123 5ustar bcpiercewheelunison-2.32.52/win32rc/U.ico0000644000076500000000000010600011203037745015020 0ustar bcpiercewheel v ^ ; 00 %G  hm ~ h( @ ????( @ʦ """)))UUUMMMBBB999|PP3f3333f333ff3fffff3f3f̙f3333f3333333333f3333333f3f33ff3f3f3f3333f3333333f3̙33333f333ff3ffffff3f33f3ff3f3f3ffff3fffffffff3fffffff3f̙ffff3ff333f3ff33fff33f3ff̙3f3f3333f333ff3fffff̙̙3̙f̙̙̙3f̙3f3f3333f333ff3fffff3f3f̙3ffffffffff!___www ,,, ,,, ,,,, ,,,, ,,,,, ,,,,, ,,,,, ,,,,, ,,,,, ,,,,, ,2,2, ,2,2, 2,2,2 2,2,2 22222 22222 22222 22222 22222 22222 22222 22222 28282 28282 82828 82828 28282 28282 88888 88888 88888 88888 88888 88888 888 888 88 88 88 88 ????PNG  IHDR\rf;IDATx]DI ( ]9tTPQbA;鈠Jޛyɦ&If7Kf^fg'y{ +@ ] )HiD#Rڕ`!҉+'2#"'rv8(DJ9C!+2%HUڟDZLrT|"UUi"v@f!  x={";.#ҝv9|G"IDI3iڕ?w~hݦ;24?( $rƃ27Y6ǥYDZB^" ߏD*Uy !G$X4k<_]|I?axP@VX1P6'9rԝ ;'&zx'D%%h9sڔpK ԭ mz֛ ǎ]^&2vB<@" Od\!wGn'%q`#sx $'ji#-<X/^pzڕJwH$199 L^6+d3aĻۤDj9HKp > a/t2!`w%yۈG)=tZ* >mLuH#"G<@3 ȣÇU1hЭ S\%=ʹ7ˈW ΟOGH8X`Z.Nz?)wxr Dy,"RO:u) cUU(0!8pkq(g$gw-6Hc"h9(LdxҤ50zvHǏˣ8/,Phi,U={4W\]cO 907oFqA~%9lbahFPbnDžՙ{=/%$/+IKs?~:?(_w\ދҖfbи<8}Zvy_6p8<}mUuaC/-qh;/؃>,cAnb+Q?f,+W_"* SH2<5g(0.@c<.p^P 6 d{N OCP GqGnޏ䃐q(0~.Erx,ЃKf`Ѐ 0vDPp. CQ{9C3 Ը8 5Y ;e%|Tj k ;/4ZZ÷Qີ(0z=GA8q<ȕY t*}̛{DJg w$p]'?G_~ȧ&gၛ@Vqe{p3RwDDrer {%Fq]DnL \k@Y?4j^ݻA:sf""ƱU]0n.xYIH ,Я͝EUfм&#D>Hfe@FэK^3J ҙ3:X @ ];ﾑmF1H \s,Г°Ql@"9/[L軍KoїRy\l% n}B?﨔{` If,z,w?Ԅ,Y?ʘ_H@2f~8/px0c4pe!°jx,jU[JMgHm !th&N̬1` ,@Lh@gxi+΀0Σ0 \͵=!L|L 3ΚUtF;vYCrf6𨉡S!Ls` "l`pul8,iE@ S&ˣQÌϥ]p0 4cVW?r% fuYhh:KDrx>= 32h+@I6,_qn%ᢣкbu 3mg &iuY83֩GwA YoUg[MI?.]WÌw*X MGW @ Ю21x\GG0J_.0~@t ^ 9Dq +7Wo\%w-.4a8$1pS*0abm,nE%ZfcwKi{jhpݶN"o8dϞ(^yI3qp;G'}Iֵ[>?f{.SW9$9zoa;zZ ?%nHEhf^x `;+jRޅ!p>%E[FBBa괺%ɹ׋Җ)f{&8NC;oS\k-<逛__ƜqÌA vk-[,Sֵl;QzB6Uc]D``R!Lu1XX˯ TSLa-CaZ՜B51֊y?#0gJ~q+ni9x 61v15H.Om"4Ak]Yғwov%t )dC c- LY$)d(uסH g p5:Fzp n t2B>7'@A] sm JYi=9x V5mV"]Z}bЫ,2P`e#} C$ƪe7+/!NC!zkzڋ3d@MV!0'Haf]sp kegTN^B& ){nYC |^e c(0 #ܪ᳁nVVB!/mwyA9x fM.; '5|% \gmT 9lC!?( 0S"[88Dän5v+K @'8x K͊ 1Gh=P`Vm} L NN!@E7+K lC!kd$t~a|\J>JY< c({4. 7K*'P.o ߜEE:#B4)gxSP7Ѯ'e+c)5|\)h9x r$¾W+PρguNNG̵zb*`7;PZ zs~&[]rn 'Z6N[TW DCо?'Z5  NN!@c 3eS}4׎`3sp &~xKd.c><b^FRN ~aWd@&|0[5 h,'U}t798B#oi1>)b*k&NB!5TWkN.tS(~4aV^p(0FdV' |&HP{0p3s LᛁL'GPJ[<?h7;P`}7+NN~ L[8dk>rA98H*Dm8x-Xy .I^!5WXG7*kfNB!_`qb488BF! ,h8x ~Vpwpp䅉T0UcQ}~2$ױ݇`GJA#/o-ѫ-|w=N @ͼ0A0|up tx)hR. ~6MNC!{EibBQ{88HUE2 sG"MÒ``R&khfn [(Dt ܬqp ^-]EXX8TO2:0uwF;1DH5! I=?  0pXp:8l'o% ܬ&Hpk@hfzs | so؏`4qp ^\/(:df |)O_q\CY=? !ȮF;P`Dwӣ[gJ^{bxPLz~N^VN|& %$7)GR$8xv%T[nI'z4_"TF(-خWYwwq gs4'P2>8xĄ (@٢q  G^{ !D+DuBHپB#q"3YY0L0Y)P/H ^'Q"E_7}IP-øƟ &+jxJB#ws  Ƨp#ϵc=XsFd`R&gKksX *K 5pHV VT\QA0UN4N^B!,Dbtp<36 =T VԣD )~{5C/?|/LQfdqRB[`1R`֖sx,vU8HpL3E7 Bm |C$&{[nE/ڎ;9ːvUHקWS <2f/llmEyϫ&kCB荁GK vUIJ%S`@`>Bq% yAp4,; 63CM}su(wX _Wkh7X%D\< ЊOOn}_- cVR"JK^ <\vǸt@݀z`&rs`k8,n=cN9[ke&RLdXޯdE7b0tH1ͧV /" +uCJ|1O&DZT(_8+,_q%UW8,Bj9 /> %h6X%D*־iX037'sK FJW8JC׽Ԧk#{M ;x wnU͗ H\4p]ؼL8 ){?~6X&Qųc^GW"@A ]J /' 6G].^tF̒ Vn2 =HR)0[!h%7 =MGK9`" Lm \?}6p37 Y96nƥSCN \Oρ~ZwAv AX*$"oD)~5pmZ/LjNY{7Э.GRv9 \u`W_eQgCQk!qB ժH*L'*gJN \q<]&DVPhx%1;nX9T'@T݀z`&+[ra-'.e?8:M&Dk>S]ٯMAVs|VN*|G=Y7et_QN+Seh@&;K-F -ׅ>;. 5H#ڍV c"!exfѺx“8rQ+Z`hӭGeW64"WJCJN:iuF/=N:"{ѡzܚ6Jaɯsf@O?iG *@M}i6`4LwUNs{CQ`<]t1[M< A| `br7@@/`Q\P& 2L-wRvأɫpby ڤd6/ i>^*K@;@h ;c`\; aVW'u)YG A ʕ͗;]㲁NbW=~8_܃ hjXs[NwFo++Fy @+"3h7X' <5)*kі.r[M= PB;,u.U xeN9we㲔.Q.l^d<㥁Gi?< \! ΁a _Hބ? ^&M.7_]Nq!`@"`=zhu׌u#5&t1bLsaUY;%4 )!jtN0pZ} V6y@୺g0z~H@k40(Cd+,- %—bۺF<#TM /ԣی:ڗK ra3ppXZ@3R6hO#2t=O y"))X'|$wo>1Ůۼ&2X'[.5O8!fcTX?m${aF&n{a؞t)o>Ne<*/T&ILq+XNf 3Ԇk .1"4ȗ~rc5'::ÔcW\< # ?o=nL^_nk_{ 7/pèa kY#+T 癁k,vu J d2 @ WA2`DhBHxԲ?9,bۉ\ ezOe]OG7@xr%tvq(\(S">]q{ӓZB`9gp'%>' x8+I~) j {$Vj}~Dq!h1HO[Bbw\z \0k@ϵaIG pHfpBBSe%c"Ϯzc5p9?WGxSq B۳ +]3K}ߩ;)[ =|:`x `@? 5r_. %x(95 ܬ.w$r_DWp$@: \TKuXCs蕁kҢ?H^A. $Ui$tm| .9ZKgTyȶg7Fl@MI 0BeX,;Ϛ`2tNc3pk ?+.̀7v\5F8TӅiz 덛{ʡ1C"Y$1p3|~ܠi7Y 4@Ϫe‹7fu^{]D*[x*!+F bΎxжn#z'9ȟK7h^[m%]-T@ hF9H/`ETȗewЉsxa#Wat}!B{ bVHFߖH "j9` P1ե{ $eONv4@;=q}2<_6ZF 'YBljox]뉡'q u=, N;7Ɠ7$AbfM?x ̽?h)L\U]9ϩ ų%xg\\V_Se=n_pFwT(E`< R0- /F)JImx\ ~.ߑ at r7L1 hJ1 .A|&> {HM`2  'zPT "&_>ʠM.ӮG@`9\R;5?e9.m %0trlA ̈~@^we5?{S|) z!jpwa VHS {17#z k[ C#]@!|}<ChgxEf  ATM(*82=?0L Njd@`?\'y޹\1p _p%DD~q.W@Qm826^\#bW7{39b?= 0fc'vDf$ y#NzeFw`'/O1qGYGGh)%`DW TI]57?xVfGx-3%2; p3AܼRH//Tn9e^#V]*"l]?}pg\+XA8}$4?g߿L ϐ}y* v{ \~g}[1I@|iW#ȻU]h %8D}!4>E^:xAQ>F@,1_OEl[4+|9$pkAt!cnqG O]̅tҵqF4%Ed$2 .0'{@D2(Ψ]6ĥť:*]<.aA=kN΀\5 +gb83؅UykTE%q8'v*B @ a}.ƭ6mP'`7;) !;K" 8$b7Z;^  Q0f 28ppdb2SdsIENDB`(0`  <)|- 2 : B H B ; 1,P . Gb')+++++++)"qN 3  2m(++++++++++++++++)y 9 #$P^(++++++++++++++++++++*j)`+z++++++++++++++++++++++++ 3#T0.-,++++++++++++++++++++++'UY:98754321/.-+&$)++++++++++++Z3 B C BA@?=<;:,U; / (w#h , 2 A,++++++++( 0 !` N M L J I H G F @G $a / 1+4310/.-+N NEWVUTSQP J? ,4<;:8765#30[a`_]\[Z$_Y E D C BA?>0Q;ljihgfd]50L N L K J I H < %l &LutsqponL5(yNWVUTRQ J, 0Y ~ }|{zxwK( aQa_^]\[X/6]$###""!J HRjihfedc8<`(''&&%%G{6Rsrqpnml@?d**)))))Cm&O }{zyxwu $IFk,++++**?dJ##""!!  +P Px----,,,?aJy''&&%%$ 2WTz///....AbMz*))))((7[W{1100000CbOz++++***:\Y{3222221EbRz---,,,,;\[{4444433GbTz//....-=\^{6666555IbV{10000//?\`|8887777JbY{2222111A\b|::99998Lc[{4443333B\e|;;;;;::Nc]{6655555D] g|====<<<Pc_|8777776F] i}???>>>>Rcb|9999988H]!l}AA@@@@?Tdd|;;;;:::J]"n}CBBBBAAVdg|==<<<<<K^#p}DDDDCCCWd i}??>>>>=M^$s~FFFEEEEYd!k}@@@@@??O^%u~HHGGGGG[d"n}BBBBAAAQ^&w~JIIIIIH]d#p}DDDCCCCR^'yKKKKJJJ_d$r}FFEEEEDT^'|MMMMLLLae%t~HGGGGFFV^(OONNNNNbd&w~IIIIHHHV]JI))AQPPPPPO;(~(}HIKN'z'y?JOONNNNNMMG:; IHPRRRRRRRPIH LKOPPPPOOOMEF ZYRRRRRRRZY `^RRRRQQQWW  5%trRRRRR%tr 5 "";({yRRRRR$pn 1,+U/RRR/,+U-,\2RRR.+*O10x9R910x21;R7//q3223254232 r r????( @  3^\mt|{n[ As!=P(++++++++&X 7K{*+++++++++++++ ?WDf%,+++++++++++++++% ?[ #<:8643.!&++++++L I J H F D A!v?f  7Hp.1/-+)Ks 5ZXVTR#cY?=;97~AhfdbH   8 K I G F(Pvtrp< 5YWVT 2b""! B}<gedb ?k(''&GyAutrp L u++**IuF}""! ~ Xz.---JqM|('&&`~000/MqP|+***j3322QrS|---, p5554TrW}00// w8877Wr[}3222;:::Zs^}5554 @==<]sb~8877 @@??ase~;:::"CBBBdt h~===9!EEED gt!l@@?<'HHGG!ku#pCBBB KJJJ"mu$sEEED MMML$qu%wHHGG32)}%rqPPOO.'{}ABAD&w}0KJJJ!go$s{-1 -RRRRRRQ?JJUJK\>NMMMLLL(}76/5RRRRRFQPsRRzFPPOOO101(DCJ=RRRLVUXWMRRR:BADMLhDRP`_ cbPRBKJaTRI$om %trHQP~@? A@???(0 :*Xht{cr D/p$++++++++%t " ++++++++++++ p><974(  )++++k  AQO L ANq A`0742$ 6Badb^ ,n$n H G E= *7 (M_ywta,9VZXT>S==`v|'}GFF22AA@dv|)JJI45EDD iw|*NNM78HHG!ir )(&'ywERQQK:HHEG8HLKK<"lr !!YWACRRRR)~(~~POON?RS<!fdZHRR11RRG dcV%rqtL876768L$qos#mkPO*PO*#mkAAAAA~A~A~A~AAAAAAAAAA<A<A<A~AAA(  e/ "" h.l&++++++'jf)=@<-&#$++'RBy`\D5 C?&o[|xHgBw_\ <p))S]Ok{xS$~/.WW[e))k(43^Wce/.!w,99eW le43&0?>!mW#te99*5DC$tW&|e?>-8II'{W*eDC1%rrW=NN-ae6_e6.IH6!hrW+LLRRDVUTTANNG(L0gOH&vu'&vu'HO0g2~-@-@2~AAAAìAìAìAìAìAìAìAìAAAìAAunison-2.32.52/win32rc/unison.rc0000644000076500000000000000006411203037745015764 0ustar bcpiercewheel#include UNISON_ICON ICON "U.ico" unison-2.32.52/win32rc/unison.res0000644000076500000000000010645011203037745016157 0ustar bcpiercewheel   ( @ ????  ( @ʦ """)))UUUMMMBBB999|PP3f3333f333ff3fffff3f3f̙f3333f3333333333f3333333f3f33ff3f3f3f3333f3333333f3̙33333f333ff3ffffff3f33f3ff3f3f3ffff3fffffffff3fffffff3f̙ffff3ff333f3ff33fff33f3ff̙3f3f3333f333ff3fffff̙̙3̙f̙̙̙3f̙3f3f3333f333ff3fffff3f3f̙3ffffffffff!___www ,,, ,,, ,,,, ,,,, ,,,,, ,,,,, ,,,,, ,,,,, ,,,,, ,,,,, ,2,2, ,2,2, 2,2,2 2,2,2 22222 22222 22222 22222 22222 22222 22222 22222 28282 28282 82828 82828 28282 28282 88888 88888 88888 88888 88888 88888 888 888 88 88 88 88 ????;  PNG  IHDR\rf;IDATx]DI ( ]9tTPQbA;鈠Jޛyɦ&If7Kf^fg'y{ +@ ] )HiD#Rڕ`!҉+'2#"'rv8(DJ9C!+2%HUڟDZLrT|"UUi"v@f!  x={";.#ҝv9|G"IDI3iڕ?w~hݦ;24?( $rƃ27Y6ǥYDZB^" ߏD*Uy !G$X4k<_]|I?axP@VX1P6'9rԝ ;'&zx'D%%h9sڔpK ԭ mz֛ ǎ]^&2vB<@" Od\!wGn'%q`#sx $'ji#-<X/^pzڕJwH$199 L^6+d3aĻۤDj9HKp > a/t2!`w%yۈG)=tZ* >mLuH#"G<@3 ȣÇU1hЭ S\%=ʹ7ˈW ΟOGH8X`Z.Nz?)wxr Dy,"RO:u) cUU(0!8pkq(g$gw-6Hc"h9(LdxҤ50zvHǏˣ8/,Phi,U={4W\]cO 907oFqA~%9lbahFPbnDžՙ{=/%$/+IKs?~:?(_w\ދҖfbи<8}Zvy_6p8<}mUuaC/-qh;/؃>,cAnb+Q?f,+W_"* SH2<5g(0.@c<.p^P 6 d{N OCP GqGnޏ䃐q(0~.Erx,ЃKf`Ѐ 0vDPp. CQ{9C3 Ը8 5Y ;e%|Tj k ;/4ZZ÷Qີ(0z=GA8q<ȕY t*}̛{DJg w$p]'?G_~ȧ&gၛ@Vqe{p3RwDDrer {%Fq]DnL \k@Y?4j^ݻA:sf""ƱU]0n.xYIH ,Я͝EUfм&#D>Hfe@FэK^3J ҙ3:X @ ];ﾑmF1H \s,Г°Ql@"9/[L軍KoїRy\l% n}B?﨔{` If,z,w?Ԅ,Y?ʘ_H@2f~8/px0c4pe!°jx,jU[JMgHm !th&N̬1` ,@Lh@gxi+΀0Σ0 \͵=!L|L 3ΚUtF;vYCrf6𨉡S!Ls` "l`pul8,iE@ S&ˣQÌϥ]p0 4cVW?r% fuYhh:KDrx>= 32h+@I6,_qn%ᢣкbu 3mg &iuY83֩GwA YoUg[MI?.]WÌw*X MGW @ Ю21x\GG0J_.0~@t ^ 9Dq +7Wo\%w-.4a8$1pS*0abm,nE%ZfcwKi{jhpݶN"o8dϞ(^yI3qp;G'}Iֵ[>?f{.SW9$9zoa;zZ ?%nHEhf^x `;+jRޅ!p>%E[FBBa괺%ɹ׋Җ)f{&8NC;oS\k-<逛__ƜqÌA vk-[,Sֵl;QzB6Uc]D``R!Lu1XX˯ TSLa-CaZ՜B51֊y?#0gJ~q+ni9x 61v15H.Om"4Ak]Yғwov%t )dC c- LY$)d(uסH g p5:Fzp n t2B>7'@A] sm JYi=9x V5mV"]Z}bЫ,2P`e#} C$ƪe7+/!NC!zkzڋ3d@MV!0'Haf]sp kegTN^B& ){nYC |^e c(0 #ܪ᳁nVVB!/mwyA9x fM.; '5|% \gmT 9lC!?( 0S"[88Dän5v+K @'8x K͊ 1Gh=P`Vm} L NN!@E7+K lC!kd$t~a|\J>JY< c({4. 7K*'P.o ߜEE:#B4)gxSP7Ѯ'e+c)5|\)h9x r$¾W+PρguNNG̵zb*`7;PZ zs~&[]rn 'Z6N[TW DCо?'Z5  NN!@c 3eS}4׎`3sp &~xKd.c><b^FRN ~aWd@&|0[5 h,'U}t798B#oi1>)b*k&NB!5TWkN.tS(~4aV^p(0FdV' |&HP{0p3s LᛁL'GPJ[<?h7;P`}7+NN~ L[8dk>rA98H*Dm8x-Xy .I^!5WXG7*kfNB!_`qb488BF! ,h8x ~Vpwpp䅉T0UcQ}~2$ױ݇`GJA#/o-ѫ-|w=N @ͼ0A0|up tx)hR. ~6MNC!{EibBQ{88HUE2 sG"MÒ``R&khfn [(Dt ܬqp ^-]EXX8TO2:0uwF;1DH5! I=?  0pXp:8l'o% ܬ&Hpk@hfzs | so؏`4qp ^\/(:df |)O_q\CY=? !ȮF;P`Dwӣ[gJ^{bxPLz~N^VN|& %$7)GR$8xv%T[nI'z4_"TF(-خWYwwq gs4'P2>8xĄ (@٢q  G^{ !D+DuBHپB#q"3YY0L0Y)P/H ^'Q"E_7}IP-øƟ &+jxJB#ws  Ƨp#ϵc=XsFd`R&gKksX *K 5pHV VT\QA0UN4N^B!,Dbtp<36 =T VԣD )~{5C/?|/LQfdqRB[`1R`֖sx,vU8HpL3E7 Bm |C$&{[nE/ڎ;9ːvUHקWS <2f/llmEyϫ&kCB荁GK vUIJ%S`@`>Bq% yAp4,; 63CM}su(wX _Wkh7X%D\< ЊOOn}_- cVR"JK^ <\vǸt@݀z`&rs`k8,n=cN9[ke&RLdXޯdE7b0tH1ͧV /" +uCJ|1O&DZT(_8+,_q%UW8,Bj9 /> %h6X%D*־iX037'sK FJW8JC׽Ԧk#{M ;x wnU͗ H\4p]ؼL8 ){?~6X&Qųc^GW"@A ]J /' 6G].^tF̒ Vn2 =HR)0[!h%7 =MGK9`" Lm \?}6p37 Y96nƥSCN \Oρ~ZwAv AX*$"oD)~5pmZ/LjNY{7Э.GRv9 \u`W_eQgCQk!qB ժH*L'*gJN \q<]&DVPhx%1;nX9T'@T݀z`&+[ra-'.e?8:M&Dk>S]ٯMAVs|VN*|G=Y7et_QN+Seh@&;K-F -ׅ>;. 5H#ڍV c"!exfѺx“8rQ+Z`hӭGeW64"WJCJN:iuF/=N:"{ѡzܚ6Jaɯsf@O?iG *@M}i6`4LwUNs{CQ`<]t1[M< A| `br7@@/`Q\P& 2L-wRvأɫpby ڤd6/ i>^*K@;@h ;c`\; aVW'u)YG A ʕ͗;]㲁NbW=~8_܃ hjXs[NwFo++Fy @+"3h7X' <5)*kі.r[M= PB;,u.U xeN9we㲔.Q.l^d<㥁Gi?< \! ΁a _Hބ? ^&M.7_]Nq!`@"`=zhu׌u#5&t1bLsaUY;%4 )!jtN0pZ} V6y@୺g0z~H@k40(Cd+,- %—bۺF<#TM /ԣی:ڗK ra3ppXZ@3R6hO#2t=O y"))X'|$wo>1Ůۼ&2X'[.5O8!fcTX?m${aF&n{a؞t)o>Ne<*/T&ILq+XNf 3Ԇk .1"4ȗ~rc5'::ÔcW\< # ?o=nL^_nk_{ 7/pèa kY#+T 癁k,vu J d2 @ WA2`DhBHxԲ?9,bۉ\ ezOe]OG7@xr%tvq(\(S">]q{ӓZB`9gp'%>' x8+I~) j {$Vj}~Dq!h1HO[Bbw\z \0k@ϵaIG pHfpBBSe%c"Ϯzc5p9?WGxSq B۳ +]3K}ߩ;)[ =|:`x `@? 5r_. %x(95 ܬ.w$r_DWp$@: \TKuXCs蕁kҢ?H^A. $Ui$tm| .9ZKgTyȶg7Fl@MI 0BeX,;Ϛ`2tNc3pk ?+.̀7v\5F8TӅiz 덛{ʡ1C"Y$1p3|~ܠi7Y 4@Ϫe‹7fu^{]D*[x*!+F bΎxжn#z'9ȟK7h^[m%]-T@ hF9H/`ETȗewЉsxa#Wat}!B{ bVHFߖH "j9` P1ե{ $eONv4@;=q}2<_6ZF 'YBljox]뉡'q u=, N;7Ɠ7$AbfM?x ̽?h)L\U]9ϩ ų%xg\\V_Se=n_pFwT(E`< R0- /F)JImx\ ~.ߑ at r7L1 hJ1 .A|&> {HM`2  'zPT "&_>ʠM.ӮG@`9\R;5?e9.m %0trlA ̈~@^we5?{S|) z!jpwa VHS {17#z k[ C#]@!|}<ChgxEf  ATM(*82=?0L Njd@`?\'y޹\1p _p%DD~q.W@Qm826^\#bW7{39b?= 0fc'vDf$ y#NzeFw`'/O1qGYGGh)%`DW TI]57?xVfGx-3%2; p3AܼRH//Tn9e^#V]*"l]?}pg\+XA8}$4?g߿L ϐ}y* v{ \~g}[1I@|iW#ȻU]h %8D}!4>E^:xAQ>F@,1_OEl[4+|9$pkAt!cnqG O]̅tҵqF4%Ed$2 .0'{@D2(Ψ]6ĥť:*]<.aA=kN΀\5 +gb83؅UykTE%q8'v*B @ a}.ƭ6mP'`7;) !;K" 8$b7Z;^  Q0f 28ppdb2SdsIENDB`%  (0`  <)|- 2 : B H B ; 1,P . Gb')+++++++)"qN 3  2m(++++++++++++++++)y 9 #$P^(++++++++++++++++++++*j)`+z++++++++++++++++++++++++ 3#T0.-,++++++++++++++++++++++'UY:98754321/.-+&$)++++++++++++Z3 B C BA@?=<;:,U; / (w#h , 2 A,++++++++( 0 !` N M L J I H G F @G $a / 1+4310/.-+N NEWVUTSQP J? ,4<;:8765#30[a`_]\[Z$_Y E D C BA?>0Q;ljihgfd]50L N L K J I H < %l &LutsqponL5(yNWVUTRQ J, 0Y ~ }|{zxwK( aQa_^]\[X/6]$###""!J HRjihfedc8<`(''&&%%G{6Rsrqpnml@?d**)))))Cm&O }{zyxwu $IFk,++++**?dJ##""!!  +P Px----,,,?aJy''&&%%$ 2WTz///....AbMz*))))((7[W{1100000CbOz++++***:\Y{3222221EbRz---,,,,;\[{4444433GbTz//....-=\^{6666555IbV{10000//?\`|8887777JbY{2222111A\b|::99998Lc[{4443333B\e|;;;;;::Nc]{6655555D] g|====<<<Pc_|8777776F] i}???>>>>Rcb|9999988H]!l}AA@@@@?Tdd|;;;;:::J]"n}CBBBBAAVdg|==<<<<<K^#p}DDDDCCCWd i}??>>>>=M^$s~FFFEEEEYd!k}@@@@@??O^%u~HHGGGGG[d"n}BBBBAAAQ^&w~JIIIIIH]d#p}DDDCCCCR^'yKKKKJJJ_d$r}FFEEEEDT^'|MMMMLLLae%t~HGGGGFFV^(OONNNNNbd&w~IIIIHHHV]JI))AQPPPPPO;(~(}HIKN'z'y?JOONNNNNMMG:; IHPRRRRRRRPIH LKOPPPPOOOMEF ZYRRRRRRRZY `^RRRRQQQWW  5%trRRRRR%tr 5 "";({yRRRRR$pn 1,+U/RRR/,+U-,\2RRR.+*O10x9R910x21;R7//q3223254232 r r????  ( @  3^\mt|{n[ As!=P(++++++++&X 7K{*+++++++++++++ ?WDf%,+++++++++++++++% ?[ #<:8643.!&++++++L I J H F D A!v?f  7Hp.1/-+)Ks 5ZXVTR#cY?=;97~AhfdbH   8 K I G F(Pvtrp< 5YWVT 2b""! B}<gedb ?k(''&GyAutrp L u++**IuF}""! ~ Xz.---JqM|('&&`~000/MqP|+***j3322QrS|---, p5554TrW}00// w8877Wr[}3222;:::Zs^}5554 @==<]sb~8877 @@??ase~;:::"CBBBdt h~===9!EEED gt!l@@?<'HHGG!ku#pCBBB KJJJ"mu$sEEED MMML$qu%wHHGG32)}%rqPPOO.'{}ABAD&w}0KJJJ!go$s{-1 -RRRRRRQ?JJUJK\>NMMMLLL(}76/5RRRRRFQPsRRzFPPOOO101(DCJ=RRRLVUXWMRRR:BADMLhDRP`_ cbPRBKJaTRI$om %trHQP~@? A@???  (0 :*Xht{cr D/p$++++++++%t " ++++++++++++ p><974(  )++++k  AQO L ANq A`0742$ 6Badb^ ,n$n H G E= *7 (M_ywta,9VZXT>S==`v|'}GFF22AA@dv|)JJI45EDD iw|*NNM78HHG!ir )(&'ywERQQK:HHEG8HLKK<"lr !!YWACRRRR)~(~~POON?RS<!fdZHRR11RRG dcV%rqtL876768L$qos#mkPO*PO*#mkAAAAA~A~A~A~AAAAAAAAAA<A<A<A~AAAh  (  e/ "" h.l&++++++'jf)=@<-&#$++'RBy`\D5 C?&o[|xHgBw_\ <p))S]Ok{xS$~/.WW[e))k(43^Wce/.!w,99eW le43&0?>!mW#te99*5DC$tW&|e?>-8II'{W*eDC1%rrW=NN-ae6_e6.IH6!hrW+LLRRDVUTTANNG(L0gOH&vu'&vu'HO0g2~-@-@2~AAAAìAìAìAìAìAìAìAìAAAìAAh4UNISON_ICON    ;00 %    hunison-2.32.52/win32rc/unison.res.lib0000755000076500000000000010715611203037745016733 0ustar bcpiercewheelLX.rsrc̍<@0|J |Jh|J X|J h|J x|J |J |J |J |J@(|J  UNISON_ICONh ;$I%nt hdh( @ ????( @ʦ """)))UUUMMMBBB999|PP3f3333f333ff3fffff3f3f̙f3333f3333333333f3333333f3f33ff3f3f3f3333f3333333f3̙33333f333ff3ffffff3f33f3ff3f3f3ffff3fffffffff3fffffff3f̙ffff3ff333f3ff33fff33f3ff̙3f3f3333f333ff3fffff̙̙3̙f̙̙̙3f̙3f3f3333f333ff3fffff3f3f̙3ffffffffff!___www ,,, ,,, ,,,, ,,,, ,,,,, ,,,,, ,,,,, ,,,,, ,,,,, ,,,,, ,2,2, ,2,2, 2,2,2 2,2,2 22222 22222 22222 22222 22222 22222 22222 22222 28282 28282 82828 82828 28282 28282 88888 88888 88888 88888 88888 88888 888 888 88 88 88 88 ????PNG  IHDR\rf;IDATx]DI ( ]9tTPQbA;鈠Jޛyɦ&If7Kf^fg'y{ +@ ] )HiD#Rڕ`!҉+'2#"'rv8(DJ9C!+2%HUڟDZLrT|"UUi"v@f!  x={";.#ҝv9|G"IDI3iڕ?w~hݦ;24?( $rƃ27Y6ǥYDZB^" ߏD*Uy !G$X4k<_]|I?axP@VX1P6'9rԝ ;'&zx'D%%h9sڔpK ԭ mz֛ ǎ]^&2vB<@" Od\!wGn'%q`#sx $'ji#-<X/^pzڕJwH$199 L^6+d3aĻۤDj9HKp > a/t2!`w%yۈG)=tZ* >mLuH#"G<@3 ȣÇU1hЭ S\%=ʹ7ˈW ΟOGH8X`Z.Nz?)wxr Dy,"RO:u) cUU(0!8pkq(g$gw-6Hc"h9(LdxҤ50zvHǏˣ8/,Phi,U={4W\]cO 907oFqA~%9lbahFPbnDžՙ{=/%$/+IKs?~:?(_w\ދҖfbи<8}Zvy_6p8<}mUuaC/-qh;/؃>,cAnb+Q?f,+W_"* SH2<5g(0.@c<.p^P 6 d{N OCP GqGnޏ䃐q(0~.Erx,ЃKf`Ѐ 0vDPp. CQ{9C3 Ը8 5Y ;e%|Tj k ;/4ZZ÷Qີ(0z=GA8q<ȕY t*}̛{DJg w$p]'?G_~ȧ&gၛ@Vqe{p3RwDDrer {%Fq]DnL \k@Y?4j^ݻA:sf""ƱU]0n.xYIH ,Я͝EUfм&#D>Hfe@FэK^3J ҙ3:X @ ];ﾑmF1H \s,Г°Ql@"9/[L軍KoїRy\l% n}B?﨔{` If,z,w?Ԅ,Y?ʘ_H@2f~8/px0c4pe!°jx,jU[JMgHm !th&N̬1` ,@Lh@gxi+΀0Σ0 \͵=!L|L 3ΚUtF;vYCrf6𨉡S!Ls` "l`pul8,iE@ S&ˣQÌϥ]p0 4cVW?r% fuYhh:KDrx>= 32h+@I6,_qn%ᢣкbu 3mg &iuY83֩GwA YoUg[MI?.]WÌw*X MGW @ Ю21x\GG0J_.0~@t ^ 9Dq +7Wo\%w-.4a8$1pS*0abm,nE%ZfcwKi{jhpݶN"o8dϞ(^yI3qp;G'}Iֵ[>?f{.SW9$9zoa;zZ ?%nHEhf^x `;+jRޅ!p>%E[FBBa괺%ɹ׋Җ)f{&8NC;oS\k-<逛__ƜqÌA vk-[,Sֵl;QzB6Uc]D``R!Lu1XX˯ TSLa-CaZ՜B51֊y?#0gJ~q+ni9x 61v15H.Om"4Ak]Yғwov%t )dC c- LY$)d(uסH g p5:Fzp n t2B>7'@A] sm JYi=9x V5mV"]Z}bЫ,2P`e#} C$ƪe7+/!NC!zkzڋ3d@MV!0'Haf]sp kegTN^B& ){nYC |^e c(0 #ܪ᳁nVVB!/mwyA9x fM.; '5|% \gmT 9lC!?( 0S"[88Dän5v+K @'8x K͊ 1Gh=P`Vm} L NN!@E7+K lC!kd$t~a|\J>JY< c({4. 7K*'P.o ߜEE:#B4)gxSP7Ѯ'e+c)5|\)h9x r$¾W+PρguNNG̵zb*`7;PZ zs~&[]rn 'Z6N[TW DCо?'Z5  NN!@c 3eS}4׎`3sp &~xKd.c><b^FRN ~aWd@&|0[5 h,'U}t798B#oi1>)b*k&NB!5TWkN.tS(~4aV^p(0FdV' |&HP{0p3s LᛁL'GPJ[<?h7;P`}7+NN~ L[8dk>rA98H*Dm8x-Xy .I^!5WXG7*kfNB!_`qb488BF! ,h8x ~Vpwpp䅉T0UcQ}~2$ױ݇`GJA#/o-ѫ-|w=N @ͼ0A0|up tx)hR. ~6MNC!{EibBQ{88HUE2 sG"MÒ``R&khfn [(Dt ܬqp ^-]EXX8TO2:0uwF;1DH5! I=?  0pXp:8l'o% ܬ&Hpk@hfzs | so؏`4qp ^\/(:df |)O_q\CY=? !ȮF;P`Dwӣ[gJ^{bxPLz~N^VN|& %$7)GR$8xv%T[nI'z4_"TF(-خWYwwq gs4'P2>8xĄ (@٢q  G^{ !D+DuBHپB#q"3YY0L0Y)P/H ^'Q"E_7}IP-øƟ &+jxJB#ws  Ƨp#ϵc=XsFd`R&gKksX *K 5pHV VT\QA0UN4N^B!,Dbtp<36 =T VԣD )~{5C/?|/LQfdqRB[`1R`֖sx,vU8HpL3E7 Bm |C$&{[nE/ڎ;9ːvUHקWS <2f/llmEyϫ&kCB荁GK vUIJ%S`@`>Bq% yAp4,; 63CM}su(wX _Wkh7X%D\< ЊOOn}_- cVR"JK^ <\vǸt@݀z`&rs`k8,n=cN9[ke&RLdXޯdE7b0tH1ͧV /" +uCJ|1O&DZT(_8+,_q%UW8,Bj9 /> %h6X%D*־iX037'sK FJW8JC׽Ԧk#{M ;x wnU͗ H\4p]ؼL8 ){?~6X&Qųc^GW"@A ]J /' 6G].^tF̒ Vn2 =HR)0[!h%7 =MGK9`" Lm \?}6p37 Y96nƥSCN \Oρ~ZwAv AX*$"oD)~5pmZ/LjNY{7Э.GRv9 \u`W_eQgCQk!qB ժH*L'*gJN \q<]&DVPhx%1;nX9T'@T݀z`&+[ra-'.e?8:M&Dk>S]ٯMAVs|VN*|G=Y7et_QN+Seh@&;K-F -ׅ>;. 5H#ڍV c"!exfѺx“8rQ+Z`hӭGeW64"WJCJN:iuF/=N:"{ѡzܚ6Jaɯsf@O?iG *@M}i6`4LwUNs{CQ`<]t1[M< A| `br7@@/`Q\P& 2L-wRvأɫpby ڤd6/ i>^*K@;@h ;c`\; aVW'u)YG A ʕ͗;]㲁NbW=~8_܃ hjXs[NwFo++Fy @+"3h7X' <5)*kі.r[M= PB;,u.U xeN9we㲔.Q.l^d<㥁Gi?< \! ΁a _Hބ? ^&M.7_]Nq!`@"`=zhu׌u#5&t1bLsaUY;%4 )!jtN0pZ} V6y@୺g0z~H@k40(Cd+,- %—bۺF<#TM /ԣی:ڗK ra3ppXZ@3R6hO#2t=O y"))X'|$wo>1Ůۼ&2X'[.5O8!fcTX?m${aF&n{a؞t)o>Ne<*/T&ILq+XNf 3Ԇk .1"4ȗ~rc5'::ÔcW\< # ?o=nL^_nk_{ 7/pèa kY#+T 癁k,vu J d2 @ WA2`DhBHxԲ?9,bۉ\ ezOe]OG7@xr%tvq(\(S">]q{ӓZB`9gp'%>' x8+I~) j {$Vj}~Dq!h1HO[Bbw\z \0k@ϵaIG pHfpBBSe%c"Ϯzc5p9?WGxSq B۳ +]3K}ߩ;)[ =|:`x `@? 5r_. %x(95 ܬ.w$r_DWp$@: \TKuXCs蕁kҢ?H^A. $Ui$tm| .9ZKgTyȶg7Fl@MI 0BeX,;Ϛ`2tNc3pk ?+.̀7v\5F8TӅiz 덛{ʡ1C"Y$1p3|~ܠi7Y 4@Ϫe‹7fu^{]D*[x*!+F bΎxжn#z'9ȟK7h^[m%]-T@ hF9H/`ETȗewЉsxa#Wat}!B{ bVHFߖH "j9` P1ե{ $eONv4@;=q}2<_6ZF 'YBljox]뉡'q u=, N;7Ɠ7$AbfM?x ̽?h)L\U]9ϩ ų%xg\\V_Se=n_pFwT(E`< R0- /F)JImx\ ~.ߑ at r7L1 hJ1 .A|&> {HM`2  'zPT "&_>ʠM.ӮG@`9\R;5?e9.m %0trlA ̈~@^we5?{S|) z!jpwa VHS {17#z k[ C#]@!|}<ChgxEf  ATM(*82=?0L Njd@`?\'y޹\1p _p%DD~q.W@Qm826^\#bW7{39b?= 0fc'vDf$ y#NzeFw`'/O1qGYGGh)%`DW TI]57?xVfGx-3%2; p3AܼRH//Tn9e^#V]*"l]?}pg\+XA8}$4?g߿L ϐ}y* v{ \~g}[1I@|iW#ȻU]h %8D}!4>E^:xAQ>F@,1_OEl[4+|9$pkAt!cnqG O]̅tҵqF4%Ed$2 .0'{@D2(Ψ]6ĥť:*]<.aA=kN΀\5 +gb83؅UykTE%q8'v*B @ a}.ƭ6mP'`7;) !;K" 8$b7Z;^  Q0f 28ppdb2SdsIENDB`(0`  <)|- 2 : B H B ; 1,P . Gb')+++++++)"qN 3  2m(++++++++++++++++)y 9 #$P^(++++++++++++++++++++*j)`+z++++++++++++++++++++++++ 3#T0.-,++++++++++++++++++++++'UY:98754321/.-+&$)++++++++++++Z3 B C BA@?=<;:,U; / (w#h , 2 A,++++++++( 0 !` N M L J I H G F @G $a / 1+4310/.-+N NEWVUTSQP J? ,4<;:8765#30[a`_]\[Z$_Y E D C BA?>0Q;ljihgfd]50L N L K J I H < %l &LutsqponL5(yNWVUTRQ J, 0Y ~ }|{zxwK( aQa_^]\[X/6]$###""!J HRjihfedc8<`(''&&%%G{6Rsrqpnml@?d**)))))Cm&O }{zyxwu $IFk,++++**?dJ##""!!  +P Px----,,,?aJy''&&%%$ 2WTz///....AbMz*))))((7[W{1100000CbOz++++***:\Y{3222221EbRz---,,,,;\[{4444433GbTz//....-=\^{6666555IbV{10000//?\`|8887777JbY{2222111A\b|::99998Lc[{4443333B\e|;;;;;::Nc]{6655555D] g|====<<<Pc_|8777776F] i}???>>>>Rcb|9999988H]!l}AA@@@@?Tdd|;;;;:::J]"n}CBBBBAAVdg|==<<<<<K^#p}DDDDCCCWd i}??>>>>=M^$s~FFFEEEEYd!k}@@@@@??O^%u~HHGGGGG[d"n}BBBBAAAQ^&w~JIIIIIH]d#p}DDDCCCCR^'yKKKKJJJ_d$r}FFEEEEDT^'|MMMMLLLae%t~HGGGGFFV^(OONNNNNbd&w~IIIIHHHV]JI))AQPPPPPO;(~(}HIKN'z'y?JOONNNNNMMG:; IHPRRRRRRRPIH LKOPPPPOOOMEF ZYRRRRRRRZY `^RRRRQQQWW  5%trRRRRR%tr 5 "";({yRRRRR$pn 1,+U/RRR/,+U-,\2RRR.+*O10x9R910x21;R7//q3223254232 r r????( @  3^\mt|{n[ As!=P(++++++++&X 7K{*+++++++++++++ ?WDf%,+++++++++++++++% ?[ #<:8643.!&++++++L I J H F D A!v?f  7Hp.1/-+)Ks 5ZXVTR#cY?=;97~AhfdbH   8 K I G F(Pvtrp< 5YWVT 2b""! B}<gedb ?k(''&GyAutrp L u++**IuF}""! ~ Xz.---JqM|('&&`~000/MqP|+***j3322QrS|---, p5554TrW}00// w8877Wr[}3222;:::Zs^}5554 @==<]sb~8877 @@??ase~;:::"CBBBdt h~===9!EEED gt!l@@?<'HHGG!ku#pCBBB KJJJ"mu$sEEED MMML$qu%wHHGG32)}%rqPPOO.'{}ABAD&w}0KJJJ!go$s{-1 -RRRRRRQ?JJUJK\>NMMMLLL(}76/5RRRRRFQPsRRzFPPOOO101(DCJ=RRRLVUXWMRRR:BADMLhDRP`_ cbPRBKJaTRI$om %trHQP~@? A@???(0 :*Xht{cr D/p$++++++++%t " ++++++++++++ p><974(  )++++k  AQO L ANq A`0742$ 6Badb^ ,n$n H G E= *7 (M_ywta,9VZXT>S==`v|'}GFF22AA@dv|)JJI45EDD iw|*NNM78HHG!ir )(&'ywERQQK:HHEG8HLKK<"lr !!YWACRRRR)~(~~POON?RS<!fdZHRR11RRG dcV%rqtL876768L$qos#mkPO*PO*#mkAAAAA~A~A~A~AAAAAAAAAA<A<A<A~AAA(  e/ "" h.l&++++++'jf)=@<-&#$++'RBy`\D5 C?&o[|xHgBw_\ <p))S]Ok{xS$~/.WW[e))k(43^Wce/.!w,99eW le43&0?>!mW#te99*5DC$tW&|e?>-8II'{W*eDC1%rrW=NN-ae6_e6.IH6!hrW+LLRRDVUTTANNG(L0gOH&vu'&vu'HO0g2~-@-@2~AAAAìAìAìAìAìAìAìAìAAAìAA   ;00 %    hXhx.rsrcunison-2.32.52/winmain.c0000644000076500000000000000033111176730177014447 0ustar bcpiercewheel#include #include extern char **__argv; int WINAPI WinMain(HINSTANCE h, HINSTANCE hPrevInstance, LPSTR lpCmdLine, int nCmdShow) { caml_main(__argv); return 0; } unison-2.32.52/xferhint.ml0000644000076500000000000000735511176730177015037 0ustar bcpiercewheel(* Unison file synchronizer: src/xferhint.ml *) (* Copyright 1999-2009, Benjamin C. Pierce This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . *) let debug = Trace.debug "xferhint" let xferbycopying = Prefs.createBool "xferbycopying" true "!optimize transfers using local copies" ("When this preference is set, Unison will try to avoid transferring " ^ "file contents across the network by recognizing when a file with the " ^ "required contents already exists in the target replica. This usually " ^ "allows file moves to be propagated very quickly. The default value is" ^ "\\texttt{true}. ") module PathMap = Hashtbl.Make (struct type t = Fspath.t * Path.local let hash (fspath, path) = (Hashtbl.hash (Fspath.toString fspath) + 13217 * Path.hash path) land 0x3FFFFFFF let equal = (=) end) module FPMap = Hashtbl.Make (struct type t = Os.fullfingerprint let hash = Hashtbl.hash let equal = (=) end) (* map(path, fingerprint) *) let path2fingerprintMap = PathMap.create 101 (* map(fingerprint, path) *) let fingerprint2pathMap = FPMap.create 101 (* Now we don't clear it out anymore let initLocal () = debug (fun () -> Util.msg "initLocal\n"); path2fingerprintMap := PathMap.empty; fingerprint2pathMap := FPMap.empty *) let lookup fp = assert (Prefs.read xferbycopying); debug (fun () -> Util.msg "lookup: fp = %s\n" (Os.fullfingerprint_to_string fp)); try Some (FPMap.find fingerprint2pathMap fp) with Not_found -> None let insertEntry p fp = if Prefs.read xferbycopying then begin debug (fun () -> let (fspath, path) = p in Util.msg "insertEntry: fspath=%s, path=%s, fp=%s\n" (Fspath.toString fspath) (Path.toString path) (Os.fullfingerprint_to_string fp)); (* Neither of these should be able to raise Not_found *) PathMap.replace path2fingerprintMap p fp; FPMap.replace fingerprint2pathMap fp p end let deleteEntry p = if Prefs.read xferbycopying then begin debug (fun () -> let (fspath, path) = p in Util.msg "deleteEntry: fspath=%s, path=%s\n" (Fspath.toString fspath) (Path.toString path)); try let fp = PathMap.find path2fingerprintMap p in PathMap.remove path2fingerprintMap p; let p' = FPMap.find fingerprint2pathMap fp in (* Maybe we should do this unconditionally *) if p' = p then FPMap.remove fingerprint2pathMap fp with Not_found -> () end let renameEntry pOrig pNew = if Prefs.read xferbycopying then begin debug (fun () -> let (fspathOrig, pathOrig) = pOrig in let (fspathNew, pathNew) = pNew in Util.msg "renameEntry: fsOrig=%s, pOrig=%s, fsNew=%s, pNew=%s\n" (Fspath.toString fspathOrig) (Path.toString pathOrig) (Fspath.toString fspathNew) (Path.toString pathNew)); try let fp = PathMap.find path2fingerprintMap pOrig in PathMap.remove path2fingerprintMap pOrig; PathMap.replace path2fingerprintMap pNew fp; FPMap.replace fingerprint2pathMap fp pNew with Not_found -> () end let _ = Os.initializeXferFunctions deleteEntry renameEntry unison-2.32.52/xferhint.mli0000644000076500000000000000152711176730177015203 0ustar bcpiercewheel(* 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