unison-2.48.3/ 000755 000766 000000 00000000000 12467142517 014047 5 ustar 00bcpierce wheel 000000 000000 unison-2.48.3/.depend 000644 000766 000000 00000052372 12010744576 015315 0 ustar 00bcpierce wheel 000000 000000 abort.cmi: uutil.cmi
bytearray.cmi:
case.cmi: ubase/prefs.cmi
checksum.cmi:
clroot.cmi:
common.cmi: uutil.cmi props.cmi path.cmi osx.cmi os.cmi name.cmi fspath.cmi \
fileinfo.cmi
copy.cmi: uutil.cmi props.cmi path.cmi osx.cmi os.cmi lwt/lwt.cmi fspath.cmi \
fileinfo.cmi common.cmi
external.cmi: lwt/lwt.cmi
fileinfo.cmi: system.cmi props.cmi ubase/prefs.cmi path.cmi osx.cmi \
fspath.cmi
files.cmi: uutil.cmi system.cmi props.cmi path.cmi lwt/lwt_util.cmi \
lwt/lwt.cmi common.cmi
fileutil.cmi:
fingerprint.cmi: uutil.cmi path.cmi fspath.cmi
fpcache.cmi: system.cmi props.cmi path.cmi osx.cmi os.cmi fspath.cmi \
fileinfo.cmi
fs.cmi: system/system_intf.cmo fspath.cmi
fspath.cmi: system.cmi path.cmi name.cmi
fswatch.cmi: path.cmi lwt/lwt.cmi fspath.cmi
fswatchold.cmi: path.cmi lwt/lwt.cmi fspath.cmi
globals.cmi: ubase/prefs.cmi pred.cmi path.cmi lwt/lwt.cmi common.cmi
lock.cmi: system.cmi
name.cmi:
os.cmi: uutil.cmi system.cmi props.cmi path.cmi name.cmi fspath.cmi \
fileinfo.cmi
osx.cmi: uutil.cmi ubase/prefs.cmi path.cmi fspath.cmi fingerprint.cmi
path.cmi: pred.cmi name.cmi
pred.cmi:
props.cmi: uutil.cmi ubase/prefs.cmi path.cmi osx.cmi fspath.cmi
recon.cmi: props.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: update.cmi ubase/prefs.cmi path.cmi os.cmi fspath.cmi
strings.cmi:
system.cmi: system/system_intf.cmo
terminal.cmi: lwt/lwt_unix.cmi
test.cmi:
transfer.cmi: uutil.cmi lwt/lwt.cmi bytearray.cmi
transport.cmi: uutil.cmi lwt/lwt.cmi common.cmi
tree.cmi:
ui.cmi:
uicommon.cmi: uutil.cmi ubase/prefs.cmi path.cmi lwt/lwt.cmi common.cmi
uigtk.cmi: uicommon.cmi
uigtk2.cmi: uicommon.cmi
uitext.cmi: uicommon.cmi
unicode.cmi:
update.cmi: uutil.cmi tree.cmi props.cmi path.cmi osx.cmi os.cmi name.cmi \
ubase/myMap.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/prefs.cmi abort.cmi
abort.cmx: uutil.cmx ubase/util.cmx ubase/trace.cmx ubase/prefs.cmx abort.cmi
bytearray.cmo: bytearray.cmi
bytearray.cmx: bytearray.cmi
case.cmo: ubase/util.cmi unicode.cmi ubase/prefs.cmi case.cmi
case.cmx: ubase/util.cmx unicode.cmx ubase/prefs.cmx case.cmi
checksum.cmo: checksum.cmi
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 update.cmi transfer.cmi \
ubase/trace.cmi ubase/safelist.cmi remote.cmi props.cmi ubase/prefs.cmi \
path.cmi osx.cmi os.cmi lwt/lwt_util.cmi lwt/lwt.cmi globals.cmi \
fspath.cmi fs.cmi fpcache.cmi fingerprint.cmi fileinfo.cmi external.cmi \
common.cmi clroot.cmi bytearray.cmi abort.cmi copy.cmi
copy.cmx: xferhint.cmx uutil.cmx ubase/util.cmx update.cmx transfer.cmx \
ubase/trace.cmx ubase/safelist.cmx remote.cmx props.cmx ubase/prefs.cmx \
path.cmx osx.cmx os.cmx lwt/lwt_util.cmx lwt/lwt.cmx globals.cmx \
fspath.cmx fs.cmx fpcache.cmx fingerprint.cmx fileinfo.cmx external.cmx \
common.cmx clroot.cmx bytearray.cmx abort.cmx copy.cmi
external.cmo: ubase/util.cmi system.cmi ubase/safelist.cmi lwt/lwt_util.cmi \
lwt/lwt_unix.cmi lwt/lwt.cmi external.cmi
external.cmx: ubase/util.cmx system.cmx ubase/safelist.cmx lwt/lwt_util.cmx \
lwt/lwt_unix.cmx lwt/lwt.cmx external.cmi
fileinfo.cmo: ubase/util.cmi system.cmi props.cmi ubase/prefs.cmi path.cmi \
osx.cmi fswatch.cmi fspath.cmi fs.cmi fileinfo.cmi
fileinfo.cmx: ubase/util.cmx system.cmx props.cmx ubase/prefs.cmx path.cmx \
osx.cmx fswatch.cmx fspath.cmx fs.cmx fileinfo.cmi
files.cmo: xferhint.cmi uutil.cmi ubase/util.cmi update.cmi ubase/trace.cmi \
system.cmi stasher.cmi ubase/safelist.cmi ubase/rx.cmi remote.cmi \
props.cmi ubase/prefs.cmi path.cmi osx.cmi os.cmi name.cmi \
lwt/lwt_util.cmi lwt/lwt_unix.cmi lwt/lwt.cmi globals.cmi fspath.cmi \
fs.cmi fingerprint.cmi fileinfo.cmi external.cmi copy.cmi common.cmi \
abort.cmi files.cmi
files.cmx: xferhint.cmx uutil.cmx ubase/util.cmx update.cmx ubase/trace.cmx \
system.cmx stasher.cmx ubase/safelist.cmx ubase/rx.cmx remote.cmx \
props.cmx ubase/prefs.cmx path.cmx osx.cmx os.cmx name.cmx \
lwt/lwt_util.cmx lwt/lwt_unix.cmx lwt/lwt.cmx globals.cmx fspath.cmx \
fs.cmx fingerprint.cmx fileinfo.cmx external.cmx copy.cmx common.cmx \
abort.cmx files.cmi
fileutil.cmo: fileutil.cmi
fileutil.cmx: fileutil.cmi
fingerprint.cmo: uutil.cmi ubase/util.cmi path.cmi fspath.cmi fs.cmi \
fingerprint.cmi
fingerprint.cmx: uutil.cmx ubase/util.cmx path.cmx fspath.cmx fs.cmx \
fingerprint.cmi
fpcache.cmo: uutil.cmi ubase/util.cmi ubase/trace.cmi system.cmi \
ubase/safelist.cmi props.cmi ubase/prefs.cmi path.cmi osx.cmi os.cmi \
fspath.cmi fileinfo.cmi fpcache.cmi
fpcache.cmx: uutil.cmx ubase/util.cmx ubase/trace.cmx system.cmx \
ubase/safelist.cmx props.cmx ubase/prefs.cmx path.cmx osx.cmx os.cmx \
fspath.cmx fileinfo.cmx fpcache.cmi
fs.cmo: fspath.cmi fs.cmi
fs.cmx: fspath.cmx fs.cmi
fspath.cmo: uutil.cmi ubase/util.cmi system.cmi ubase/rx.cmi path.cmi \
name.cmi fileutil.cmi fspath.cmi
fspath.cmx: uutil.cmx ubase/util.cmx system.cmx ubase/rx.cmx path.cmx \
name.cmx fileutil.cmx fspath.cmi
fswatch.cmo: uutil.cmi ubase/util.cmi ubase/trace.cmi system.cmi path.cmi \
lwt/lwt_unix.cmi lwt/lwt.cmi fspath.cmi fswatch.cmi
fswatch.cmx: uutil.cmx ubase/util.cmx ubase/trace.cmx system.cmx path.cmx \
lwt/lwt_unix.cmx lwt/lwt.cmx fspath.cmx fswatch.cmi
fswatchold.cmo: uutil.cmi ubase/util.cmi system.cmi ubase/safelist.cmi \
ubase/prefs.cmi pred.cmi path.cmi os.cmi lwt/lwt_unix.cmi lwt/lwt.cmi \
globals.cmi fswatch.cmi fspath.cmi fswatchold.cmi
fswatchold.cmx: uutil.cmx ubase/util.cmx system.cmx ubase/safelist.cmx \
ubase/prefs.cmx pred.cmx path.cmx os.cmx lwt/lwt_unix.cmx lwt/lwt.cmx \
globals.cmx fswatch.cmx fspath.cmx fswatchold.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
library_info.cmo:
library_info.cmx:
linkgtk.cmo: uigtk.cmi main.cmo
linkgtk.cmx: uigtk.cmx main.cmx
linkgtk2.cmo: uigtk2.cmi main.cmo
linkgtk2.cmx: uigtk2.cmx main.cmx
linktext.cmo: uitext.cmi main.cmo
linktext.cmx: uitext.cmx main.cmx
lock.cmo: ubase/util.cmi system.cmi lock.cmi
lock.cmx: ubase/util.cmx system.cmx lock.cmi
main.cmo: uutil.cmi ubase/util.cmi uitext.cmi uicommon.cmi strings.cmi \
ubase/safelist.cmi remote.cmi ubase/prefs.cmi os.cmi
main.cmx: uutil.cmx ubase/util.cmx uitext.cmx uicommon.cmx strings.cmx \
ubase/safelist.cmx remote.cmx ubase/prefs.cmx os.cmx
mkProjectInfo.cmo:
mkProjectInfo.cmx:
name.cmo: ubase/util.cmi ubase/rx.cmi case.cmi name.cmi
name.cmx: ubase/util.cmx ubase/rx.cmx case.cmx name.cmi
os.cmo: uutil.cmi ubase/util.cmi ubase/trace.cmi system.cmi \
ubase/safelist.cmi props.cmi ubase/prefs.cmi path.cmi osx.cmi name.cmi \
fspath.cmi fs.cmi fingerprint.cmi fileinfo.cmi os.cmi
os.cmx: uutil.cmx ubase/util.cmx ubase/trace.cmx system.cmx \
ubase/safelist.cmx props.cmx ubase/prefs.cmx path.cmx osx.cmx name.cmx \
fspath.cmx fs.cmx fingerprint.cmx fileinfo.cmx os.cmi
osx.cmo: uutil.cmi ubase/util.cmi ubase/trace.cmi system.cmi \
ubase/safelist.cmi ubase/prefs.cmi path.cmi name.cmi fspath.cmi fs.cmi \
fingerprint.cmi osx.cmi
osx.cmx: uutil.cmx ubase/util.cmx ubase/trace.cmx system.cmx \
ubase/safelist.cmx ubase/prefs.cmx path.cmx name.cmx fspath.cmx fs.cmx \
fingerprint.cmx osx.cmi
path.cmo: ubase/util.cmi ubase/safelist.cmi ubase/rx.cmi pred.cmi name.cmi \
fileutil.cmi case.cmi path.cmi
path.cmx: ubase/util.cmx ubase/safelist.cmx ubase/rx.cmx pred.cmx name.cmx \
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 \
lwt/lwt_unix.cmi fspath.cmi fs.cmi external.cmi props.cmi
props.cmx: uutil.cmx ubase/util.cmx ubase/prefs.cmx path.cmx osx.cmx \
lwt/lwt_unix.cmx fspath.cmx fs.cmx external.cmx props.cmi
recon.cmo: ubase/util.cmi update.cmi tree.cmi ubase/trace.cmi sortri.cmi \
ubase/safelist.cmi props.cmi ubase/prefs.cmi pred.cmi path.cmi name.cmi \
globals.cmi fileinfo.cmi common.cmi recon.cmi
recon.cmx: ubase/util.cmx update.cmx tree.cmx ubase/trace.cmx sortri.cmx \
ubase/safelist.cmx props.cmx ubase/prefs.cmx pred.cmx path.cmx name.cmx \
globals.cmx fileinfo.cmx common.cmx recon.cmi
remote.cmo: uutil.cmi ubase/util.cmi ubase/trace.cmi terminal.cmi system.cmi \
ubase/safelist.cmi ubase/prefs.cmi os.cmi lwt/lwt_util.cmi \
lwt/lwt_unix.cmi lwt/lwt.cmi fspath.cmi fs.cmi common.cmi clroot.cmi \
case.cmi bytearray.cmi remote.cmi
remote.cmx: uutil.cmx ubase/util.cmx ubase/trace.cmx terminal.cmx system.cmx \
ubase/safelist.cmx ubase/prefs.cmx os.cmx lwt/lwt_util.cmx \
lwt/lwt_unix.cmx lwt/lwt.cmx fspath.cmx fs.cmx common.cmx clroot.cmx \
case.cmx bytearray.cmx remote.cmi
sortri.cmo: ubase/util.cmi ubase/safelist.cmi ubase/prefs.cmi pred.cmi \
path.cmi common.cmi sortri.cmi
sortri.cmx: ubase/util.cmx ubase/safelist.cmx ubase/prefs.cmx pred.cmx \
path.cmx common.cmx sortri.cmi
stasher.cmo: xferhint.cmi ubase/util.cmi update.cmi system.cmi \
ubase/safelist.cmi remote.cmi props.cmi ubase/prefs.cmi pred.cmi path.cmi \
osx.cmi os.cmi lwt/lwt_unix.cmi lwt/lwt.cmi globals.cmi fspath.cmi \
fingerprint.cmi fileutil.cmi fileinfo.cmi copy.cmi common.cmi stasher.cmi
stasher.cmx: xferhint.cmx ubase/util.cmx update.cmx system.cmx \
ubase/safelist.cmx remote.cmx props.cmx ubase/prefs.cmx pred.cmx path.cmx \
osx.cmx os.cmx lwt/lwt_unix.cmx lwt/lwt.cmx globals.cmx fspath.cmx \
fingerprint.cmx fileutil.cmx fileinfo.cmx copy.cmx common.cmx stasher.cmi
strings.cmo: strings.cmi
strings.cmx: strings.cmi
system.cmo: system.cmi
system.cmx: system.cmi
terminal.cmo: system.cmi ubase/rx.cmi lwt/lwt_unix.cmi lwt/lwt.cmi \
terminal.cmi
terminal.cmx: system.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 fs.cmi fingerprint.cmi common.cmi \
test.cmi
test.cmx: uutil.cmx ubase/util.cmx update.cmx uicommon.cmx transport.cmx \
ubase/trace.cmx stasher.cmx ubase/safelist.cmx remote.cmx recon.cmx \
ubase/prefs.cmx path.cmx os.cmx lwt/lwt_util.cmx lwt/lwt_unix.cmx \
lwt/lwt.cmx globals.cmx fspath.cmx fs.cmx fingerprint.cmx common.cmx \
test.cmi
transfer.cmo: uutil.cmi ubase/util.cmi ubase/trace.cmi ubase/safelist.cmi \
lwt/lwt.cmi checksum.cmi 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 ubase/trace.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 ubase/trace.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 system.cmi stasher.cmi ubase/safelist.cmi remote.cmi \
recon.cmi props.cmi ubase/prefs.cmi path.cmi osx.cmi os.cmi name.cmi \
lwt/lwt_unix.cmi lwt/lwt.cmi globals.cmi fspath.cmi files.cmi \
fileinfo.cmi common.cmi clroot.cmi case.cmi uicommon.cmi
uicommon.cmx: xferhint.cmx uutil.cmx ubase/util.cmx update.cmx \
ubase/trace.cmx system.cmx stasher.cmx ubase/safelist.cmx remote.cmx \
recon.cmx props.cmx ubase/prefs.cmx path.cmx osx.cmx os.cmx name.cmx \
lwt/lwt_unix.cmx lwt/lwt.cmx globals.cmx fspath.cmx files.cmx \
fileinfo.cmx common.cmx clroot.cmx case.cmx uicommon.cmi
uigtk.cmo: uutil.cmi ubase/util.cmi update.cmi uitext.cmi uicommon.cmi \
transport.cmi ubase/trace.cmi system.cmi strings.cmi sortri.cmi \
ubase/safelist.cmi remote.cmi recon.cmi ubase/prefs.cmi pixmaps.cmo \
path.cmi os.cmi lwt/lwt_util.cmi lwt/lwt_unix.cmi lwt/lwt.cmi globals.cmi \
files.cmi common.cmi clroot.cmi uigtk.cmi
uigtk.cmx: uutil.cmx ubase/util.cmx update.cmx uitext.cmx uicommon.cmx \
transport.cmx ubase/trace.cmx system.cmx strings.cmx sortri.cmx \
ubase/safelist.cmx remote.cmx recon.cmx ubase/prefs.cmx pixmaps.cmx \
path.cmx os.cmx lwt/lwt_util.cmx lwt/lwt_unix.cmx lwt/lwt.cmx globals.cmx \
files.cmx common.cmx clroot.cmx uigtk.cmi
uigtk2.cmo: uutil.cmi ubase/util.cmi update.cmi unicode.cmi uitext.cmi \
uicommon.cmi transport.cmi ubase/trace.cmi system.cmi strings.cmi \
sortri.cmi ubase/safelist.cmi remote.cmi recon.cmi ubase/prefs.cmi \
pixmaps.cmo path.cmi os.cmi lwt/lwt_util.cmi lwt/lwt_unix.cmi lwt/lwt.cmi \
globals.cmi files.cmi common.cmi clroot.cmi case.cmi uigtk2.cmi
uigtk2.cmx: uutil.cmx ubase/util.cmx update.cmx unicode.cmx uitext.cmx \
uicommon.cmx transport.cmx ubase/trace.cmx system.cmx strings.cmx \
sortri.cmx ubase/safelist.cmx remote.cmx recon.cmx ubase/prefs.cmx \
pixmaps.cmx path.cmx os.cmx lwt/lwt_util.cmx lwt/lwt_unix.cmx lwt/lwt.cmx \
globals.cmx files.cmx common.cmx clroot.cmx case.cmx uigtk2.cmi
uimacbridge.cmo: xferhint.cmi uutil.cmi ubase/util.cmi update.cmi \
uicommon.cmi transport.cmi ubase/trace.cmi terminal.cmi system.cmi \
stasher.cmi ubase/safelist.cmi remote.cmi recon.cmi ubase/prefs.cmi \
path.cmi os.cmi main.cmo lwt/lwt_util.cmi lwt/lwt_unix.cmi lwt/lwt.cmi \
globals.cmi fspath.cmi files.cmi common.cmi clroot.cmi
uimacbridge.cmx: xferhint.cmx uutil.cmx ubase/util.cmx update.cmx \
uicommon.cmx transport.cmx ubase/trace.cmx terminal.cmx system.cmx \
stasher.cmx ubase/safelist.cmx remote.cmx recon.cmx ubase/prefs.cmx \
path.cmx os.cmx main.cmx lwt/lwt_util.cmx lwt/lwt_unix.cmx lwt/lwt.cmx \
globals.cmx fspath.cmx files.cmx common.cmx clroot.cmx
uimacbridgenew.cmo: xferhint.cmi uutil.cmi ubase/util.cmi update.cmi \
unicode.cmi uicommon.cmi transport.cmi ubase/trace.cmi terminal.cmi \
system.cmi stasher.cmi ubase/safelist.cmi remote.cmi recon.cmi \
ubase/prefs.cmi path.cmi os.cmi main.cmo lwt/lwt_util.cmi \
lwt/lwt_unix.cmi lwt/lwt.cmi globals.cmi fspath.cmi files.cmi common.cmi \
clroot.cmi
uimacbridgenew.cmx: xferhint.cmx uutil.cmx ubase/util.cmx update.cmx \
unicode.cmx uicommon.cmx transport.cmx ubase/trace.cmx terminal.cmx \
system.cmx stasher.cmx ubase/safelist.cmx remote.cmx recon.cmx \
ubase/prefs.cmx path.cmx os.cmx main.cmx lwt/lwt_util.cmx \
lwt/lwt_unix.cmx lwt/lwt.cmx globals.cmx fspath.cmx files.cmx common.cmx \
clroot.cmx
uitext.cmo: uutil.cmi ubase/util.cmi update.cmi uicommon.cmi transport.cmi \
ubase/trace.cmi system.cmi ubase/safelist.cmi remote.cmi recon.cmi \
ubase/prefs.cmi path.cmi lwt/lwt_util.cmi lwt/lwt_unix.cmi lwt/lwt.cmi \
globals.cmi fswatchold.cmi common.cmi uitext.cmi
uitext.cmx: uutil.cmx ubase/util.cmx update.cmx uicommon.cmx transport.cmx \
ubase/trace.cmx system.cmx ubase/safelist.cmx remote.cmx recon.cmx \
ubase/prefs.cmx path.cmx lwt/lwt_util.cmx lwt/lwt_unix.cmx lwt/lwt.cmx \
globals.cmx fswatchold.cmx common.cmx uitext.cmi
unicode.cmo: unicode_tables.cmo unicode.cmi
unicode.cmx: unicode_tables.cmx unicode.cmi
unicode_tables.cmo:
unicode_tables.cmx:
update.cmo: xferhint.cmi uutil.cmi ubase/util.cmi tree.cmi ubase/trace.cmi \
system.cmi ubase/safelist.cmi remote.cmi props.cmi ubase/proplist.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 fswatchold.cmi \
fswatch.cmi fspath.cmi fpcache.cmi fingerprint.cmi fileinfo.cmi \
common.cmi case.cmi update.cmi
update.cmx: xferhint.cmx uutil.cmx ubase/util.cmx tree.cmx ubase/trace.cmx \
system.cmx ubase/safelist.cmx remote.cmx props.cmx ubase/proplist.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 fswatchold.cmx \
fswatch.cmx fspath.cmx fpcache.cmx fingerprint.cmx fileinfo.cmx \
common.cmx case.cmx update.cmi
uutil.cmo: ubase/util.cmi ubase/trace.cmi uutil.cmi
uutil.cmx: ubase/util.cmx ubase/trace.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
fsmonitor/watchercommon.cmo: lwt/lwt_unix.cmi lwt/lwt.cmi \
fsmonitor/watchercommon.cmi
fsmonitor/watchercommon.cmx: lwt/lwt_unix.cmx lwt/lwt.cmx \
fsmonitor/watchercommon.cmi
lwt/lwt.cmo: lwt/lwt.cmi
lwt/lwt.cmx: lwt/lwt.cmi
lwt/lwt_unix.cmo: lwt/lwt_unix.cmi
lwt/lwt_unix.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
system/system_generic.cmo:
system/system_generic.cmx:
system/system_intf.cmo:
system/system_intf.cmx:
system/system_win.cmo: unicode.cmi system/system_generic.cmo ubase/rx.cmi
system/system_win.cmx: unicode.cmx system/system_generic.cmx ubase/rx.cmx
ubase/myMap.cmo: ubase/myMap.cmi
ubase/myMap.cmx: ubase/myMap.cmi
ubase/prefs.cmo: ubase/util.cmi ubase/uarg.cmi system.cmi ubase/safelist.cmi \
ubase/prefs.cmi
ubase/prefs.cmx: ubase/util.cmx ubase/uarg.cmx system.cmx ubase/safelist.cmx \
ubase/prefs.cmi
ubase/proplist.cmo: ubase/util.cmi ubase/proplist.cmi
ubase/proplist.cmx: ubase/util.cmx ubase/proplist.cmi
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 system.cmi ubase/safelist.cmi ubase/prefs.cmi \
ubase/trace.cmi
ubase/trace.cmx: ubase/util.cmx system.cmx ubase/safelist.cmx ubase/prefs.cmx \
ubase/trace.cmi
ubase/uarg.cmo: ubase/util.cmi system.cmi ubase/safelist.cmi ubase/uarg.cmi
ubase/uarg.cmx: ubase/util.cmx system.cmx ubase/safelist.cmx ubase/uarg.cmi
ubase/uprintf.cmo: ubase/uprintf.cmi
ubase/uprintf.cmx: ubase/uprintf.cmi
ubase/util.cmo: ubase/uprintf.cmi system.cmi ubase/safelist.cmi \
ubase/util.cmi
ubase/util.cmx: ubase/uprintf.cmx system.cmx ubase/safelist.cmx \
ubase/util.cmi
fsmonitor/watchercommon.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 system.cmi
ubase/proplist.cmi:
ubase/rx.cmi:
ubase/safelist.cmi:
ubase/trace.cmi: ubase/prefs.cmi
ubase/uarg.cmi:
ubase/uprintf.cmi:
ubase/util.cmi: system.cmi
fsmonitor/linux/inotify.cmo: fsmonitor/linux/inotify.cmi
fsmonitor/linux/inotify.cmx: fsmonitor/linux/inotify.cmi
fsmonitor/linux/lwt_inotify.cmo: lwt/lwt_unix.cmi lwt/lwt.cmi \
fsmonitor/linux/inotify.cmi fsmonitor/linux/lwt_inotify.cmi
fsmonitor/linux/lwt_inotify.cmx: lwt/lwt_unix.cmx lwt/lwt.cmx \
fsmonitor/linux/inotify.cmx fsmonitor/linux/lwt_inotify.cmi
fsmonitor/linux/watcher.cmo: fsmonitor/watchercommon.cmi \
fsmonitor/linux/lwt_inotify.cmi lwt/lwt.cmi fsmonitor/linux/inotify.cmi
fsmonitor/linux/watcher.cmx: fsmonitor/watchercommon.cmx \
fsmonitor/linux/lwt_inotify.cmx lwt/lwt.cmx fsmonitor/linux/inotify.cmx
fsmonitor/windows/shortnames.cmo: fsmonitor/windows/shortnames.cmi
fsmonitor/windows/shortnames.cmx: fsmonitor/windows/shortnames.cmi
fsmonitor/windows/watcher.cmo: fsmonitor/watchercommon.cmi \
fsmonitor/windows/shortnames.cmi lwt/lwt.cmi
fsmonitor/windows/watcher.cmx: fsmonitor/watchercommon.cmx \
fsmonitor/windows/shortnames.cmx lwt/lwt.cmx
lwt/example/editor.cmo: lwt/lwt_unix.cmi
lwt/example/editor.cmx: lwt/lwt_unix.cmx
lwt/example/relay.cmo: lwt/lwt_unix.cmi lwt/lwt.cmi
lwt/example/relay.cmx: lwt/lwt_unix.cmx lwt/lwt.cmx
lwt/generic/lwt_unix_impl.cmo: lwt/pqueue.cmi lwt/lwt.cmi
lwt/generic/lwt_unix_impl.cmx: lwt/pqueue.cmx lwt/lwt.cmx
lwt/win/lwt_unix_impl.cmo: lwt/pqueue.cmi lwt/lwt.cmi
lwt/win/lwt_unix_impl.cmx: lwt/pqueue.cmx lwt/lwt.cmx
lwt/win/lwt_win.cmo: lwt/win/lwt_win.cmi
lwt/win/lwt_win.cmx: lwt/win/lwt_win.cmi
system/generic/system_impl.cmo: system/system_generic.cmo
system/generic/system_impl.cmx: system/system_generic.cmx
system/win/system_impl.cmo: system/system_win.cmo system/system_generic.cmo
system/win/system_impl.cmx: system/system_win.cmx system/system_generic.cmx
fsmonitor/linux/inotify.cmi:
fsmonitor/linux/lwt_inotify.cmi: lwt/lwt.cmi fsmonitor/linux/inotify.cmi
fsmonitor/windows/shortnames.cmi:
lwt/win/lwt_win.cmi: lwt/lwt.cmi
unison-2.48.3/abort.ml 000644 000766 000000 00000004160 12450317305 015500 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/abort.ml *)
(* Copyright 1999-2015, 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 maxerrors =
Prefs.createInt "maxerrors" 1
"!maximum number of errors before a directory transfer is aborted"
"This preference controls after how many errors Unison aborts a \
directory transfer. Setting it to a large number allows Unison \
to transfer most of a directory even when some files fail to be \
copied. The default is 1. If the preference is set too high, \
Unison may take a long time to abort in case of repeated \
failures (for instance, when the disk is full)."
(****)
let files = Hashtbl.create 17
let abortAll = ref false
let errorCountCell id =
try
Hashtbl.find files id
with Not_found ->
let c = ref 0 in
Hashtbl.add files id c;
c
let errorCount id = !(errorCountCell id)
let bumpErrorCount id = incr (errorCountCell id)
(****)
let reset () = Hashtbl.clear files; abortAll := false
(****)
let file id =
debug (fun() -> Util.msg "Aborting line %s\n" (Uutil.File.toString id));
bumpErrorCount id
let all () = abortAll := true
(****)
let check id =
debug (fun() -> Util.msg "Checking line %s\n" (Uutil.File.toString id));
if !abortAll || errorCount id >= Prefs.read maxerrors 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.48.3/abort.mli 000644 000766 000000 00000000726 11216731117 015655 0 ustar 00bcpierce wheel 000000 000000
(* 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.48.3/BUGS.txt 000644 000766 000000 00000014225 11227367513 015352 0 ustar 00bcpierce wheel 000000 000000 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, 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
[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?
[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]
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.
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.
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...]
"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!
---------------------------------------------------------------------------
COSMETIC
========
Interactively adding an ignore pattern for src will not make
src/RECENTNEWS immediately disappear (as it does not directly match
the pattern)...
unison-2.48.3/bytearray.ml 000644 000766 000000 00000005202 12450317305 016371 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/bytearray.ml *)
(* Copyright 1999-2015, 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.48.3/bytearray.mli 000644 000766 000000 00000001123 12450317305 016540 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/bytearray.mli *)
(* Copyright 1999-2015, 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.48.3/bytearray_stubs.c 000644 000766 000000 00000002271 12450317305 017426 0 ustar 00bcpierce wheel 000000 000000 /* Unison file synchronizer: src/bytearray_stubs.c */
/* Copyright 1999-2015 (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.48.3/case.ml 000644 000766 000000 00000016240 12450317305 015306 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/case.ml *)
(* Copyright 1999-2015, 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.createBoolWithDefault "ignorecase"
"!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 may be "
^ "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 someHostIsInsensitive =
Prefs.createBool "someHostIsInsensitive" false
"*Pseudo-preference for internal use only" ""
let unicode =
Prefs.createBoolWithDefault "unicode"
"!assume Unicode encoding in case insensitive mode"
"When set to {\\tt true}, this flag causes Unison to perform \
case insensitive file comparisons assuming Unicode encoding. \
This is the default. When the flag is set to {\\tt false}, \
a Latin 1 encoding is assumed. When Unison runs in case sensitive \
mode, this flag only makes a difference if one host is running \
Windows or Mac OS X. Under Windows, the flag selects between using \
the Unicode or 8bit Windows API for accessing the filesystem. \
Under Mac OS X, it selects whether comparing the filenames up to \
decomposition, or byte-for-byte."
let unicodeEncoding =
Prefs.createBool "unicodeEnc" false
"*Pseudo-preference for internal use only" ""
let useUnicode () =
let pref = Prefs.read unicode in
pref = `True || pref = `Default
let useUnicodeAPI = useUnicode
let unicodeCaseSensitive =
Prefs.createBool "unicodeCS" ~local:true false
"*Pseudo-preference for internal use only" ""
(* 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 someHostRunningOsX =
Prefs.set someHostIsInsensitive
(Prefs.read caseInsensitiveMode = `True ||
(Prefs.read caseInsensitiveMode = `Default && b));
Prefs.set unicodeCaseSensitive (useUnicode () && someHostRunningOsX);
Prefs.set unicodeEncoding (useUnicode ())
(****)
(* Dots are ignored at the end of filenames under Windows. *)
(* FIX: for the moment, simply disallow files ending with a dot.
This is more efficient, and this may well be good enough.
We should reconsider this is people start complaining...
let hasTrailingDots s =
let rec iter s pos len wasDot =
if pos = len then wasDot else
let c = s.[pos] in
(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)
let rmTrailDots s =
s
(*FIX: disabled for now -- requires an archive version change
if
Prefs.read someHostIsRunningWindows &&
not (Prefs.read allHostsAreRunningWindows) &&
hasTrailingDots s
then
removeTrailingDots s
else
s
*)
*)
(****)
type mode = Sensitive | Insensitive | UnicodeSensitive | UnicodeInsensitive
(*
Important invariant:
if [compare s s' = 0],
then [hash s = hash s'] and
and [Rx.match_string rx (normalizeMatchedString s) =
Rx.match_string rx (normalizeMatchedString s')]
(when [rx] has been compiled using the [caseInsensitiveMatch] mode)
*)
let sensitiveOps = object
method mode = Sensitive
method modeDesc = "case sensitive"
method compare s s' = compare (s : string) s'
method hash s = Uutil.hash s
method normalizePattern s = s
method caseInsensitiveMatch = false
method normalizeMatchedString s = s
method normalizeFilename s = s
method badEncoding s = false
end
let insensitiveOps = object
method mode = Insensitive
method modeDesc = "Latin-1 case insensitive"
method compare s s' = Util.nocase_cmp s s'
method hash s = Uutil.hash (String.lowercase s)
method normalizePattern s = s
method caseInsensitiveMatch = true
method normalizeMatchedString s = s
method normalizeFilename s = s
method badEncoding s = false
end
let unicodeSensitiveOps = object
method mode = UnicodeSensitive
method modeDesc = "Unicode case sensitive"
method compare s s' = Unicode.case_sensitive_compare s s'
method hash s = Uutil.hash (Unicode.decompose s)
method normalizePattern p = Unicode.decompose p
method caseInsensitiveMatch = false
method normalizeMatchedString s = Unicode.decompose s
method normalizeFilename s = Unicode.compose s
method badEncoding s = not (Unicode.check_utf_8 s)
end
let unicodeInsensitiveOps = object
method mode = UnicodeInsensitive
method modeDesc = "Unicode case insensitive"
method compare s s' = Unicode.case_insensitive_compare s s'
method hash s = Uutil.hash (Unicode.normalize s)
method normalizePattern p = Unicode.normalize p
method caseInsensitiveMatch = false
method normalizeMatchedString s = Unicode.normalize s
method normalizeFilename s = Unicode.compose s
method badEncoding s = not (Unicode.check_utf_8 s)
end
(* Note: the dispatch must be fast *)
let ops () =
if Prefs.read someHostIsInsensitive then begin
if Prefs.read unicodeEncoding then
unicodeInsensitiveOps
else
insensitiveOps
end else
if Prefs.read unicodeCaseSensitive then
unicodeSensitiveOps
else
sensitiveOps
let caseSensitiveModeDesc = sensitiveOps#modeDesc
unison-2.48.3/case.mli 000644 000766 000000 00000002732 12450317305 015460 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/case.mli *)
(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
val caseInsensitiveMode : [`True|`False|`Default] Prefs.t
val unicodeEncoding : bool Prefs.t
val useUnicodeAPI : unit -> bool
type mode = Sensitive | Insensitive | UnicodeSensitive | UnicodeInsensitive
val ops : unit ->
< mode : mode; modeDesc : string; (* Current mode *)
compare : string -> string -> int; (* Comparison function *)
hash : string -> int; (* Hash function compatible with
the comparison function *)
normalizePattern : string -> string; (* Normalize a pattern *)
caseInsensitiveMatch : bool; (* Whether pattern matching
should be done in a case
insensitive way *)
normalizeMatchedString : string -> string;
(* Put the string in some form
suitable for pattern matching *)
normalizeFilename : string -> string; (* Convert a filename into
its preferred form
(NFC for Unicode). *)
badEncoding : string -> bool > (* Test whether the string uses
the correct encoding *)
val init : bool -> bool -> unit
val caseSensitiveModeDesc : string
unison-2.48.3/checksum.ml 000644 000766 000000 00000005327 12450317305 016201 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/checksum.ml *)
(* Copyright 1999-2015, 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.48.3/checksum.mli 000644 000766 000000 00000001127 12450317305 016344 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/checksum.mli *)
(* Copyright 1999-2015, 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.48.3/clroot.ml 000644 000766 000000 00000020277 12450317305 015702 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/clroot.ml *)
(* Copyright 1999-2015, 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.48.3/clroot.mli 000644 000766 000000 00000001344 12450317305 016045 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/clroot.mli *)
(* Copyright 1999-2015, 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.48.3/common.ml 000644 000766 000000 00000017724 12450317305 015673 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/common.ml *)
(* Copyright 1999-2015, 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.toPrintString fspath
| (Remote host, fspath) -> "//"^host^"/"^(Fspath.toPrintString 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 ? *)
Fspath.compare fspath1 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 ? *)
Fspath.compare fspath1 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 =
{ typ : Fileinfo.typ;
status : status;
desc : Props.t; (* Properties (for the UI) *)
ui : updateItem;
size : int * Uutil.Filesize.t; (* Number of items and size *)
props : Props.t list } (* Parent properties *)
type direction =
Conflict of string (* The string is the reason of the conflict *)
| Merge
| Replica1ToReplica2
| Replica2ToReplica1
let direction2string = function
Conflict _ -> "conflict"
| Merge -> "merge"
| Replica1ToReplica2 -> "replica1 to replica2"
| Replica2ToReplica1 -> "replica2 to replica1"
let isConflict = function
Conflict _ -> true
| _ -> false
type difference =
{ rc1 : replicaContent;
rc2 : replicaContent;
errors1 : string list;
errors2 : string list;
mutable direction : direction;
default_direction : direction }
type replicas =
Problem of string (* There was a problem during update detection *)
| Different of difference (* Replicas differ *)
type reconItem = {path1 : Path.t; path2 : 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 rc rc' =
match rc.status, rc'.status with
`Deleted, _ ->
`Delete
| (`Unchanged | `PropsChanged), (`Unchanged | `PropsChanged) ->
`SetProps
| _ ->
`Copy
let rcLength rc rc' =
if riAction rc rc' = `SetProps then
Uutil.Filesize.zero
else
snd rc.size
let riLength ri =
match ri.replicas with
Different {rc1 = {status= `Unchanged | `PropsChanged};
rc2 = {status= `Unchanged | `PropsChanged}} ->
Uutil.Filesize.zero (* No contents propagated *)
| Different {rc1 = rc1; rc2 = rc2; direction = 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 diff -> isConflict diff.direction
let partiallyProblematic ri =
match ri.replicas with
Problem _ ->
true
| Different diff ->
isConflict diff.direction || diff.errors1 <> [] || diff.errors2 <> []
let isDeletion ri =
match ri.replicas with
Different {rc1 = rc1; rc2 = rc2; direction = rDir} ->
(match rDir, rc1.typ, rc2.typ with
Replica1ToReplica2, `ABSENT, _ -> true
| Replica2ToReplica1, _, `ABSENT -> true
| _ -> false)
| _ -> false
let rcType rc = Fileinfo.type2string rc.typ
let riFileType ri =
match ri.replicas with
Different {rc1 = rc1; rc2 = rc2; default_direction = dir} ->
begin match dir with
Replica2ToReplica1 -> rcType rc2
| _ -> rcType rc1
end
| _ -> "nonexistent"
unison-2.48.3/common.mli 000644 000766 000000 00000012747 12450317305 016044 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/common.mli *)
(* Copyright 1999-2015, 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 =
{ typ : Fileinfo.typ;
status : status;
desc : Props.t; (* Properties (for the UI) *)
ui : updateItem;
size : int * Uutil.Filesize.t; (* Number of items and size *)
props : Props.t list } (* Parent properties *)
type direction =
Conflict of string (* The string is the reason of the conflict *)
| Merge
| Replica1ToReplica2
| Replica2ToReplica1
val direction2string : direction -> string
val isConflict : direction -> bool
type difference =
{ rc1 : replicaContent; (* - content of first replica *)
rc2 : replicaContent; (* - content of second replica *)
errors1 : string list; (* - deep errors in first replica *)
errors2 : string list; (* - deep errors in second replica *)
mutable direction : direction; (* - action to take (it's mutable so that
the user interface can change it) *)
default_direction : direction } (* - default action to take *)
(* Variable name prefix: "rplc" *)
type replicas =
Problem of string (* There was a problem during update detection *)
| Different of difference (* Replicas differ *)
(* Variable name prefix: "ri" *)
type reconItem = {path1 : Path.t; path2 : 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
(* True if the ri is problematic or if it has some deep errors in a
directory *)
val partiallyProblematic : reconItem -> bool
val isDeletion : reconItem -> bool
unison-2.48.3/CONTRIB 000644 000766 000000 00000004215 10440677010 015062 0 ustar 00bcpierce wheel 000000 000000 INFORMATION 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.48.3/copy.ml 000644 000766 000000 00000113076 12450317305 015352 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/copy.ml *)
(* Copyright 1999-2015, 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 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)
(****)
(* If newFpOpt = Some newfp, check that the current source contents
matches newfp. Otherwise, check whether the source file has been
modified during synchronization. *)
let checkForChangesToSourceLocal
fspathFrom pathFrom archDesc archFp archStamp archRess newFpOpt paranoid =
(* Retrieve attributes of current source file *)
let sourceInfo = Fileinfo.get true fspathFrom pathFrom in
match newFpOpt with
None ->
(* no newfp provided: so we need to compare the archive with the
current source *)
let clearlyChanged =
sourceInfo.Fileinfo.typ <> `FILE
|| Props.length sourceInfo.Fileinfo.desc <> Props.length archDesc
|| Osx.ressLength sourceInfo.Fileinfo.osX.Osx.ressInfo <>
Osx.ressLength archRess in
let dataClearlyUnchanged =
not clearlyChanged
&& Props.same_time sourceInfo.Fileinfo.desc archDesc
&& not (Fpcache.excelFile pathFrom)
&& match archStamp with
Some (Fileinfo.InodeStamp inode) -> sourceInfo.Fileinfo.inode = inode
| Some (Fileinfo.CtimeStamp ctime) -> true
| None -> false in
let ressClearlyUnchanged =
not clearlyChanged
&& Osx.ressUnchanged archRess sourceInfo.Fileinfo.osX.Osx.ressInfo
None dataClearlyUnchanged in
if dataClearlyUnchanged && ressClearlyUnchanged then begin
if paranoid && not (Os.isPseudoFingerprint archFp) then begin
let newFp = Os.fingerprint fspathFrom pathFrom sourceInfo in
if archFp <> newFp then begin
Update.markPossiblyUpdated fspathFrom pathFrom;
raise (Util.Transient (Printf.sprintf
"The source file %s\n\
has been modified but the fast update detection mechanism\n\
failed to detect it. Try running once with the fastcheck\n\
option set to 'no'."
(Fspath.toPrintString (Fspath.concat fspathFrom pathFrom))))
end
end
end else if
clearlyChanged
|| archFp <> Os.fingerprint fspathFrom pathFrom sourceInfo
then
raise (Util.Transient (Printf.sprintf
"The source file %s\nhas been modified during synchronization. \
Transfer aborted."
(Fspath.toPrintString (Fspath.concat fspathFrom pathFrom))))
| Some newfp ->
(* newfp provided means that the archive contains a pseudo-fingerprint... *)
assert (Os.isPseudoFingerprint archFp);
(* ... so we can't compare the archive with the source; instead we
need to compare the current source to the new fingerprint: *)
if newfp <> Os.fingerprint fspathFrom pathFrom sourceInfo then
raise (Util.Transient (Printf.sprintf
"Current source file %s\n not same as transferred file. \
Transfer aborted."
(Fspath.toPrintString (Fspath.concat fspathFrom pathFrom))))
let checkForChangesToSourceOnRoot =
Remote.registerRootCmd
"checkForChangesToSource"
(fun (fspathFrom,
(pathFrom, archDesc, archFp, archStamp, archRess, newFpOpt, paranoid)) ->
checkForChangesToSourceLocal
fspathFrom pathFrom archDesc archFp archStamp archRess newFpOpt paranoid;
Lwt.return ())
let checkForChangesToSource
root pathFrom archDesc archFp archStamp archRess newFpOpt paranoid =
checkForChangesToSourceOnRoot
root (pathFrom, archDesc, archFp, archStamp, archRess, newFpOpt, paranoid)
(****)
let fileIsTransferred fspathTo pathTo desc fp ress =
let info = Fileinfo.get false fspathTo pathTo in
(info,
info.Fileinfo.typ = `FILE
&&
Props.length info.Fileinfo.desc = Props.length desc
&&
Osx.ressLength info.Fileinfo.osX.Osx.ressInfo =
Osx.ressLength ress
&&
let fp' = Os.fingerprint fspathTo pathTo info in
fp' = fp)
(* We slice the files in 1GB chunks because that's the limit for
Fingerprint.subfile on 32 bit architectures *)
let fingerprintLimit = Uutil.Filesize.ofInt64 1072693248L
let rec fingerprintPrefix fspath path offset len accu =
if len = Uutil.Filesize.zero then accu else begin
let l = min len fingerprintLimit in
let fp = Fingerprint.subfile (Fspath.concat fspath path) offset l in
fingerprintPrefix fspath path
(Int64.add offset (Uutil.Filesize.toInt64 l)) (Uutil.Filesize.sub len l)
(fp :: accu)
end
let fingerprintPrefixRemotely =
Remote.registerServerCmd
"fingerprintSubfile"
(fun _ (fspath, path, len) ->
Lwt.return (fingerprintPrefix fspath path 0L len []))
let appendThreshold = Uutil.Filesize.ofInt (1024 * 1024)
let validFilePrefix connFrom fspathFrom pathFrom fspathTo pathTo info desc =
let len = Props.length info.Fileinfo.desc in
if
info.Fileinfo.typ = `FILE &&
len >= appendThreshold && len < Props.length desc
then begin
Lwt.try_bind
(fun () ->
fingerprintPrefixRemotely connFrom (fspathFrom, pathFrom, len))
(fun fpFrom ->
let fpTo = fingerprintPrefix fspathTo pathTo 0L len [] in
Lwt.return (if fpFrom = fpTo then Some len else None))
(fun _ ->
Lwt.return None)
end else
Lwt.return None
type transferStatus =
TransferSucceeded of Fileinfo.t
| TransferNeedsDoubleCheckAgainstCurrentSource of Fileinfo.t * Os.fullfingerprint
| TransferFailed of string
(* Paranoid check: recompute the transferred file's fingerprint to match it
with the archive's. If the old
fingerprint was a pseudo-fingerprint, we can't tell just from looking at the
new file and the archive information, so we return
TransferProbablySucceeded in this case, along with the new fingerprint
that we can check in checkForChangesToSource when we've
calculated the current source fingerprint.
*)
let paranoidCheck fspathTo pathTo realPathTo desc fp ress =
let info = Fileinfo.get false fspathTo pathTo in
let fp' = Os.fingerprint fspathTo pathTo info in
if Os.isPseudoFingerprint fp then begin
Lwt.return (TransferNeedsDoubleCheckAgainstCurrentSource (info,fp'))
end else if fp' <> fp then begin
Lwt.return (TransferFailed (Os.reasonForFingerprintMismatch fp fp'))
end else
Lwt.return (TransferSucceeded info)
let saveTempFileLocal (fspathTo, (pathTo, realPathTo, reason)) =
let savepath =
Os.tempPath ~fresh:true fspathTo
(match Path.deconstructRev realPathTo with
Some (nm, _) -> Path.addSuffixToFinalName
(Path.child Path.empty nm) "-bad"
| None -> Path.fromString "bad")
in
Os.rename "save temp" fspathTo pathTo fspathTo savepath;
Lwt.fail
(Util.Transient
(Printf.sprintf
"The file %s was incorrectly transferred (fingerprint mismatch in %s) \
-- temp file saved as %s"
(Path.toString pathTo)
reason
(Fspath.toDebugString (Fspath.concat fspathTo savepath))))
let saveTempFileOnRoot =
Remote.registerRootCmd "saveTempFile" saveTempFileLocal
(****)
let removeOldTempFile fspathTo pathTo =
if Os.exists fspathTo pathTo then begin
debug (fun() -> Util.msg "Removing old temp file %s / %s\n"
(Fspath.toDebugString fspathTo) (Path.toString pathTo));
Os.delete fspathTo pathTo
end
let openFileIn fspath path kind =
match kind with
`DATA ->
Fs.open_in_bin (Fspath.concat fspath path)
| `DATA_APPEND len ->
let ch = Fs.open_in_bin (Fspath.concat fspath path) in
LargeFile.seek_in ch (Uutil.Filesize.toInt64 len);
ch
| `RESS ->
Osx.openRessIn fspath path
let openFileOut fspath path kind len =
match kind with
`DATA ->
let fullpath = Fspath.concat fspath path in
let flags = [Unix.O_WRONLY;Unix.O_CREAT] in
let perm = 0o600 in
begin match Util.osType with
`Win32 ->
Fs.open_out_gen
[Open_wronly; Open_creat; Open_excl; Open_binary] perm fullpath
| `Unix ->
let fd =
try
Fs.openfile fullpath (Unix.O_EXCL :: flags) perm
with
Unix.Unix_error
((Unix.EOPNOTSUPP | Unix.EUNKNOWNERR 524), _, _) ->
(* O_EXCL not supported under a Netware NFS-mounted filesystem.
Solaris and Linux report different errors. *)
Fs.openfile fullpath (Unix.O_TRUNC :: flags) perm
in
Unix.out_channel_of_descr fd
end
| `DATA_APPEND len ->
let fullpath = Fspath.concat fspath path in
let perm = 0o600 in
let ch = Fs.open_out_gen [Open_wronly; Open_binary] perm fullpath in
Fs.chmod fullpath perm;
LargeFile.seek_out ch (Uutil.Filesize.toInt64 len);
ch
| `RESS ->
Osx.openRessOut fspath path len
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 copyContents fspathFrom pathFrom fspathTo pathTo fileKind fileLength ido =
let use_id f = match ido with Some id -> f id | None -> () in
let inFd = openFileIn fspathFrom pathFrom fileKind in
protect
(fun () ->
let outFd = openFileOut fspathTo pathTo fileKind fileLength in
protect
(fun () ->
Uutil.readWriteBounded inFd outFd fileLength
(fun l ->
use_id (fun id ->
(* (Util.msg "Copied file %s (%d bytes)\n" (Path.toString pathFrom) l); *)
Uutil.showProgress id (Uutil.Filesize.ofInt l) "l"));
close_in inFd;
close_out outFd;
(* ignore (Sys.command ("ls -l " ^ (Fspath.toString (Fspath.concat fspathTo pathTo)))) *)
)
(fun () -> close_out_noerr outFd))
(fun () -> close_in_noerr inFd)
let localFile
fspathFrom pathFrom fspathTo pathTo realPathTo update desc ressLength ido =
Util.convertUnixErrorsToTransient
"copying locally"
(fun () ->
debug (fun () ->
Util.msg "Copy.localFile %s / %s to %s / %s\n"
(Fspath.toDebugString fspathFrom) (Path.toString pathFrom)
(Fspath.toDebugString fspathTo) (Path.toString pathTo));
removeOldTempFile fspathTo pathTo;
copyContents
fspathFrom pathFrom fspathTo pathTo `DATA (Props.length desc) ido;
if ressLength > Uutil.Filesize.zero then
copyContents
fspathFrom pathFrom fspathTo pathTo `RESS ressLength ido;
setFileinfo fspathTo pathTo realPathTo update desc)
(****)
let tryCopyMovedFile fspathTo pathTo realPathTo update desc fp ress id =
if not (Prefs.read Xferhint.xferbycopying) then None else
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 ->
None
| Some (candidateFspath, candidatePath, hintHandle) ->
debug (fun () ->
Util.msg
"tryCopyMovedFile: found match at %s,%s. Try local copying\n"
(Fspath.toDebugString candidateFspath)
(Path.toString candidatePath));
try
(* If candidateFspath is the replica root, the argument
[true] is correct. Otherwise, we don't expect to point
to a symlink, and therefore we still get the correct
result. *)
let info = Fileinfo.get true candidateFspath candidatePath in
if
info.Fileinfo.typ <> `ABSENT &&
Props.length info.Fileinfo.desc = Props.length desc
then begin
localFile
candidateFspath candidatePath fspathTo pathTo realPathTo
update desc (Osx.ressLength ress) (Some id);
let (info, isTransferred) =
fileIsTransferred fspathTo pathTo desc fp ress in
if isTransferred then begin
debug (fun () -> Util.msg "tryCopyMoveFile: success.\n");
let msg =
Printf.sprintf
"Shortcut: copied %s/%s from local file %s/%s\n"
(Fspath.toPrintString fspathTo)
(Path.toString realPathTo)
(Fspath.toPrintString candidateFspath)
(Path.toString candidatePath)
in
Some (info, msg)
end else begin
debug (fun () ->
Util.msg "tryCopyMoveFile: candidate file %s modified!\n"
(Path.toString candidatePath));
Xferhint.deleteEntry hintHandle;
None
end
end else begin
debug (fun () ->
Util.msg "tryCopyMoveFile: candidate file %s disappeared!\n"
(Path.toString candidatePath));
Xferhint.deleteEntry hintHandle;
None
end
with
Util.Transient s ->
debug (fun () ->
Util.msg
"tryCopyMovedFile: local copy from %s didn't work [%s]"
(Path.toString candidatePath) s);
Xferhint.deleteEntry hintHandle;
None)
(****)
(* 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.")
let decompressor = ref Remote.MsgIdMap.empty
let processTransferInstruction conn (file_id, ti) =
Util.convertUnixErrorsToTransient
"processing a transfer instruction"
(fun () ->
ignore (Remote.MsgIdMap.find file_id !decompressor ti))
let marshalTransferInstruction =
(fun (file_id, (data, pos, len)) rem ->
(Remote.encodeInt file_id :: (data, pos, len) :: rem,
len + Remote.intSize)),
(fun buf pos ->
let len = Bytearray.length buf - pos - Remote.intSize in
(Remote.decodeInt buf pos, (buf, pos + Remote.intSize, len)))
let streamTransferInstruction =
Remote.registerStreamCmd
"processTransferInstruction" marshalTransferInstruction
processTransferInstruction
let showPrefixProgress id kind =
match kind with
`DATA_APPEND len -> Uutil.showProgress id len "r"
| _ -> ()
let compress conn
(biOpt, fspathFrom, pathFrom, fileKind, sizeFrom, id, file_id) =
Lwt.catch
(fun () ->
streamTransferInstruction conn
(fun processTransferInstructionRemotely ->
(* We abort the file transfer on error if it has not
already started *)
if fileKind <> `RESS then Abort.check id;
let infd = openFileIn fspathFrom pathFrom fileKind in
lwt_protect
(fun () ->
showPrefixProgress id fileKind;
let showProgress count =
Uutil.showProgress id (Uutil.Filesize.ofInt count) "r" in
let compr =
match biOpt with
None ->
Transfer.send infd sizeFrom showProgress
| Some bi ->
Transfer.Rsync.rsyncCompress
bi infd sizeFrom showProgress
in
compr
(fun ti -> processTransferInstructionRemotely (file_id, ti))
>>= fun () ->
close_in infd;
Lwt.return ())
(fun () ->
close_in_noerr infd)))
(fun e ->
(* We cannot wrap the code above with the handler below,
as the code is executed asynchronously. *)
Util.convertUnixErrorsToTransient "transferring file contents"
(fun () -> raise e))
let compressRemotely = Remote.registerServerCmd "compress" compress
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
(* Lazy creation of the destination file *)
let destinationFd fspath path kind len outfd id =
match !outfd with
None ->
(* We abort the file transfer on error if it has not
already started *)
if kind <> `RESS then Abort.check id;
let fd = openFileOut fspath path kind len in
showPrefixProgress id kind;
outfd := Some fd;
fd
| Some fd ->
fd
(* Lazy opening of the reference file (for rsync algorithm) *)
let referenceFd fspath path kind infd =
match !infd with
None ->
let fd = openFileIn fspath path kind in
infd := Some fd;
fd
| Some fd ->
fd
let rsyncReg = Lwt_util.make_region (40 * 1024)
let rsyncThrottle useRsync srcFileSize destFileSize f =
if not useRsync then f () else
let l = Transfer.Rsync.memoryFootprint srcFileSize destFileSize in
Lwt_util.run_in_region rsyncReg l f
let transferFileContents
connFrom fspathFrom pathFrom fspathTo pathTo realPathTo update
fileKind srcFileSize id =
(* We delay the opening of the files so that there are not too many
temporary files remaining after a crash, and that they are not
too many files simultaneously opened. *)
let outfd = ref None in
let infd = ref None in
let showProgress count =
Uutil.showProgress id (Uutil.Filesize.ofInt count) "r" in
let destFileSize =
match update with
`Copy ->
Uutil.Filesize.zero
| `Update (destFileDataSize, destFileRessSize) ->
match fileKind with
`DATA | `DATA_APPEND _ -> destFileDataSize
| `RESS -> destFileRessSize
in
let useRsync =
Prefs.read rsyncActivated
&&
Transfer.Rsync.aboveRsyncThreshold destFileSize
&&
Transfer.Rsync.aboveRsyncThreshold srcFileSize
in
rsyncThrottle useRsync srcFileSize destFileSize (fun () ->
let (bi, decompr) =
if useRsync then
Util.convertUnixErrorsToTransient
"preprocessing file"
(fun () ->
let ifd = referenceFd fspathTo realPathTo fileKind infd in
let (bi, blockSize) =
protect
(fun () -> Transfer.Rsync.rsyncPreprocess
ifd srcFileSize destFileSize)
(fun () -> close_in_noerr ifd)
in
close_all infd outfd;
(Some bi,
(* Rsync decompressor *)
fun ti ->
let ifd = referenceFd fspathTo realPathTo fileKind infd in
let fd =
destinationFd
fspathTo pathTo fileKind srcFileSize outfd id in
let eof =
Transfer.Rsync.rsyncDecompress blockSize ifd fd showProgress ti
in
if eof then close_all infd outfd))
else
(None,
(* Simple generic decompressor *)
fun ti ->
let fd =
destinationFd fspathTo pathTo fileKind srcFileSize outfd id in
let eof = Transfer.receive fd showProgress ti in
if eof then close_all infd outfd)
in
let file_id = Remote.newMsgId () in
Lwt.catch
(fun () ->
decompressor := Remote.MsgIdMap.add file_id decompr !decompressor;
compressRemotely connFrom
(bi, fspathFrom, pathFrom, fileKind, srcFileSize, id, file_id)
>>= fun () ->
decompressor :=
Remote.MsgIdMap.remove file_id !decompressor; (* For GC *)
close_all infd outfd;
(* JV: FIX: the file descriptors are already closed... *)
Lwt.return ())
(fun e ->
decompressor :=
Remote.MsgIdMap.remove file_id !decompressor; (* For GC *)
close_all_no_error infd outfd;
Lwt.fail e))
(****)
let transferResourceForkAndSetFileinfo
connFrom fspathFrom pathFrom fspathTo pathTo realPathTo
update desc fp ress id =
(* Resource fork *)
let ressLength = Osx.ressLength ress in
begin if ressLength > Uutil.Filesize.zero then
transferFileContents
connFrom fspathFrom pathFrom fspathTo pathTo realPathTo update
`RESS ressLength id
else
Lwt.return ()
end >>= fun () ->
setFileinfo fspathTo pathTo realPathTo update desc;
paranoidCheck fspathTo pathTo realPathTo desc fp ress
let reallyTransferFile
connFrom fspathFrom pathFrom fspathTo pathTo realPathTo
update desc fp ress id tempInfo =
debug (fun() -> Util.msg "reallyTransferFile(%s,%s) -> (%s,%s,%s,%s)\n"
(Fspath.toDebugString fspathFrom) (Path.toString pathFrom)
(Fspath.toDebugString fspathTo) (Path.toString pathTo)
(Path.toString realPathTo) (Props.toString desc));
validFilePrefix connFrom fspathFrom pathFrom fspathTo pathTo tempInfo desc
>>= fun prefixLen ->
begin match prefixLen with
None ->
removeOldTempFile fspathTo pathTo
| Some len ->
debug
(fun() ->
Util.msg "Keeping %s bytes previously transferred for file %s\n"
(Uutil.Filesize.toString len) (Path.toString pathFrom))
end;
(* Data fork *)
transferFileContents
connFrom fspathFrom pathFrom fspathTo pathTo realPathTo update
(match prefixLen with None -> `DATA | Some l -> `DATA_APPEND l)
(Props.length desc) id >>= fun () ->
transferResourceForkAndSetFileinfo
connFrom fspathFrom pathFrom fspathTo pathTo realPathTo
update desc fp ress id
(****)
let filesBeingTransferred = Hashtbl.create 17
let wakeupNextTransfer fp =
match
try
Some (Queue.take (Hashtbl.find filesBeingTransferred fp))
with Queue.Empty ->
None
with
None ->
Hashtbl.remove filesBeingTransferred fp
| Some next ->
Lwt.wakeup next ()
let executeTransfer fp f =
Lwt.try_bind f
(fun res -> wakeupNextTransfer fp; Lwt.return res)
(fun e -> wakeupNextTransfer fp; Lwt.fail e)
(* Keep track of which file contents are being transferred, and delay
the transfer of a file with the same contents as another file being
currently transferred. This way, the second transfer can be
skipped and replaced by a local copy. *)
let rec registerFileTransfer pathTo fp f =
if not (Prefs.read Xferhint.xferbycopying) then f () else
match
try Some (Hashtbl.find filesBeingTransferred fp) with Not_found -> None
with
None ->
let q = Queue.create () in
Hashtbl.add filesBeingTransferred fp q;
executeTransfer fp f
| Some q ->
debug (fun () -> Util.msg "delaying tranfer of file %s\n"
(Path.toString pathTo));
let res = Lwt.wait () in
Queue.push res q;
res >>= fun () ->
executeTransfer fp f
(****)
let copyprog =
Prefs.createString "copyprog" "rsync --partial --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 --append-verify --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.createBoolWithDefault "copyquoterem"
"!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 copymax =
Prefs.createInt "copymax" 1
"!maximum number of simultaneous copyprog transfers"
("A number indicating how many instances of the external copying utility \
Unison is allowed to run simultaneously (default to 1).")
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 shouldUseExternalCopyprog update desc =
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
let prepareExternalTransfer fspathTo pathTo =
let info = Fileinfo.get false fspathTo pathTo in
match info.Fileinfo.typ with
`FILE when Props.length info.Fileinfo.desc > Uutil.Filesize.zero ->
let perms = Props.perms info.Fileinfo.desc in
let perms' = perms lor 0o600 in
begin try
Fs.chmod (Fspath.concat fspathTo pathTo) perms'
with Unix.Unix_error _ -> () end;
true
| `ABSENT ->
false
| _ ->
debug (fun() -> Util.msg "Removing old temp file %s / %s\n"
(Fspath.toDebugString fspathTo) (Path.toString pathTo));
Os.delete fspathTo pathTo;
false
let finishExternalTransferLocal connFrom
(fspathFrom, pathFrom, fspathTo, pathTo, realPathTo,
update, desc, fp, ress, id) =
let info = Fileinfo.get false fspathTo pathTo in
if
info.Fileinfo.typ <> `FILE ||
Props.length info.Fileinfo.desc <> Props.length desc
then
raise (Util.Transient (Printf.sprintf
"External copy program did not create target file (or bad length): %s"
(Path.toString pathTo)));
transferResourceForkAndSetFileinfo
connFrom fspathFrom pathFrom fspathTo pathTo realPathTo
update desc fp ress id >>= fun res ->
Xferhint.insertEntry fspathTo pathTo fp;
Lwt.return res
let finishExternalTransferOnRoot =
Remote.registerRootCmdWithConnection
"finishExternalTransfer" finishExternalTransferLocal
let copyprogReg = Lwt_util.make_region 1
let transferFileUsingExternalCopyprog
rootFrom pathFrom rootTo fspathTo pathTo realPathTo
update desc fp ress id useExistingTarget =
Uutil.showProgress id Uutil.Filesize.zero "ext";
let prog =
if useExistingTarget 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 Uutil.quotes s else s in
let fromSpec =
(formatConnectionInfo rootFrom)
^ (addquotes rootFrom
(Fspath.toString (Fspath.concat (snd rootFrom) pathFrom))) in
let toSpec =
(formatConnectionInfo rootTo)
^ (addquotes rootTo
(Fspath.toString (Fspath.concat fspathTo pathTo))) in
let cmd = prog ^ " "
^ (Uutil.quotes fromSpec) ^ " "
^ (Uutil.quotes toSpec) in
Trace.log (Printf.sprintf "%s\n" cmd);
Lwt_util.resize_region copyprogReg (Prefs.read copymax);
Lwt_util.run_in_region copyprogReg 1
(fun () -> External.runExternalProgram cmd) >>= fun (_, log) ->
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"));
Uutil.showProgress id (Props.length desc) "ext";
finishExternalTransferOnRoot rootTo rootFrom
(snd rootFrom, pathFrom, fspathTo, pathTo, realPathTo,
update, desc, fp, ress, id)
(****)
let transferFileLocal connFrom
(fspathFrom, pathFrom, fspathTo, pathTo, realPathTo,
update, desc, fp, ress, id) =
let (tempInfo, isTransferred) =
fileIsTransferred fspathTo pathTo desc fp ress in
if isTransferred then begin
(* File is already fully transferred (from some interrupted
previous transfer). *)
(* Make sure permissions are right. *)
let msg =
Printf.sprintf
"%s/%s has already been transferred\n"
(Fspath.toDebugString fspathTo) (Path.toString realPathTo)
in
let len = Uutil.Filesize.add (Props.length desc) (Osx.ressLength ress) in
Uutil.showProgress id len "alr";
setFileinfo fspathTo pathTo realPathTo update desc;
Xferhint.insertEntry fspathTo pathTo fp;
Lwt.return (`DONE (TransferSucceeded tempInfo, Some msg))
end else
registerFileTransfer pathTo fp
(fun () ->
match
tryCopyMovedFile fspathTo pathTo realPathTo update desc fp ress id
with
Some (info, msg) ->
(* Transfer was performed by copying *)
Xferhint.insertEntry fspathTo pathTo fp;
Lwt.return (`DONE (TransferSucceeded info, Some msg))
| None ->
if shouldUseExternalCopyprog update desc then
Lwt.return (`EXTERNAL (prepareExternalTransfer fspathTo pathTo))
else begin
reallyTransferFile
connFrom fspathFrom pathFrom fspathTo pathTo realPathTo
update desc fp ress id tempInfo >>= fun status ->
Xferhint.insertEntry fspathTo pathTo fp;
Lwt.return (`DONE (status, None))
end)
let transferFileOnRoot =
Remote.registerRootCmdWithConnection "transferFile" transferFileLocal
(* 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 =
(* Token queue *)
min 64 ((truncate (Uutil.Filesize.toFloat sz) + 1023) / 1024)
+
(* Read buffer *)
8
let transferFile
rootFrom pathFrom rootTo fspathTo pathTo realPathTo
update desc fp ress id =
let f () =
Abort.check id;
transferFileOnRoot rootTo rootFrom
(snd rootFrom, pathFrom, fspathTo, pathTo, realPathTo,
update, desc, fp, ress, id) >>= fun status ->
match status with
`DONE (status, msg) ->
begin match msg with
Some msg ->
(* If the file was already present or transferred by copying
on the server, we need to update the amount of data
transferred so far here. *)
if fst rootTo <> Common.Local then begin
let len =
Uutil.Filesize.add (Props.length desc) (Osx.ressLength ress)
in
Uutil.showProgress id len "rem"
end;
Trace.log msg
| None ->
()
end;
Lwt.return status
| `EXTERNAL useExistingTarget ->
transferFileUsingExternalCopyprog
rootFrom pathFrom rootTo fspathTo pathTo realPathTo
update desc fp ress id useExistingTarget
in
(* When streaming, we only transfer one file at a time, so we don't
need to limit the number of concurrent transfers *)
if Prefs.read Remote.streamingActivated then
f ()
else
let bufSz = bufferSize (max (Props.length desc) (Osx.ressLength ress)) in
Lwt_util.run_in_region transferFileReg bufSz f
(****)
let file rootFrom pathFrom rootTo fspathTo pathTo realPathTo
update desc fp stamp 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.toDebugString 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);
paranoidCheck fspathTo pathTo realPathTo desc fp ress
| _ ->
transferFile
rootFrom pathFrom rootTo fspathTo pathTo realPathTo
update desc fp ress id
end >>= fun status ->
Trace.showTimer timer;
match status with
TransferSucceeded info ->
checkForChangesToSource rootFrom pathFrom desc fp stamp ress None false
>>= fun () ->
Lwt.return info
| TransferNeedsDoubleCheckAgainstCurrentSource (info,newfp) ->
debug (fun() -> Util.msg
"Archive data for %s is a pseudo-fingerprint: double-checking...\n"
(Path.toString realPathTo));
checkForChangesToSource rootFrom pathFrom
desc fp stamp ress (Some newfp) false
>>= (fun () ->
Lwt.return info)
| TransferFailed reason ->
(* Maybe we failed because the source file was modified.
We check this before reporting a failure *)
checkForChangesToSource rootFrom pathFrom desc fp stamp ress None true
>>= fun () ->
(* This function never returns (it is supposed to fail) *)
saveTempFileOnRoot rootTo (pathTo, realPathTo, reason)
(****)
let recursively fspathFrom pathFrom fspathTo pathTo =
let rec copy pFrom pTo =
let info = Fileinfo.get true fspathFrom pFrom in
match info.Fileinfo.typ with
| `SYMLINK ->
debug (fun () -> Util.msg " Copying link %s / %s to %s / %s\n"
(Fspath.toDebugString fspathFrom) (Path.toString pFrom)
(Fspath.toDebugString fspathTo) (Path.toString pTo));
Os.symlink fspathTo pTo (Os.readLink fspathFrom pFrom)
| `FILE ->
debug (fun () -> Util.msg " Copying file %s / %s to %s / %s\n"
(Fspath.toDebugString fspathFrom) (Path.toString pFrom)
(Fspath.toDebugString fspathTo) (Path.toString pTo));
localFile fspathFrom pFrom fspathTo pTo pTo
`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.toDebugString fspathFrom) (Path.toString pFrom)
(Fspath.toDebugString fspathTo) (Path.toString pTo));
Os.createDir fspathTo pTo info.Fileinfo.desc;
let ch = Os.childrenOf fspathFrom pFrom in
Safelist.iter
(fun n -> copy (Path.child pFrom n) (Path.child pTo n)) ch
| `ABSENT -> assert false in
debug (fun () -> Util.msg " Copying recursively %s / %s\n"
(Fspath.toDebugString fspathFrom) (Path.toString pathFrom));
copy pathFrom pathTo;
debug (fun () -> Util.msg " Finished copying %s / %s\n"
(Fspath.toDebugString fspathFrom) (Path.toString pathTo))
unison-2.48.3/copy.mli 000644 000766 000000 00000003002 12010743652 015506 0 ustar 00bcpierce wheel 000000 000000
(* Transfer a file from one 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 (temp location) *)
-> 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 *)
-> Fileinfo.stamp option (* source file stamp, if available *)
-> Osx.ressStamp (* resource info of file *)
-> Uutil.File.t (* file's index in UI (for progress bars) *)
-> Fileinfo.t Lwt.t (* information regarding the transferred file *)
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), if appropriate *)
-> unit
val recursively :
Fspath.t (* fspath of source *)
-> Path.local (* path of source *)
-> Fspath.t (* fspath of target *)
-> Path.local (* path of target *)
-> unit
unison-2.48.3/COPYING 000644 000766 000000 00000104513 11021523440 015065 0 ustar 00bcpierce wheel 000000 000000 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.48.3/external.ml 000644 000766 000000 00000006370 12450317305 016220 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/external.ml *)
(* Copyright 1999-2015, 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 lst = ref [] in
let rec loop () =
lst := input_line c :: !lst;
loop ()
in
begin try loop () with End_of_file -> () end;
String.concat "\n" (Safelist.rev !lst)
let readChannelTillEof_lwt c =
let rec loop lines =
Lwt.try_bind
(fun () -> Lwt_unix.input_line c)
(fun l -> loop (l :: lines))
(fun e -> if e = End_of_file then Lwt.return lines else Lwt.fail e)
in
String.concat "\n" (Safelist.rev (Lwt_unix.run (loop [])))
let readChannelsTillEof l =
let rec suckitdry lines c =
Lwt.try_bind
(fun () -> Lwt_unix.input_line c)
(fun l -> suckitdry (l :: lines) c)
(fun e -> match e with End_of_file -> Lwt.return lines | _ -> raise e)
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 = System.open_process_in ("\"" ^ cmd ^ "\"") in
let log = readChannelTillEof c in
let returnValue = System.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
Lwt.return (returnValue,mergeResultLog)
end else
let (out, ipt, err) as desc = System.open_process_full cmd in
let out = Lwt_unix.intern_in_channel out in
let err = Lwt_unix.intern_in_channel err in
readChannelsTillEof [out;err]
>>= (function [logOut;logErr] ->
let returnValue = System.close_process_full desc in
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.48.3/external.mli 000644 000766 000000 00000000360 12450317305 016362 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/external.mli *)
(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
val runExternalProgram : string -> (Unix.process_status * string) Lwt.t
val readChannelTillEof : in_channel -> string
unison-2.48.3/fileinfo.ml 000644 000766 000000 00000017560 12450317305 016174 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/fileinfo.ml *)
(* Copyright 1999-2015, 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+"
let allowSymlinks =
Prefs.createBoolWithDefault "links"
"!allow the synchronization of symbolic links (true/false/default)"
("When set to {\\tt true}, this flag causes Unison to synchronize \
symbolic links. When the flag is set to {\\tt false}, symbolic \
links will result in an error during update detection. \
Ordinarily, when the flag is set to {\\tt default}, symbolic \
links are synchronized except when one of the hosts is running \
Windows. In rare circumstances it may be useful to set the flag \
manually.")
let symlinksAllowed =
Prefs.createBool "links-aux" true
"*Pseudo-preference for internal use only" ""
let init b =
Prefs.set symlinksAllowed
(Prefs.read allowSymlinks = `True ||
(Prefs.read allowSymlinks = `Default && not b))
type typ = [ `ABSENT | `FILE | `DIRECTORY | `SYMLINK ]
let type2string = function
`ABSENT -> "nonexistent"
| `FILE -> "file"
| `DIRECTORY -> "dir"
| `SYMLINK -> "symlink"
type t = { typ : typ; inode : int; 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 = Fs.lstat fullpath in
if stats.Unix.LargeFile.st_kind = Unix.S_LNK
&& fromRoot
&& Path.followLink path
then begin
Fswatch.followLink path;
try Fs.stat fullpath
with Unix.Unix_error((Unix.ENOENT | Unix.ENOTDIR),_,_) ->
raise (Util.Transient (Printf.sprintf
"Path %s is marked 'follow' but its target is missing"
(Fspath.toPrintString fullpath)))
end 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.toDebugString (Fspath.concat fspath path))
fromRoot stats.Unix.LargeFile.st_ctime stats.Unix.LargeFile.st_mtime);
let typ =
match stats.Unix.LargeFile.st_kind with
Unix.S_REG -> `FILE
| Unix.S_DIR -> `DIRECTORY
| Unix.S_LNK ->
if not fromRoot || Prefs.read symlinksAllowed then
`SYMLINK
else
raise
(Util.Transient
(Format.sprintf "path %s is a symbolic link"
(Fspath.toPrintString (Fspath.concat fspath path))))
| _ ->
raise (Util.Transient
("path " ^
(Fspath.toPrintString (Fspath.concat 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;
desc = Props.get stats osxInfos;
osX = osxInfos }
with
Unix.Unix_error((Unix.ENOENT | Unix.ENOTDIR),_,_) ->
{ typ = `ABSENT;
inode = 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 ignoreInodeNumbers =
Prefs.createBool "ignoreinodenumbers" false
"!ignore inode number changes when detecting updates"
("When set to true, this preference makes Unison not take advantage \
of inode numbers during fast update detection. \
This switch should be used with care, as it \
is less safe than the standard update detection method, but it \
can be useful with filesystems which do not support inode numbers.")
let _ = Prefs.alias ignoreInodeNumbers "pretendwin"
let stamp info =
(* Was "CtimeStamp info.ctime", but this is bogus: Windows
ctimes are not reliable. *)
if Prefs.read ignoreInodeNumbers then CtimeStamp 0.0 else
if Fs.hasInodeNumbers () then InodeStamp info.inode else 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)
(****)
let get' f =
Util.convertUnixErrorsToTransient
"querying file information"
(fun () ->
try
let stats = System.stat f in
let typ = `FILE in
let osxInfos = Osx.defaultInfos typ in
{ typ = typ;
inode = stats.Unix.LargeFile.st_ino land 0x3FFFFFFF;
desc = Props.get stats osxInfos;
osX = osxInfos }
with
Unix.Unix_error((Unix.ENOENT | Unix.ENOTDIR),_,_) ->
{ typ = `ABSENT;
inode = 0;
desc = Props.dummy;
osX = Osx.defaultInfos `ABSENT })
unison-2.48.3/fileinfo.mli 000644 000766 000000 00000002000 12450317305 016324 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/fileinfo.mli *)
(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
type typ = [`ABSENT | `FILE | `DIRECTORY | `SYMLINK]
val type2string : typ -> string
type t = { typ : typ; inode : int; desc : Props.t; osX : Osx.info}
val get : bool (* fromRoot *) -> 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
val get' : System.fspath -> t
(* 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)
(****)
val init : bool -> unit
val allowSymlinks : [`True|`False|`Default] Prefs.t
val ignoreInodeNumbers : bool Prefs.t
unison-2.48.3/files.ml 000644 000766 000000 00000135230 12450317305 015476 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/files.ml *)
(* Copyright 1999-2015, 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.toDebugString source in
let targetname = Fspath.toDebugString target in
debug (fun() -> Util.msg "Writing commit log: renaming %s to %s via %s\n"
sourcename targetname tempname);
Util.convertUnixErrorsToFatal
"writing commit log"
(fun () ->
let c =
System.open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_excl]
0o600 commitLogName in
Printf.fprintf c "Warning: the last run of %s terminated abnormally "
Uutil.myName;
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 () -> System.unlink commitLogName)
let processCommitLog () =
if System.file_exists commitLogName then begin
raise(Util.Fatal(
Printf.sprintf
"Warning: the previous run of %s terminated in a dangerous state.
Please consult the file %s, delete it, and try again."
Uutil.myName
(System.fspathToPrintString commitLogName)))
end else
Lwt.return ()
let processCommitLogOnHost =
Remote.registerHostCmd "processCommitLog" processCommitLog
let processCommitLogs() =
Lwt_unix.run
(Globals.allHostsIter (fun h -> processCommitLogOnHost h ()))
(* ------------------------------------------------------------ *)
let copyOnConflict = Prefs.createBool "copyonconflict" false
"!keep copies of conflicting files"
"When this flag is set, Unison will make a copy of files that would \
otherwise be overwritten or deleted in case of conflicting changes, \
and more generally whenever the default behavior is overriden. \
This makes it possible to automatically resolve conflicts in a \
fairly safe way when synchronizing continuously, in combination \
with the \\verb|-repeat watch| and \\verb|-prefer newer| preferences."
let prepareCopy workingDir path notDefault =
if notDefault && Prefs.read copyOnConflict then begin
let tmpPath = Os.tempPath workingDir path in
Copy.recursively workingDir path workingDir tmpPath;
Some (workingDir, path, tmpPath)
end else
None
let finishCopy copyInfo =
match copyInfo with
Some (workingDir, path, tmpPath) ->
let tm = Unix.localtime (Unix.gettimeofday ()) in
let rec copyPath n =
let p =
Path.addToFinalName path
(Format.sprintf " (copy: conflict%s on %04d-%02d-%02d)"
(if n = 0 then "" else " #" ^ string_of_int n)
(tm.Unix.tm_year + 1900) (tm.Unix.tm_mon + 1) tm.Unix.tm_mday)
in
if Os.exists workingDir p then copyPath (n + 1) else p
in
Os.rename "keepCopy" workingDir tmpPath workingDir (copyPath 0)
| None ->
()
(* ------------------------------------------------------------ *)
let deleteLocal (fspathTo, (pathTo, ui, notDefault)) =
debug (fun () ->
Util.msg "deleteLocal [%s] (None, %s)\n"
(Fspath.toDebugString fspathTo) (Path.toString pathTo));
let localPathTo = Update.translatePathLocal fspathTo pathTo in
let copyInfo = prepareCopy fspathTo localPathTo notDefault in
(* Make sure the target is unchanged first *)
(* (There is an unavoidable race condition here.) *)
let prevArch = Update.checkNoUpdates fspathTo localPathTo ui in
finishCopy copyInfo;
Stasher.backup fspathTo localPathTo `AndRemove prevArch;
(* Archive update must be done last *)
Update.replaceArchiveLocal fspathTo localPathTo Update.NoArchive;
Lwt.return ()
let deleteOnRoot = Remote.registerRootCmd "delete" deleteLocal
let delete rootFrom pathFrom rootTo pathTo ui notDefault =
deleteOnRoot rootTo (pathTo, ui, notDefault) >>= fun _ ->
Update.replaceArchive rootFrom pathFrom Update.NoArchive
(* ------------------------------------------------------------ *)
let fileUpdated ui =
match ui with
Updates (File (_, ContentsUpdated _), _) -> true
| _ -> false
let setPropLocal (fspath, (path, ui, newDesc, oldDesc)) =
(* [ui] provides the modtime while [newDesc] provides the other
file properties *)
let localPath = Update.translatePathLocal fspath path in
let (workingDir,realPath) = Fspath.findWorkingDir fspath localPath in
Fileinfo.set workingDir realPath (`Update oldDesc) newDesc;
if fileUpdated ui then Stasher.stashCurrentVersion fspath localPath None;
(* Archive update must be done last *)
Update.updateProps fspath localPath (Some newDesc) ui;
Lwt.return ()
let setPropOnRoot = Remote.registerRootCmd "setProp" setPropLocal
let updatePropsOnRoot =
Remote.registerRootCmd
"updateProps"
(fun (fspath, (path, propOpt, ui)) ->
let localPath = Update.translatePathLocal fspath path in
(* Archive update must be done first *)
Update.updateProps fspath localPath propOpt ui;
if fileUpdated ui then
Stasher.stashCurrentVersion fspath localPath None;
Lwt.return ())
let updateProps root path propOpt ui =
updatePropsOnRoot root (path, propOpt, ui)
(* FIX: we should check there has been no update before performing the
change *)
let setProp rootFrom pathFrom rootTo pathTo newDesc oldDesc uiFrom uiTo =
debug (fun() ->
Util.msg
"setProp %s %s %s\n %s %s %s\n"
(root2string rootFrom) (Path.toString pathFrom)
(Props.toString newDesc)
(root2string rootTo) (Path.toString pathTo)
(Props.toString oldDesc));
setPropOnRoot rootTo (pathTo, uiTo, newDesc, oldDesc) >>= fun _ ->
updateProps rootFrom pathFrom None uiFrom
(* ------------------------------------------------------------ *)
let mkdirOnRoot =
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 *)
Fs.chmod (Fspath.concat workingDir path)
(Props.perms info.Fileinfo.desc lor 0o700)
with Unix.Unix_error _ -> () end;
Lwt.return (true, info.Fileinfo.desc)
end else begin
if info.Fileinfo.typ <> `ABSENT then
Os.delete workingDir path;
Os.createDir workingDir path Props.dirDefault;
Lwt.return (false, (Fileinfo.get false workingDir path).Fileinfo.desc)
end)
let setDirPropOnRoot =
Remote.registerRootCmd
"setDirProp"
(fun (_, (workingDir, path, initialDesc, newDesc)) ->
Fileinfo.set workingDir path (`Set initialDesc) newDesc;
Lwt.return ())
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 performRename fspathTo localPathTo workingDir pathFrom pathTo prevArch =
debug (fun () -> Util.msg "Renaming %s to %s in %s; root is %s\n"
(Path.toString pathFrom)
(Path.toString pathTo)
(Fspath.toDebugString workingDir)
(Fspath.toDebugString fspathTo));
let source = Fspath.concat workingDir pathFrom in
let target = Fspath.concat workingDir pathTo in
Util.convertUnixErrorsToTransient
(Printf.sprintf "renaming %s to %s"
(Fspath.toDebugString source) (Fspath.toDebugString 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.toPrintString source) (Fspath.toPrintString 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 workingDir pathTo in
let temp = Fspath.concat workingDir tmpPath in
let temp' = Fspath.toDebugString temp in
debug (fun() ->
Util.msg "moving %s to %s\n" (Fspath.toDebugString target) temp');
Stasher.backup fspathTo localPathTo `ByCopying prevArch;
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.toDebugString source)
(Fspath.toDebugString 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 fspathTo localPathTo `ByCopying prevArch;
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.toDebugString target)
(Fingerprint.toString (Fingerprint.file target Path.empty)));
end)
(* FIX: maybe we should rename the destination before making any check ? *)
(* JV (6/09): the window is small again...
FIX: When this code was originally written, we assumed that the
checkNoUpdates would happen immediately before the rename, 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 renameLocal
(fspathTo,
(localPathTo, workingDir, pathFrom, pathTo, ui, archOpt, notDefault)) =
let copyInfo = prepareCopy workingDir pathTo notDefault in
(* Make sure the target is unchanged, then do the rename.
(Note that there is an unavoidable race condition here...) *)
let prevArch = Update.checkNoUpdates fspathTo localPathTo ui in
finishCopy copyInfo;
performRename fspathTo localPathTo workingDir pathFrom pathTo prevArch;
begin match archOpt with
Some archTo -> Stasher.stashCurrentVersion fspathTo localPathTo None;
Update.iterFiles fspathTo localPathTo archTo
Xferhint.insertEntry;
(* Archive update must be done last *)
Update.replaceArchiveLocal fspathTo localPathTo archTo
| None -> ()
end;
Lwt.return ()
let renameOnHost = Remote.registerRootCmd "rename" renameLocal
let rename root localPath workingDir pathOld pathNew ui archOpt notDefault =
debug (fun() ->
Util.msg "rename(root=%s, pathOld=%s, pathNew=%s)\n"
(root2string root)
(Path.toString pathOld) (Path.toString pathNew));
renameOnHost root
(localPath, workingDir, pathOld, pathNew, ui, archOpt, notDefault)
(* ------------------------------------------------------------ *)
(* 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 rec createDirectories fspath localPath props =
match props with
[] ->
()
| desc :: rem ->
match Path.deconstructRev localPath with
None ->
assert false
| Some (_, parentPath) ->
createDirectories fspath parentPath rem;
try
let absolutePath = Fspath.concat fspath parentPath in
Fs.mkdir absolutePath (Props.perms desc)
(* The directory may have already been created
if there are several paths with the same prefix *)
with Unix.Unix_error (Unix.EEXIST, _, _) -> ()
let setupTargetPathsAndCreateParentDirectoryLocal (fspath, (path, props)) =
let localPath = Update.translatePathLocal fspath path in
Util.convertUnixErrorsToTransient
"creating parent directories"
(fun () -> createDirectories fspath localPath props);
let (workingDir,realPath) = Fspath.findWorkingDir fspath localPath in
let tempPath = Os.tempPath ~fresh:false workingDir realPath in
Lwt.return (workingDir, realPath, tempPath, localPath)
let setupTargetPathsAndCreateParentDirectory =
Remote.registerRootCmd "setupTargetPathsAndCreateParentDirectory"
setupTargetPathsAndCreateParentDirectoryLocal
(* ------------------------------------------------------------ *)
let updateSourceArchiveLocal (fspathFrom, (localPathFrom, uiFrom, errPaths)) =
(* Archive update must be done first (before Stasher call) *)
let newArch = Update.updateArchive fspathFrom localPathFrom uiFrom in
(* We update the archive with what we were expected to copy *)
Update.replaceArchiveLocal fspathFrom localPathFrom newArch;
(* Then, we remove all pieces of which the copy failed *)
List.iter
(fun p ->
debug (fun () ->
Util.msg "Copy under %s/%s was aborted\n"
(Fspath.toDebugString fspathFrom) (Path.toString p));
Update.replaceArchiveLocal fspathFrom p Update.NoArchive)
errPaths;
Stasher.stashCurrentVersion fspathFrom localPathFrom None;
Lwt.return ()
let updateSourceArchive =
Remote.registerRootCmd "updateSourceArchive" updateSourceArchiveLocal
(* ------------------------------------------------------------ *)
let deleteSpuriousChild fspathTo pathTo nm =
(* FIX: maybe we should turn them into Unison temporary files? *)
let path = (Path.child pathTo nm) in
debug (fun() -> Util.msg "Deleting spurious file %s/%s\n"
(Fspath.toDebugString fspathTo) (Path.toString path));
Os.delete fspathTo path
let rec deleteSpuriousChildrenRec fspathTo pathTo archChildren children =
match archChildren, children with
archNm :: archRem, nm :: rem ->
let c = Name.compare archNm nm in
if c < 0 then
deleteSpuriousChildrenRec fspathTo pathTo archRem children
else if c = 0 then
deleteSpuriousChildrenRec fspathTo pathTo archChildren rem
else begin
deleteSpuriousChild fspathTo pathTo nm;
deleteSpuriousChildrenRec fspathTo pathTo archChildren rem
end
| [], nm :: rem ->
deleteSpuriousChild fspathTo pathTo nm;
deleteSpuriousChildrenRec fspathTo pathTo [] rem
| _, [] ->
()
let deleteSpuriousChildrenLocal (_, (fspathTo, pathTo, archChildren)) =
deleteSpuriousChildrenRec
fspathTo pathTo archChildren
(List.sort Name.compare (Os.childrenOf fspathTo pathTo));
Lwt.return ()
let deleteSpuriousChildren =
Remote.registerRootCmd "deleteSpuriousChildren" deleteSpuriousChildrenLocal
let rec normalizePropsRec propsFrom propsTo =
match propsFrom, propsTo with
d :: r, d' :: r' -> normalizePropsRec r r'
| _, [] -> propsFrom
| [], _ :: _ -> assert false
let normalizeProps propsFrom propsTo =
normalizePropsRec (Safelist.rev propsFrom) (Safelist.rev propsTo)
(* ------------------------------------------------------------ *)
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) *)
propsFrom (* the properties of the parent directories, in
case we need to propagate them *)
rootTo pathTo (* ...to here *)
uiTo (* (but, before committing the copy, check that
this updateItem still describes the current
state of the target replica) *)
propsTo (* the properties of the parent directories *)
notDefault (* [true] if not Unison's default action *)
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 *)
setupTargetPathsAndCreateParentDirectory rootTo
(pathTo, normalizeProps propsFrom propsTo)
>>= fun (workingDir, realPathTo, tempPathTo, localPathTo) ->
(* When in Unicode case-insensitive mode, we want to create files
with NFC normal-form filenames. *)
let realPathTo =
match update with
`Update _ ->
realPathTo
| `Copy ->
match Path.deconstructRev realPathTo with
None ->
assert false
| Some (name, parentPath) ->
Path.child parentPath (Name.normalize name)
in
(* Calculate source path *)
Update.translatePath rootFrom pathFrom >>= fun localPathFrom ->
let errors = ref [] in
(* 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));
Lwt.catch
(fun () ->
match f with
Update.ArchiveFile (desc, fp, stamp, ress) ->
Lwt_util.run_in_region copyReg 1 (fun () ->
Abort.check id;
let stmp =
if Update.useFastChecking () then Some stamp else None in
Copy.file
rootFrom pFrom rootTo workingDir pTo realPTo
update desc fp stmp ress id
>>= fun info ->
let ress' = Osx.stamp info.Fileinfo.osX in
Lwt.return
(Update.ArchiveFile (Props.override info.Fileinfo.desc desc,
fp, Fileinfo.stamp info, 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) >>= fun () ->
Lwt.return (f, []))
| 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));
mkdirOnRoot rootTo (workingDir, pTo))
>>= fun (dirAlreadyExisting, initialDesc) ->
Abort.check id;
(* We start a thread for each child *)
let childThreads =
Update.NameMap.mapi
(fun name child ->
let nameTo = Name.normalize name in
copyRec (Path.child pFrom name)
(Path.child pTo nameTo)
(Path.child realPTo nameTo)
child)
children
in
(* We collect the thread results *)
Update.NameMap.fold
(fun nm childThr remThr ->
childThr >>= fun (arch, paths) ->
remThr >>= fun (children, pathl, error) ->
let childErr = arch = Update.NoArchive in
let children =
if childErr then children else
Update.NameMap.add nm arch children
in
Lwt.return (children, paths :: pathl, error || childErr))
childThreads
(Lwt.return (Update.NameMap.empty, [], false))
>>= fun (newChildren, pathl, childError) ->
begin if dirAlreadyExisting || childError then
let childNames =
Update.NameMap.fold (fun nm _ l -> nm :: l) newChildren [] in
deleteSpuriousChildren rootTo (workingDir, pTo, childNames)
else
Lwt.return ()
end >>= fun () ->
Lwt_util.run_in_region copyReg 1 (fun () ->
(* We use the actual file permissions so as to preserve
inherited bits *)
setDirPropOnRoot rootTo
(workingDir, pTo, initialDesc, desc)) >>= fun () ->
Lwt.return (Update.ArchiveDir (desc, newChildren),
List.flatten pathl)
| Update.NoArchive ->
assert false)
(fun e ->
match e with
Util.Transient _ ->
if not (Abort.testException e) then begin
Abort.file id;
errors := e :: !errors
end;
Lwt.return (Update.NoArchive, [pFrom])
| _ ->
Lwt.fail e)
in
(* Compute locally what we need to propagate *)
let rootLocal = List.hd (Globals.rootsInCanonicalOrder ()) in
let localArch =
Update.updateArchive (snd rootLocal) localPathFrom uiFrom in
copyRec localPathFrom tempPathTo realPathTo localArch
>>= fun (archTo, errPaths) ->
if archTo = Update.NoArchive then
(* We were not able to transfer anything *)
Lwt.fail (List.hd !errors)
else begin
(* Rename the files to their final location and then update the
archive on the destination replica *)
rename rootTo localPathTo workingDir tempPathTo realPathTo uiTo
(Some archTo) notDefault >>= fun () ->
(* Update the archive on the source replica
FIX: we could reuse localArch if rootFrom is the same as rootLocal *)
updateSourceArchive rootFrom (localPathFrom, uiFrom, errPaths) >>= fun () ->
(* Return the first error, if any *)
match Safelist.rev !errors with
e :: _ -> Lwt.fail e
| [] -> Lwt.return ()
end
(* ------------------------------------------------------------ *)
let (>>=) = Lwt.bind
let diffCmd =
Prefs.createString "diff" "diff -u CURRENT2 CURRENT1"
"!set 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)
^ " " ^ (Fspath.quotes fspath1)
^ " " ^ (Fspath.quotes fspath2)
else
Util.replacesubstrings (Prefs.read diffCmd)
["CURRENT1", Fspath.quotes fspath1;
"CURRENT2", Fspath.quotes fspath2] in
let c = System.open_process_in
(if Util.osType = `Win32 && not Util.isCygwin then
(* BCP: Proposed by Karl M. to deal with the standard windows
command processor's weird treatment of spaces and quotes: *)
"\"" ^ cmd ^ "\""
else
cmd) in
showDiff cmd (External.readChannelTillEof c);
ignore (System.close_process_in c) in
let (desc1, fp1, ress1, desc2, fp2, ress2) = Common.fileInfos ui1 ui2 in
match root1,root2 with
(Local,fspath1),(Local,fspath2) ->
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 None ress2 id) >>= fun info ->
Lwt.return ());
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 None ress1 id >>= fun info ->
Lwt.return ()));
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 = System.opendir dir in
let files = ref [] in
begin try
while true do files := dirh.System.readdir () :: !files done
with End_of_file ->
dirh.System.closedir ()
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"
(Uutil.quotes (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 None stamp id >>= fun info ->
rename rootTo localPathTo workingDirForCopy tempPathTo realPathTo
uiTo None false)
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 path1 ui1 root2 path2 ui2 id showMergeFn =
debug (fun () -> Util.msg "merge path %s between roots %s and %s\n"
(Path.toString path1) (root2string root1) (root2string root2));
(* The following assumes root1 is always local: switch them if needed to make this so *)
let (root1,path1,ui1,root2,path2,ui2) =
match root1 with
(Local,fspath1) -> (root1,path1,ui1,root2,path2,ui2)
| _ -> (root2,path2,ui2,root1,path1,ui1) in
let (localPath1, (workingDirForMerge, basep), fspath1) =
match root1 with
(Local,fspath1) ->
let localPath1 = Update.translatePathLocal fspath1 path1 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 None ress1 id >>= fun info ->
Lwt.return ());
Lwt_unix.run
(Update.translatePath root2 path2 >>= (fun path2 ->
Copy.file
root2 path2 root1 workingDirForMerge working2 basep
`Copy desc2 fp2 None ress2 id) >>= fun info ->
Lwt.return ());
(* retrieve the archive for this file, if any *)
let arch =
match ui1, ui2 with
| Updates (_, Previous (_,_,fp,_)), Updates (_, Previous (_,_,fp2,_)) ->
if fp = fp2 then
Stasher.getRecentVersion fspath1 localPath1 fp
else
assert false
| NoUpdates, Updates(_, Previous (_,_,fp,_))
| Updates(_, Previous (_,_,fp,_)), NoUpdates ->
Stasher.getRecentVersion fspath1 localPath1 fp
| 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 fp1 = Os.fingerprint workingDirForMerge working1 info1 in
let info2 = Fileinfo.get false workingDirForMerge working2 in
let fp2 = Os.fingerprint workingDirForMerge working2 info2 in
let cmd = formatMergeCmd
path1
(Fspath.quotes (Fspath.concat workingDirForMerge working1))
(Fspath.quotes (Fspath.concat workingDirForMerge working2))
(match arch with None -> None | Some f -> Some(Fspath.quotes f))
(Fspath.quotes (Fspath.concat workingDirForMerge new1))
(Fspath.quotes (Fspath.concat workingDirForMerge new2))
(Fspath.quotes (Fspath.concat workingDirForMerge newarch)) in
Trace.log (Printf.sprintf "Merge command: %s\n" cmd);
let returnValue, mergeResultLog =
Lwt_unix.run (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 path1))
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.toDebugString (Fspath.concat workingDirForMerge new1)));
let new1exists = Fs.file_exists (Fspath.concat workingDirForMerge new1) in
let new2exists = Fs.file_exists (Fspath.concat workingDirForMerge new2) in
let newarchexists = Fs.file_exists (Fspath.concat workingDirForMerge newarch) in
if new1exists && new2exists then begin
if newarchexists then
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 fp1' = Os.fingerprint workingDirForMerge new1 info1 in
let fp2' = Os.fingerprint workingDirForMerge new2 info2 in
if fp1'=fp2' 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 = Fs.file_exists (Fspath.concat workingDirForMerge working1) in
let working2_still_exists = Fs.file_exists (Fspath.concat workingDirForMerge working2) in
if working1_still_exists && working2_still_exists then begin
say (fun () -> Util.msg "No output from merge cmd and both original files are still present\n");
let info1' = Fileinfo.get false workingDirForMerge working1 in
let fp1' = Os.fingerprint workingDirForMerge working1 info1' in
let info2' = Fileinfo.get false workingDirForMerge working2 in
let fp2' = Os.fingerprint workingDirForMerge working2 info2' in
if fp1 = fp1' && fp2 = fp2' then
raise (Util.Transient "Merge program didn't change either temp file");
if fp1' = fp2' then begin
say (fun () -> Util.msg "Merge program made files equal\n");
copy [(working1,workingarch)];
end else if fp2 = fp2' then begin
say (fun () -> Util.msg "Merge program changed just first input\n");
copy [(working1,working2);(working1,workingarch)]
end else if fp1 = fp1' 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 path1 desc1 ui1 id >>= (fun () ->
copyBack workingDirForMerge working2 root2 path2 desc2 ui2 id >>= (fun () ->
let arch_fspath = Fspath.concat workingDirForMerge workingarch in
if Fs.file_exists arch_fspath then begin
debug (fun () -> Util.msg "Updating unison archives for %s to reflect results of merge\n"
(Path.toString path1));
if not (Stasher.shouldBackupCurrent path1) then
Util.msg "Warning: 'backupcurrent' is not set for path %s\n" (Path.toString path1);
Stasher.stashCurrentVersion workingDirForMerge localPath1 (Some workingarch);
let infoarch = Fileinfo.get false workingDirForMerge workingarch in
let fp = Os.fingerprint arch_fspath Path.empty infoarch in
debug (fun () -> Util.msg "New fingerprint is %s\n" (Os.fullfingerprint_to_string fp));
let new_archive_entry =
Update.ArchiveFile
(Props.get (Fs.stat arch_fspath) infoarch.osX, fp,
Fileinfo.stamp (Fileinfo.get true arch_fspath Path.empty),
Osx.stamp infoarch.osX) in
Update.replaceArchive root1 path1 new_archive_entry >>= fun _ ->
Update.replaceArchive root2 path2 new_archive_entry >>= 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.48.3/files.mli 000644 000766 000000 00000010253 12450317305 015644 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/files.mli *)
(* Copyright 1999-2015, 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 *)
-> bool (* [true] if not Unison's default action *)
-> 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 *)
-> Props.t list (* properties of parent directories *)
-> Common.root (* to what root *)
-> Path.t (* to what path *)
-> Common.updateItem (* dest. updates *)
-> Props.t list (* properties of parent directories *)
-> bool (* [true] if not Unison's default action *)
-> 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. *)
val ls : System.fspath -> string -> string list
val merge :
Common.root (* first root *)
-> Path.t (* path to merge *)
-> Common.updateItem (* differences from the archive *)
-> Common.root (* second root *)
-> Path.t (* path to merge *)
-> Common.updateItem (* differences from the archive *)
-> Uutil.File.t (* id for showing progress of transfer *)
-> (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.48.3/fileutil.ml 000644 000766 000000 00000002475 12450317305 016215 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/fileutil.ml *)
(* Copyright 1999-2015, 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.48.3/fileutil.mli 000644 000766 000000 00000000450 12450317305 016355 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/fileutil.mli *)
(* Copyright 1999-2015, 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.48.3/fingerprint.ml 000644 000766 000000 00000006363 12450317305 016727 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/fingerprint.ml *)
(* Copyright 1999-2015, 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
let pseudo_prefix = "LEN"
let pseudo path len = pseudo_prefix ^ (Uutil.Filesize.toString len) ^ "@" ^
(Digest.string (Path.toString path))
let ispseudo f = Util.startswith f pseudo_prefix
(* 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.concat fspath path in
Util.convertUnixErrorsToTransient
("digesting " ^ Fspath.toPrintString f)
(fun () -> Fs.fingerprint 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"
(Fspath.toPrintString path)));
Util.convertUnixErrorsToTransient
"digesting subfile"
(fun () ->
let inch = Fs.open_in_bin path in
begin try
LargeFile.seek_in inch offset;
let res = Digest.channel inch (Uutil.Filesize.toInt len) in
close_in inch;
res
with
End_of_file ->
close_in_noerr inch;
raise (Util.Transient
(Format.sprintf
"Error in digesting subfile '%s': truncated file"
(Fspath.toPrintString 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 =
if ispseudo md5 then md5 else begin
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
end
let string = Digest.string
let dummy = ""
let hash d =
let l = String.length d in
if l = 0 then
1234577
else begin
assert (l >= 3);
Char.code (String.unsafe_get d 0) +
(Char.code (String.unsafe_get d 1) lsl 8) +
(Char.code (String.unsafe_get d 2) lsl 16)
end
let equal (d : string) d' = d = d'
unison-2.48.3/fingerprint.mli 000644 000766 000000 00000001406 12450317305 017071 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/fingerprint.mli *)
(* Copyright 1999-2015, 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 : Fspath.t -> 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
val hash : t -> int
val equal : t -> t -> bool
(* A pseudo-fingerprint has the same type as a real one (so it can
be stored in the archive, etc.), but it is computed just from the
size of the file, ignoring the contents *)
val pseudo : Path.local -> Uutil.Filesize.t -> t
val ispseudo : t -> bool
unison-2.48.3/fpcache.ml 000644 000766 000000 00000024666 12450317305 015777 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/fpcache.ml *)
(* Copyright 1999-2015, 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 "fpcache"
(* In-memory cache *)
module PathTbl =
Hashtbl.Make
(struct
type t = string
let equal (s1 : string) (s2 : string) = s1 = s2
let hash = Hashtbl.hash
end)
let tbl = PathTbl.create 101
(* Information for writing to the on-disk cache *)
type entry =
int * string * (Props.t * Os.fullfingerprint * Fileinfo.stamp * Osx.ressStamp)
type state =
{ oc : out_channel;
mutable count : int;
mutable size : Uutil.Filesize.t;
mutable last : string;
mutable queue : entry list }
let state = ref None
(****)
(* Path compression and decompression (use delta from previous path for
compression) *)
let decompress st i path =
let l = String.length path in
let s = String.create (l + i) in
String.blit !st 0 s 0 i;
String.blit path 0 s i l;
st := s;
s
let compress state path =
let s = state.last in
let p = Path.toString path in
let l = min (String.length p) (String.length s) in
let i = ref 0 in
while !i < l && p.[!i] = s.[!i] do incr i done;
state.last <- p;
(!i, String.sub p !i (String.length p - !i))
(*****)
(* Read and write a chunk of file fingerprints from the cache *)
let read st ic =
(* I/O errors are dealt with at a higher level *)
let fp1 = Digest.input ic in
let fp2 = Digest.input ic in
let headerSize = Marshal.header_size in
let header = String.create headerSize in
really_input ic header 0 headerSize;
if fp1 <> Digest.string header then begin
debug (fun () -> Util.msg "bad header checksum\n");
raise End_of_file
end;
let dataSize = Marshal.data_size header 0 in
let s = String.create (headerSize + dataSize) in
String.blit header 0 s 0 headerSize;
really_input ic s headerSize dataSize;
if fp2 <> Digest.string s then begin
debug (fun () -> Util.msg "bad chunk checksum\n");
raise End_of_file
end;
let q : entry list = Marshal.from_string s 0 in
debug (fun () -> Util.msg "read chunk of %d files\n" (List.length q));
List.iter (fun (l, p, i) -> PathTbl.add tbl (decompress st l p) i) q
let closeOut st =
state := None;
try
close_out st.oc
with Sys_error error ->
debug (fun () -> Util.msg "error in closing cache file: %s\n" error)
let write state =
let q = Safelist.rev state.queue in
let s = Marshal.to_string q [Marshal.No_sharing] in
let fp1 = Digest.substring s 0 Marshal.header_size in
let fp2 = Digest.string s in
begin try
Digest.output state.oc fp1; Digest.output state.oc fp2;
output_string state.oc s; flush state.oc
with Sys_error error ->
debug (fun () -> Util.msg "error in writing to cache file: %s\n" error);
closeOut state
end;
state.count <- 0;
state.size <- Uutil.Filesize.zero;
state.queue <- []
(****)
(* Start and finish dealing with the cache *)
let finish () =
PathTbl.clear tbl;
match !state with
Some st -> if st.queue <> [] then write st;
closeOut st
| None -> ()
let magic = "Unison fingerprint cache format 2"
let init fastCheck ignorearchives fspath =
finish ();
if fastCheck && not ignorearchives then begin
begin try
debug (fun () -> Util.msg "opening cache file %s for input\n"
(System.fspathToDebugString fspath));
let ic = System.open_in_bin fspath in
begin try
let header = input_line ic in
if header <> magic then raise (Sys_error "wrong header");
let st = ref "" in
while true do read st ic done
with
Sys_error error ->
debug (fun () -> Util.msg "error in loading cache file %s: %s\n"
(System.fspathToDebugString fspath) error)
| End_of_file ->
()
end;
begin try
close_in ic
with Sys_error error ->
debug (fun () -> Util.msg "error in closing cache file %s: %s\n"
(System.fspathToDebugString fspath) error)
end;
with Sys_error error ->
debug (fun () -> Util.msg "could not open cache file %s: %s\n"
(System.fspathToDebugString fspath) error)
end;
begin try
debug (fun () -> Util.msg "opening cache file %s for output\n"
(System.fspathToDebugString fspath));
let oc =
System.open_out_gen
[Open_wronly; Open_creat; Open_trunc; Open_binary] 0o600 fspath in
output_string oc magic; output_string oc "\n"; flush oc;
state :=
Some { oc = oc; count = 0; size = Uutil.Filesize.zero;
last = ""; queue = [] }
with Sys_error error ->
debug (fun () -> Util.msg "could not open cache file %s: %s\n"
(System.fspathToDebugString fspath) error)
end
end
(****)
(* Enqueue a fingerprint to be written to disk. *)
let maxCount = 5000
let maxSize = Uutil.Filesize.ofInt (100 * 1024 * 1024)
let save path v =
match !state with
None ->
()
| Some state ->
let (desc, _, _, _) = v in
let l = Props.length desc in
state.size <- Uutil.Filesize.add state.size l;
state.count <- state.count + 1;
let (l, s) = compress state path in
state.queue <- (l, s, v) :: state.queue;
if state.count > maxCount || state.size > maxSize then write state
(****)
(* Check whether a fingerprint is in the in-memory cache and store it
to the on-disk cache in any case. *)
(* HACK: we disable fastcheck for Excel (and MPP) files, 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"
let dataClearlyUnchanged fastCheck path info desc stamp =
fastCheck
&&
Props.same_time info.Fileinfo.desc desc
&&
Props.length info.Fileinfo.desc = Props.length desc
&&
not (excelFile path)
&&
match stamp 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
let ressClearlyUnchanged fastCheck info ress dataClearlyUnchanged =
fastCheck
&&
Osx.ressUnchanged ress info.Fileinfo.osX.Osx.ressInfo
None dataClearlyUnchanged
let clearlyUnchanged fastCheck path newInfo oldDesc oldStamp oldRess =
let du =
dataClearlyUnchanged fastCheck path newInfo oldDesc oldStamp
in
du && ressClearlyUnchanged fastCheck newInfo oldRess du
let fastercheckUNSAFE =
Prefs.createBool "fastercheckUNSAFE"
false "!skip computing fingerprints for new files (experts only!)"
( "THIS FEATURE IS STILL EXPERIMENTAL AND SHOULD BE USED WITH EXTREME CAUTION. "
^ "\n\n"
^ "When this flag is set to {\\tt true}, Unison will compute a 'pseudo-"
^ "fingerprint' the first time it sees a file (either because the file is "
^ "new or because Unison is running for the first time). This enormously "
^ "speeds update detection, but it must be used with care, as it can cause "
^ "Unison to miss conflicts: If "
^ "a given path in the filesystem contains files on {\\em both} sides that "
^ "Unison has not yet seen, and if those files have the same length but different "
^ "contents, then Unison will not notice the presence of a conflict. If, later, one "
^ "of the files is changed, the changed file will be propagated, overwriting "
^ "the other. "
^ "\n\n"
^ "Moreover, even when the files are initially identical, setting this flag can lead "
^ "to potentially confusing behavior: "
^ "if a newly created file is later touched without being modified, Unison will "
^ "treat this "
^ "conservatively as a potential change (since it has no record of the earlier "
^ "contents) and show it as needing to be propagated to the other replica. "
^ "\n\n"
^ "Most users should leave this flag off -- the small time savings of not "
^ "fingerprinting new files is not worth the cost in terms of safety. However, "
^ "it can be very useful for power users with huge replicas that are known to "
^ "be already synchronized (e.g., because one replica is a newly created duplicate "
^ "of the other, or because they have previously been synchronized with Unison but "
^ "Unison's archives need to be rebuilt). In such situations, it is recommended "
^ "that this flag be set only for the initial run of Unison, so that new archives "
^ "can be created quickly, and then turned off for normal use.")
let fingerprint ?(newfile=false) fastCheck currfspath path info optFp =
let res =
try
let (cachedDesc, cachedFp, cachedStamp, cachedRess) =
PathTbl.find tbl (Path.toString path) in
if
not (clearlyUnchanged
fastCheck path info cachedDesc cachedStamp cachedRess)
then
raise Not_found;
debug (fun () -> Util.msg "cache hit for path %s\n"
(Path.toDebugString path));
(info.Fileinfo.desc, cachedFp, Fileinfo.stamp info,
Fileinfo.ressStamp info)
with Not_found ->
if fastCheck then
debug (fun () -> Util.msg "cache miss for path %s\n"
(Path.toDebugString path));
let (info, dig) =
if Prefs.read fastercheckUNSAFE && newfile then begin
debug (fun()-> Util.msg "skipping initial fingerprint of %s\n"
(Fspath.toDebugString (Fspath.concat currfspath path)));
(Fileinfo.get false currfspath path,
Os.pseudoFingerprint path (Props.length info.Fileinfo.desc))
end else begin
Os.safeFingerprint currfspath path info optFp
end in
(info.Fileinfo.desc, dig, Fileinfo.stamp info, Fileinfo.ressStamp info)
in
save path res;
res
unison-2.48.3/fpcache.mli 000644 000766 000000 00000001653 12450317305 016137 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/fpcache.mli *)
(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
(* Initialize the cache *)
val init : bool -> bool -> System.fspath -> unit
(* Close the cache file and clear the in-memory cache *)
val finish : unit -> unit
(* Get the fingerprint of a file, possibly from the cache *)
val fingerprint :
?newfile:bool ->
bool -> Fspath.t -> Path.local -> Fileinfo.t -> Os.fullfingerprint option ->
Props.t * Os.fullfingerprint * Fileinfo.stamp * Osx.ressStamp
(* Add an entry to the cache *)
val save :
Path.local ->
Props.t * Os.fullfingerprint * Fileinfo.stamp * Osx.ressStamp -> unit
(****)
val dataClearlyUnchanged :
bool -> Path.local -> Fileinfo.t -> Props.t -> Fileinfo.stamp -> bool
val ressClearlyUnchanged :
bool -> Fileinfo.t -> 'a Osx.ressInfo -> bool -> bool
(* Is that a file for which fast checking is disabled? *)
val excelFile : Path.local -> bool
unison-2.48.3/fs.ml 000644 000766 000000 00000004313 12450317305 015001 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/fs.ml *)
(* Copyright 1999-2015, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
module System = System_impl.Fs
type fspath = Fspath.t
type dir_handle = System.dir_handle
= { readdir : unit -> string; closedir : unit -> unit }
let symlink l f = System.symlink l (Fspath.toString f)
let readlink f = System.readlink (Fspath.toString f)
let chown f usr grp = System.chown (Fspath.toString f) usr grp
let chmod f mode = System.chmod (Fspath.toString f) mode
let utimes f t1 t2 = System.utimes (Fspath.toString f) t1 t2
let unlink f = System.unlink (Fspath.toString f)
let rmdir f = System.rmdir (Fspath.toString f)
let mkdir f mode = System.mkdir (Fspath.toString f) mode
let rename f f' = System.rename (Fspath.toString f) (Fspath.toString f')
let stat f = System.stat (Fspath.toString f)
let lstat f = System.lstat (Fspath.toString f)
let openfile f flags perms = System.openfile (Fspath.toString f) flags perms
let opendir f = System.opendir (Fspath.toString f)
let open_in_gen flags mode f =
System.open_in_gen flags mode (Fspath.toString f)
let open_out_gen flags mode f =
System.open_out_gen flags mode (Fspath.toString f)
(****)
let open_in_bin f = open_in_gen [Open_rdonly; Open_binary] 0 f
let file_exists f =
try
ignore (stat f); true
with Unix.Unix_error ((Unix.ENOENT | Unix.ENOTDIR), _, _) ->
false
(****)
let fingerprint f = System.fingerprint (Fspath.toString f)
let canSetTime f = System.canSetTime (Fspath.toString f)
let hasInodeNumbers () = System.hasInodeNumbers ()
let setUnicodeEncoding = System.setUnicodeEncoding
unison-2.48.3/fs.mli 000644 000766 000000 00000000355 12450317305 015154 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/fs.mli *)
(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
(* Operations on fspaths *)
include System_intf.Core with type fspath = Fspath.t
val setUnicodeEncoding : bool -> unit
unison-2.48.3/fsmonitor/ 000755 000766 000000 00000000000 12467142517 016067 5 ustar 00bcpierce wheel 000000 000000 unison-2.48.3/fsmonitor.py 000755 000766 000000 00000057516 12010241567 016447 0 ustar 00bcpierce wheel 000000 000000 #!/usr/bin/python
# a small program to test the possibilities to monitor the file system and
# log changes on Windowsm Linux, and OSX
#
# Originally written by Christoph Gohle (2010)
# Modified by Gene Horodecki for Windows
# Further modified by Benjamin Pierce
# should be distributed under GPL
import sys
import os
import stat
import threading
from optparse import OptionParser
from time import time, sleep
def mydebug(fmt, *args, **kwds):
if not op.debug:
return
if args:
fmt = fmt % args
elif kwds:
fmt = fmt % kwds
print >>sys.stderr, fmt
def mymesg(fmt, *args, **kwds):
if not op.verbose:
return
if args:
fmt = fmt % args
elif kwds:
fmt = fmt % kwds
print >>sys.stdout, fmt
def timer_callback(timer, streamRef):
mydebug("CFAbsoluteTimeGetCurrent() => %.3f", CFAbsoluteTimeGetCurrent())
mydebug("FSEventStreamFlushAsync(streamRef = %s)", streamRef)
FSEventStreamFlushAsync(streamRef)
def update_changes(result):
mydebug('Update_changes: absresult = %s',result)
#print('absresult',result)
result = [mangle_filename(path) for path in result]
mydebug('Update_changes: mangled = %s',result)
#print('magnled', result)
result = [relpath(op.root,path) for path in result]
#print('relative to root',result)
mydebug('Update_changes: relative to root = %s',result)
try:
f = open(op.absoutfile,'a')
for path in result:
f.write(path+'\n')
f.close()
except IOError:
mymesg('failed to open log file %s for writing',op.outfile)
def update_changes_nomangle(result):
# In win32 there are no symlinks, therefore file mangling
# is not required
# remove root from the path:
result = relpath(op.root,result)
mydebug('Changed paths: %s\n',result)
try:
# Windows hack: open in binary mode
f = open(op.absoutfile,'ab')
f.write(result+'\n')
f.close()
except IOError:
mymesg('failed to open log file %s for writing',op.outfile)
def mangle_filename(path):
"""because the FSEvents system returns 'real' paths we have to figure out
if they have been aliased by a symlink and a 'follow' directive in the unison
configuration or from the command line.
This is done here for path. The return value is the path name using symlinks
"""
try:
op.symlinks
except AttributeError:
make_symlinks()
#now lets do it
result = path
for key in op.symlinks:
#print path, key
if path.startswith(key):
result = os.path.join(op.root,os.path.join(op.symlinks[key]+path[len(key):]))
#print 'Match!', result
return result
def make_symlinks():
#lets create a dictionary of symlinks that are treated transparently here
op.symlinks = {}
fl = op.follow
try:
foll = [f.split(' ',1) for f in fl]
except TypeError:
foll = []
for k,v in foll:
if not k=='Path':
mymesg('We don\'t support anything but path specifications in follow directives. Especially not %s',k)
else:
p = v.strip('{}')
if not p[-1]=='/':
p+='/'
op.symlinks[os.path.realpath(os.path.join(op.root,p))]=p
mydebug('make_symlinks: symlinks to follow %s',op.symlinks)
def relpath(root,path):
"""returns the path relative to root (which should be absolute)
if it is not a path below root or if root is not absolute it returns None
"""
if not os.path.isabs(root):
return None
abspath = os.path.abspath(path)
mydebug('relpath: abspath(%s) = %s', path, abspath)
# make sure the root and abspath both end with a '/' or '\'
if sys.platform == 'win32':
slash = '\\'
else:
slash = '/'
if not root[-1]==slash:
root += slash
if not abspath[-1]==slash:
abspath += slash
mydebug('relpath: root = %s', root)
#print root, abspath
if not abspath[:len(root)]==root:
#print abspath[:len(root)], root
return None
mydebug('relpath: relpath = %s',abspath[len(root):])
return abspath[len(root):]
def my_abspath(path):
"""expand path including shell variables and homedir
to the absolute path
"""
return os.path.abspath(os.path.expanduser(os.path.expandvars(path)))
def update_follow(path):
""" tries to find a follow directive that matches path
and if path refers to a symbolic link the real path of the symbolic
link is returned. """
try:
op.symlinks
except AttributeError:
make_symlinks()
rpath = relpath(op.root, path)
mydebug('update_follow: rpath %s', rpath)
result = None
foll = None
for k in op.symlinks:
v = op.symlinks[k]
if v==rpath:
result = os.path.realpath(os.path.abspath(path))
foll = v
mydebug('update_follow: link %s, real %s',v,result)
break
if result:
op.symlinks[result] = foll
return result, foll
def conf_parser(conffilepath, delimiter = '=', dic = {}):
"""parse the unison configuration file at conffilename and populate a dictionary
with configuration options from there. If dic is a dictionary, these options are added to this
one (can be used to recursively call this function for include statements)."""
try:
conffile = open(conffilepath,'r')
except IOError:
mydebug('could not open configuration file at %s',conffilepath)
return None
res = dic
for line in conffile:
line = line.strip()
if len(line)<1 or line[0]=='#':
continue
elif line.startswith('include'):
dn = os.path.dirname(conffilepath)
fn = line.split()[1].strip()
conf_parser(os.path.join(dn,fn), dic = res)
else:
k,v=[s.strip() for s in line.split('=',1)]
if res.has_key(k):
res[k].append(v)
else:
res[k]=[v]
return res
################################################
# Linux specific code here
################################################
if sys.platform.startswith('linux'):
import pyinotify
class HandleEvents(pyinotify.ProcessEvent):
wm = None
#def process_IN_CREATE(self, event):
# print "Creating:", event.pathname
#def process_IN_DELETE(self, event):
# print "Removing:", event.pathname
#def process_IN_MODIFY(self, event):
# print "Modifying:", event.pathname
# def process_IN_MOVED_TO(self, event):
# print "Moved to:", event.pathname
# def process_IN_MOVED_FROM(self, event):
# print "Moved from:", event.pathname
# def process_IN_ATTRIB(self, event):
# print "attributes:", event.pathname
def process_default(self, event):
mydebug('process_default: event %s', event)
# code for adding dirs is obsolete since there is the auto_add option
# if event.dir:
# if event.mask&pyinotify.IN_CREATE:
# print 'create:', event.pathname , self.add_watch(event.pathname,rec=True)
# elif event.mask&pyinotify.IN_DELETE:
# print 'remove', event.pathname, self.remove_watch(event.pathname)
# pass
# elif event.mask&pyinotify.IN_MOVED_FROM:
# print 'move from', event.pathname, self.remove_watch(event.pathname, rec=True)
# pass
# elif event.mask&pyinotify.IN_MOVED_TO:
# print 'move to', event.pathname, self.add_watch(event.pathname,rec=True)
# else:
# pass
#handle creation of links that should be followed
if os.path.islink(event.pathname):
#special handling for links
mydebug('process_default: link %s created/changed. Checking for follows', event.pathname)
p, l = update_follow(event.pathname)
if p:
self.add_watch(p,rec=True,auto_add=True)
mydebug('process_default: follow link %s to %s',l,p)
#TODO: should handle deletion of links that are followed (delete the respective watches)
update_changes([event.pathname])
def remove_watch(self, pathname, **kwargs):
if self.watches.has_key(pathname):
return self.wm.rm_watch(self.watches.pop(pathname),**kwargs)
return None
def add_watch(self, pathname, **kwargs):
neww = self.wm.add_watch(pathname, self.mask, **kwargs)
self.watches.update(neww)
return neww
def init_watches(self, abspaths, follows):
self.watches = {}
for abspath in abspaths:
self.watches.update(self.wm.add_watch(abspath,self.mask,rec=True,auto_add=True))
#we have to add watches for follow statements since pyinotify does
#not do recursion across symlinks
make_symlinks()
for link in op.symlinks:
mydebug('following symbolic link %s',link)
if not self.watches.has_key(link):
self.watches.update(self.wm.add_watch(link,self.mask,rec=True,auto_add=True))
mydebug('init_watches: added paths %s\n based on paths %s\n and follows %s',self.watches,op.abspaths, op.follow)
def linuxwatcher():
p = HandleEvents()
wm = pyinotify.WatchManager() # Watch Manager
p.wm = wm
p.mask = pyinotify.IN_CREATE | pyinotify.IN_DELETE | pyinotify.IN_MODIFY | pyinotify.IN_ATTRIB | pyinotify.IN_MOVED_TO | pyinotify.IN_MOVED_FROM # watched events
notifier = pyinotify.Notifier(wm, p)
p.init_watches(op.abspaths, op.follow)
notifier.loop()
#################################################
# END Linux specific code
#################################################
#################################################
# MacOsX specific code
#################################################
if sys.platform == 'darwin':
from FSEvents import *
import objc
def filelevel_approx(path):
"""in order to avoid scanning the entire directory including sub
directories by unison, we have to say which files have changed. Because
this is a stupid program it only checks modification times within the
update interval. in case there are no files modified in this interval,
the entire directory is listed.
A deleted file can not be found like this. Therefore also deletes will
trigger a rescan of the directory (including subdirs)
The impact of rescans could be limited if one could make
unison work nonrecursively.
"""
result = []
#make a list of all files in question (all files in path w/o dirs)
try:
names = os.listdir(path)
except os.error, msg:
#path does not exist (anymore?). Add it to the results
mydebug("adding nonexisting path %s for sync",path)
result.append(path)
names = None
if names:
for nm in names:
full_path = os.path.join(path,nm)
st = os.lstat(full_path)
#see if the dir it was modified recently
if st.st_mtime>time()-float(op.latency):
result.append(full_path)
if result == []:
result.append(path)
return result
def fsevents_callback(streamRef, clientInfo, numEvents, eventPaths, eventMasks, eventIDs):
mydebug("fsevents_callback(streamRef = %s, clientInfo = %s, numEvents = %s)", streamRef, clientInfo, numEvents)
mydebug("fsevents_callback: FSEventStreamGetLatestEventId(streamRef) => %s", FSEventStreamGetLatestEventId(streamRef))
mydebug("fsevents_callback: eventpaths = %s",eventPaths)
full_path = clientInfo
result = []
for i in range(numEvents):
path = eventPaths[i]
if path[-1] == '/':
path = path[:-1]
if eventMasks[i] & kFSEventStreamEventFlagMustScanSubDirs:
recursive = True
elif eventMasks[i] & kFSEventStreamEventFlagUserDropped:
mymesg("BAD NEWS! We dropped events.")
mymesg("Forcing a full rescan.")
recursive = 1
path = full_path
elif eventMasks[i] & kFSEventStreamEventFlagKernelDropped:
mymesg("REALLY BAD NEWS! The kernel dropped events.")
mymesg("Forcing a full rescan.")
recursive = 1
path = full_path
else:
recursive = False
#now we should know what to do: build a file directory list
#I assume here, that unison takes a flag for recursive scans
#JV: commented out (not implemented by Unison)
# if recursive:
# #we have to check all subdirectories
# if isinstance(path,list):
# #we have to check all base paths
# allpathsrecursive = [p + '\tr']
# result.extend(path)
# else:
# result.append(path+'\tr')
# else:
#just add the path
#result.append(path)
#try to find out what has changed
result.extend(filelevel_approx(path))
mydebug('Dirs sent: %s',eventPaths)
#TODO: handle creation/deletion of links that should be followed
update_changes(result)
try:
f = open(op.absstatus,'w')
f.write('last_item = %d'%eventIDs[-1])
f.close()
except IOError:
mymesg('failed to open status file %s', op.absstatus)
def my_FSEventStreamCreate(paths):
mydebug('my_FSEventStreamCreate: selected paths are: %s',paths)
if op.sinceWhen == 'now':
op.sinceWhen = kFSEventStreamEventIdSinceNow
try:
op.symlinks
except AttributeError:
make_symlinks()
for sl in op.symlinks:
#check if that path is already there
found=False
ln = op.symlinks[sl]
for path in paths:
if relpath(op.root,path)==ln:
found = True
break
if not found:
mydebug('my_FSEventStreamCreate: watch followed link %s',ln)
paths.append(os.path.join(op.root,ln))
streamRef = FSEventStreamCreate(kCFAllocatorDefault,
fsevents_callback,
paths, #will this pass properly through? yes it does.
paths,
int(op.sinceWhen),
float(op.latency),
int(op.flags))
if streamRef is None:
mymesg("ERROR: FSEVentStreamCreate() => NULL")
return None
if op.verbose:
FSEventStreamShow(streamRef)
#print ('my_FSE', streamRef)
return streamRef
def macosxwatcher():
#since when? if it is 'now' try to read state
if op.sinceWhen == 'now':
di = conf_parser(op.absstatus)
if di and di.has_key('last_item'):
#print di['last_item'][-1]
op.sinceWhen = di['last_item'][-1]
#print op.sinceWhen
streamRef = my_FSEventStreamCreate(op.abspaths)
#print streamRef
if streamRef is None:
print('failed to get a Stream')
exit(1)
FSEventStreamScheduleWithRunLoop(streamRef, CFRunLoopGetCurrent(), kCFRunLoopDefaultMode)
startedOK = FSEventStreamStart(streamRef)
if not startedOK:
print("failed to start the FSEventStream")
exit(1)
if op.flush_seconds >= 0:
mydebug("CFAbsoluteTimeGetCurrent() => %.3f", CFAbsoluteTimeGetCurrent())
timer = CFRunLoopTimerCreate(None,
CFAbsoluteTimeGetCurrent() + float(op.flush_seconds),
float(op.flush_seconds),
0, 0, timer_callback, streamRef)
CFRunLoopAddTimer(CFRunLoopGetCurrent(), timer, kCFRunLoopDefaultMode)
try:
CFRunLoopRun()
except KeyboardInterrupt:
mydebug('stop called via Keyboard, cleaning up.')
#Stop / Invalidate / Release
FSEventStreamStop(streamRef)
FSEventStreamInvalidate(streamRef)
FSEventStreamRelease(streamRef)
mydebug('FSEventStream closed')
#################################################
# END MacOsX specific code
#################################################
#################################################
# Windows specific code
#################################################
if sys.platform == 'win32':
import win32file
import win32con
FILE_LIST_DIRECTORY = 0x0001
def win32watcherThread(abspath,file_lock):
dirHandle = win32file.CreateFile (
abspath,
FILE_LIST_DIRECTORY,
win32con.FILE_SHARE_READ | win32con.FILE_SHARE_WRITE,
None,
win32con.OPEN_EXISTING,
win32con.FILE_FLAG_BACKUP_SEMANTICS,
None
)
while 1:
results = win32file.ReadDirectoryChangesW (
dirHandle,
1024,
True,
win32con.FILE_NOTIFY_CHANGE_FILE_NAME |
win32con.FILE_NOTIFY_CHANGE_DIR_NAME |
win32con.FILE_NOTIFY_CHANGE_ATTRIBUTES |
win32con.FILE_NOTIFY_CHANGE_SIZE |
win32con.FILE_NOTIFY_CHANGE_LAST_WRITE |
win32con.FILE_NOTIFY_CHANGE_SECURITY,
None,
None
)
for action, file in results:
full_filename = os.path.join (abspath, file)
# This will return 'dir updated' for every file update within dir, but
# we don't want to send unison on a full dir sync in this situation.
if not (os.path.isdir(full_filename) and action == 3):
file_lock.acquire()
update_changes_nomangle(full_filename)
file_lock.release()
def win32watcher():
file_lock = threading.Lock()
threads = [ threading.Thread(target=win32watcherThread,args=(abspath,file_lock,)) for abspath in op.abspaths ]
for thread in threads:
thread.setDaemon(True)
thread.start()
try:
while 1:
sleep(3600)
except KeyboardInterrupt:
print "Cleaning up."
#################################################
# END Windows specific code
#################################################
if __name__=='__main__':
global op
usage = """usage: %prog [options] root [path] [path]...
This program monitors file system changes on all given (relative to root) paths
and dumps paths (relative to root) files to a file. When launched, this file is
recreated. While running new events are added. This can be read by UNISON
to trigger a sync on these files. If root is a valid unison profile, we attempt
to read all the settings from there."""
parser = OptionParser(usage=usage)
parser.add_option("-w", "--sinceWhen", dest="sinceWhen",
help="""starting point for filesystem updates to be captured
Defaults to 'now' in the first run
or the last caputured change""",default = 'now', metavar="SINCEWHEN")
parser.add_option("-l", "--latency", dest="latency",
help="set notification LATENCY in seconds. default 5",default = 5, metavar="LATENCY")
parser.add_option("-f", "--flags", dest="flags",
help="(macosx) set flags (who knows what they mean. defaults to 0",default = 0, metavar="FLAGS")
parser.add_option("-s", "--flushseconds", dest="flush_seconds",
help="(macosx) TIME interval in second until flush is forced. values < 0 turn it off. ",default = 1, metavar="TIME")
parser.add_option("-o", "--outfile", dest="outfile",
help="location of the output file. Defaults to UPATH/changes",default = 'changes', metavar="PATH")
parser.add_option("-t", "--statefile", dest="statefile",
help="(macosx) location of the state file (absolute or relative to UPATH). Defaults to UPATH/state",default = 'state', metavar="PATH")
parser.add_option("-u", "--unisonconfig", dest="uconfdir",
help='path to the unison config directory. default ~/.unison',
default = '~/.unison', metavar = 'UPATH')
parser.add_option("-z", "--follow", dest="follow",
help="define a FOLLOW directive. This is equivalent to the -follow option in unison \
(except that for now only 'Paths' are supported). This option can appear multiple times. \
if a unison configuration file is loaded, it takes precedence over this option",
action='append',metavar = 'FOLLOW')
parser.add_option("-q", "--quiet",
action="store_false", dest="verbose", default=True,
help="don't print status messages to stdout")
parser.add_option("-d", "--debug",
action="store_true", dest="debug", default=False,
help="print debug messages to stderr")
(op, args) = parser.parse_args()
if len(args)<1:
parser.print_usage()
sys.exit()
#other paths
op.absuconfdir = my_abspath(op.uconfdir)
op.absstatus = os.path.join(op.absuconfdir,op.statefile)
op.absoutfile = os.path.join(op.absuconfdir,op.outfile)
#figure out if the root argument is a valid configuration file name
p = args[0]
fn = ''
if os.path.exists(p) and not os.path.isdir(p):
fn = p
elif os.path.exists(os.path.join(op.absuconfdir,p)):
fn = os.path.join(op.absuconfdir,p)
op.unison_conf = conf_parser(fn)
#now check for the relevant information
root = None
paths = None
if op.unison_conf and op.unison_conf.has_key('root'):
#find the local root
root = None
paths = None
for r in op.unison_conf['root']:
if r[0]=='/':
root = r
if op.unison_conf.has_key('path'):
paths = op.unison_conf['path']
if op.unison_conf and op.unison_conf.has_key('follow'):
op.follow = op.unison_conf['follow']
else:
#see if follows were defined
try:
op.follow
except AttributeError:
op.follow = []
if not root:
#no root up to here. get it from args
root = args[0]
if not paths:
paths = args[1:]
#absolute paths
op.root = my_abspath(root)
op.abspaths = [os.path.join(root,path) for path in paths]
if op.abspaths == []:
#no paths specified -> make root the path to observe
op.abspaths = [op.root]
#print op.root
#print op.abspaths
mydebug('options: %s',op)
mydebug('arguments: %s',args)
#cleaning up the change file
try:
f=open(op.absoutfile,'w')
f.close()
except IOError:
mymesg('failed to open output file. STOP.')
exit(1)
#stop watching when stdin is closed
def exitThread():
while sys.stdin.readline(): pass
os._exit(0)
t = threading.Thread(target=exitThread)
t.setDaemon(True)
t.start()
if sys.platform=='darwin':
macosxwatcher()
elif sys.platform.startswith('linux'):
linuxwatcher()
elif sys.platform.startswith('win32'):
win32watcher()
else:
mymesg('unsupported platform %s',sys.platform)
unison-2.48.3/fspath.ml 000644 000766 000000 00000032256 12450317305 015665 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/fspath.ml *)
(* Copyright 1999-2015, 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 *)
(* - *)
module Fs = System_impl.Fs
let debug = Util.debug "fspath"
let debugverbose = Util.debug "fsspath+"
type t = Fspath of string
let toString (Fspath f) = f
let toPrintString (Fspath f) = f
let toDebugString (Fspath f) = String.escaped f
let toSysPath (Fspath f) = System.fspathFromString f
(* Needed to hack around some ocaml/Windows bugs, see comment at stat, below *)
let winRootRx = Rx.rx "(([a-zA-Z]:)?/|//[^/]+/[^/]+/)"
(* 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 else
let i2 = len2-n in
if i2<0 then n 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 =
if n > len then f else
try
let n' = String.rindex_from f (len-n) '/' in
String.sub f (n'+1) (len-n'-1)
with Not_found -> 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
try
let i = 1 + String.rindex f '/' in
let res = String.create (len + 2) in
String.blit f 0 res 0 i;
res.[i] <- '.';
res.[i + 1] <- '_';
String.blit f i res (i + 2) (len - i);
Fspath res
with Not_found ->
assert false
let rsrc (Fspath f) =
if isRootDir f then raise(Invalid_argument "Fspath.rsrc") 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
*)
(* 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 = Fs.getcwd() in
try
let newp =
(Fs.chdir p; (* This might raise Sys_error *)
Fs.getcwd()) in
Fs.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 Fs.chdir parent with
Sys_error why2 -> raise (Util.Fatal (Printf.sprintf
"Cannot find canonical name of %s: unable to cd either to it\n
(%s)\nor to its parent %s\n(%s)" p why parent why2)));
Fs.getcwd() end in
Fs.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 maxlinks = 100
let findWorkingDir fspath path =
let abspath = toString (concat fspath path) in
let realpath =
if not (Path.followLink path) then abspath else
let rec followlinks n p =
if n>=maxlinks then
raise
(Util.Transient (Printf.sprintf
"Too many symbolic links from %s" abspath));
try
let link = Fs.readlink p in
let linkabs =
if Filename.is_relative link then
Fs.fspathConcat (Fs.fspathDirname 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)
let quotes (Fspath f) = Uutil.quotes f
let compare (Fspath f1) (Fspath f2) = compare f1 f2
unison-2.48.3/fspath.mli 000644 000766 000000 00000002401 12450317305 016023 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/fspath.mli *)
(* Copyright 1999-2015, 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 toPrintString : t -> string
val toDebugString : t -> string
val toSysPath : t -> System.fspath
(* If fspath+path refers to a (followed) symlink, then return the directory *)
(* of the symlink's target; otherwise return the parent dir of path. If *)
(* 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
(* Escaped fspath (to pass as shell parameter) *)
val quotes : t -> string
(* CASE-SENSITIVE comparison between fspaths *)
val compare : t -> t -> int
unison-2.48.3/fswatch.ml 000644 000766 000000 00000032544 12450317305 016037 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/fswatch.ml *)
(* Copyright 1999-2015, 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 .
*)
(*
Protocol description
====================
The file monitoring process receives commands from stdin and
responds to stdout. Commands and responds are single lines composed
of an identifier followed by a single space and a space separated
list of arguments. Arguments are percent-encoded. At the minimum,
spaces and newlines must be escaped. The two processes should accept
any other escaped character.
Unison and the child process starts by indicating the protocol
version they support. At the moment, they should just output the
line 'VERSION 1'.
Debugging is enabled by the 'DEBUG' command.
At any time, the child process can signal an error by sending an
"ERROR msg" message.
When Unison start scanning a part of the replica, it emits command:
'START hash fspath path', thus indicating the archive hash (that
uniquely determines the replica) the replica's fspath and the path
where the scanning process starts. The child process should start
monitoring this location, then acknowledge the command by sending an
'OK' response.
When Unison starts scanning a directory, it emits the command
'DIR path1', where 'path1' is relative to the path given by the
START command (the location of the directory can be obtained by
concatenation of 'fspath', 'path', and 'path1'). The child process
should then start monitoring the directory, before sending an 'OK'
response.
When Unison encounters a followed link, it emits the command
'LINK path1'. The child process is expected to start monitoring
the link target before replying by 'OK'.
Unison signals that it is done scanning the part of the replica
described by the START process by emitting the 'DONE' command. The
child process should not respond to this command.
Unison can ask for a list of paths containing changes in a given
replica by sending the 'CHANGES hash' command. The child process
responds by a sequence of 'RECURSIVE path' responses, followed by a
'DONE' response. These paths should be relative to the replica
'fspath'. The child process will not have to report this changes any
more: it can consider that Unison has taken this information into
account once and for all. Thus, it is expected to thereafter report
only further changes.
Unison can wait for changes in a replica by emitting a 'WAIT hash'
command. It can watch several replicas by sending a serie of these
commands. The child process is expected to respond once, by a
'CHANGE hash1 ... hash2' response that lists the changed replicas
among those included in a 'WAIT' command, when changes are
available. It should cancel pending waits when any other command is
received.
Finally, the command 'RESET hash' tells the child process to stop
watching the given replica. In particular, it can discard any
pending change information for this replica.
*)
let debug = Util.debug "fswatch"
let debugverbose = Trace.debug "fswatch+"
let (>>=) = Lwt.bind
let rec really_write o s pos len =
Lwt_unix.write o s pos len >>= fun l ->
if l = len then
Lwt.return ()
else
really_write o s (pos + l) (len - l)
let split_on_space s =
try
let i = String.index s ' ' in
(String.sub s 0 i,
String.sub s (i + 1) (String.length s - i - 1))
with Not_found ->
(s, "")
let disallowed_char c =
match c with
'A'..'Z' | 'a'..'z' | '0'..'9' | '-' | '_' | '.' | '~'
| '!' | '*' | '\'' | '(' | ')' | ';' | ':' | '@' | '&'
| '=' | '+' | '$' | ',' | '/' | '?' | '#' | '[' | ']' ->
false
| _ ->
true
let quote s =
let l = String.length s in
let n = ref 0 in
for i = 0 to l - 1 do if disallowed_char s.[i] then incr n done;
if !n = 0 then s else begin
let q = String.create (l + 2 * !n) in
let j = ref 0 in
let hex = "0123456789ABCDEF" in
for i = 0 to l - 1 do
let c = s.[i] in
if disallowed_char s.[i] then begin
q.[!j] <- '%';
q.[!j + 1] <- hex.[Char.code c lsr 4];
q.[!j + 2] <- hex.[Char.code c land 15];
j := !j + 3
end else begin
q.[!j] <- c;
incr j
end
done;
q
end
let unquote s =
let l = String.length s in
let n = ref 0 in
for i = 0 to l - 1 do if s.[i] = '%' then incr n done;
if !n = 0 then s else begin
let hex_char c =
match c with
'0'..'9' -> Char.code c - Char.code '0'
| 'a'..'f' -> Char.code c - Char.code 'a' + 10
| 'A'..'F' -> Char.code c - Char.code 'A' + 10
| _ -> invalid_arg "unquote"
in
let u = String.create (l - 2 * !n) in
let j = ref 0 in
for i = 0 to l - 2 * !n - 1 do
let c = s.[!j] in
if c = '%' then begin
u.[i] <- Char.chr ((hex_char s.[!j + 1]) lsl 4 + hex_char s.[!j + 2]);
j := !j + 3
end else begin
u.[i] <- c;
incr j
end
done;
u
end
module Cond = struct
type t = unit Lwt.t list ref
let make () = ref []
let signal s =
let wl = !s in
s := [];
List.iter (fun w -> Lwt.wakeup w ()) wl
let wait s =
let t = Lwt.wait () in
s := t :: !s;
t
end
(****)
let useWatcher =
Prefs.createBool "watch" true
"!when set, use a file watcher process to detect changes"
"Unison uses a file watcher process, when available, to detect filesystem \
changes; this is used to speed up update detection, and for continuous \
synchronization (\\verb|-repeat watch| preference. Setting this flag to \
false disable the use of this process."
let printf o fmt =
Printf.ksprintf
(fun s ->
debugverbose (fun () -> Util.msg "<< %s" s);
Util.convertUnixErrorsToFatal
"sending command to filesystem watcher"
(fun () -> Lwt_unix.run (really_write o s 0 (String.length s))))
fmt
let read_line i =
let b = Buffer.create 160 in
let buf = String.create 160 in
let start = ref 0 in
let last = ref 0 in
let rec read () =
begin
if !start = !last then begin
Lwt_unix.read i buf 0 160 >>= fun l ->
if l = 0 then
raise (Util.Fatal "Filesystem watcher died unexpectively");
start := 0; last := l;
Lwt.return ()
end else
Lwt.return ()
end >>= fun () ->
try
let i = String.index_from buf !start '\n' in
if i >= !last then raise Not_found;
Buffer.add_substring b buf !start (i - !start);
start := i + 1;
let s = Buffer.contents b in
Buffer.clear b;
debugverbose (fun() -> Util.msg ">> %s\n" s);
Lwt.return s
with Not_found ->
Buffer.add_substring b buf !start (!last - !start);
start := 0; last := 0;
read ()
in
read
(****)
let path =
List.map System.fspathFromString
(try
Str.split (Str.regexp (if Util.osType = `Win32 then ";" else ":"))
(Sys.getenv "PATH")
with Not_found ->
[])
let search_in_path ?(path = path) name =
System.fspathConcat
(List.find (fun dir -> System.file_exists (System.fspathConcat dir name))
path)
name
let exec_path = [System.fspathFromString Sys.executable_name]
(*
try
(* Linux *)
[System.fspathFromString (Unix.readlink "/proc/self/exe")]
with Unix.Unix_error _ | Invalid_argument _ ->
let name = (System.argv ()).(0) in
if not (Filename.is_relative name) then
[System.fspathFromString name]
else if Filename.is_implicit name then
try
[search_in_path name]
with Not_found ->
[]
else
[System.fspathConcat (System.getcwd ()) name]
*)
let exec_dir = List.map System.fspathDirname exec_path
let watcher =
lazy
(let suffix = if Util.osType = `Win32 then ".exe" else "" in
System.fspathToString
(try
search_in_path ~path:(exec_dir @ path)
("unison-fsmonitor-" ^ Uutil.myMajorVersion ^ suffix)
with Not_found ->
search_in_path ~path:(exec_dir @ path)
("unison-fsmonitor" ^ suffix)))
type 'a exn_option = Value of 'a | Exn of exn | Nothing
type conn =
{ output : Lwt_unix.file_descr;
has_changes : Cond.t;
has_line : Cond.t;
line_read : Cond.t;
mutable last_line : string exn_option }
let conn = ref None
let rec reader conn read_line =
read_line () >>= fun l ->
Cond.signal conn.has_changes;
if fst (split_on_space l) = "CHANGES" then begin
reader conn read_line
end else begin
conn.last_line <- Value l;
Cond.signal conn.has_line;
Cond.wait conn.line_read >>= fun () ->
reader conn read_line
end
let safeClose fd = try Lwt_unix.close fd with Unix.Unix_error _ -> ()
let currentConnection () =
match !conn with
Some c -> c
| None -> raise (Util.Fatal ("File monitoring helper program not running"))
let closeConnection () =
match !conn with
Some c -> conn := None; safeClose c.output
| None -> ()
let connected () = !conn <> None
let startProcess () =
try
let w = Lazy.force watcher in
let (i1,o1) = Lwt_unix.pipe_out () in
let (i2,o2) = Lwt_unix.pipe_in () in
Lwt_unix.set_close_on_exec i2;
Lwt_unix.set_close_on_exec o1;
Util.convertUnixErrorsToFatal "starting filesystem watcher" (fun () ->
ignore (System.create_process w [|w|] i1 o2 Unix.stderr));
Unix.close i1; Unix.close o2;
let c =
{ output = o1;
has_changes = Cond.make ();
has_line = Cond.make ();
line_read = Cond.make ();
last_line = Nothing }
in
ignore
(Lwt.catch (fun () -> reader c (read_line i2))
(fun e ->
closeConnection (); safeClose i2;
Cond.signal c.has_changes;
c.last_line <- Exn e; Cond.signal c.has_line;
Lwt.return ()));
conn := Some c;
true
with Not_found ->
false
let emitCmd fmt =
let c = currentConnection () in
try
printf c.output fmt
with e ->
closeConnection ();
raise e
let rec readLine () =
let c = currentConnection () in
match c.last_line with
Nothing -> Lwt_unix.run (Cond.wait c.has_line); readLine ()
| Value l -> c.last_line <- Nothing; Cond.signal c.line_read; l
| Exn e -> raise e
let badResponse cmd args expected =
closeConnection ();
if cmd = "ERROR" then
raise (Util.Fatal ("Filesystem watcher error: " ^ (unquote args) ^ "\n\
The watcher can be disabled by setting preference \
'watch' to false"))
else
raise
(Util.Fatal
(Format.sprintf
"Unexpected response '%s %s' from the filesystem watcher \
(expected %s)" cmd args expected))
let readAck () =
let (cmd, args) = split_on_space (readLine ()) in
if cmd <> "OK" then badResponse cmd args "OK"
let readVersion () =
let (cmd, args) = split_on_space (readLine ()) in
if cmd <> "VERSION" then badResponse cmd args "VERSION"
let exchangeVersions () =
let res = startProcess () in
if res then begin
emitCmd "VERSION 1\n";
debug (fun () -> Util.msg "debugging enabled\n"; emitCmd "DEBUG\n");
readVersion ()
end;
res
(****)
type archiveHash = string
let scanning = ref false
let start_path = ref ""
let relpath path =
let s2 = Path.toString path in
let l1 = String.length !start_path in
let l2 = String.length s2 in
if l1 = 0 then begin
s2
end else if l1 = l2 then begin
assert (s2 = !start_path);
""
end else begin
assert
((l2 >= l1 + 1) && String.sub s2 0 l1 = !start_path && s2.[l1] = '/');
String.sub s2 (l1 + 1) (l2 - l1 - 1)
end
let startScanning hash fspath path =
if connected () then begin
emitCmd "START %s %s %s\n"
(quote hash)
(quote (Fspath.toString fspath)) (quote (Path.toString path));
readAck ();
scanning := true;
start_path := Path.toString path
end
let scanDirectory path =
if !scanning then begin
emitCmd "DIR %s\n" (quote (relpath path));
readAck ()
end
let followLink path =
if !scanning then begin
emitCmd "LINK %s\n" (quote (relpath path));
readAck ()
end
let stopScanning () =
if !scanning then begin
scanning := false;
emitCmd "DONE\n"
end
let start hash =
if not (Prefs.read useWatcher) then
false
else if not (connected ()) then
exchangeVersions ()
else begin
emitCmd "RESET %s\n" (quote hash);
true
end
let wait hash =
let c = currentConnection () in
let res = Cond.wait c.has_changes in
emitCmd "WAIT %s\n" (quote hash);
res
(****)
let rec parseChanges l =
let (cmd, args) = split_on_space (readLine ()) in
match cmd with
"CHANGES" ->
parseChanges l
| "RECURSIVE" ->
parseChanges (Path.fromString (unquote args) :: l)
| "DONE" ->
List.rev l
| other ->
badResponse other args "RECURSIVE or DONE"
let getChanges hash =
if connected () then begin
emitCmd "CHANGES %s\n" (quote hash);
parseChanges []
end else
raise (Util.Fatal "No file monitoring helper program found")
unison-2.48.3/fswatch.mli 000644 000766 000000 00000000733 12450317305 016203 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/fswatch.mli *)
(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
type archiveHash = string
val start : archiveHash -> bool
val startScanning : archiveHash -> Fspath.t -> Path.local -> unit
val stopScanning : unit -> unit
val scanDirectory : Path.local -> unit
val followLink : Path.local -> unit
val wait : archiveHash -> unit Lwt.t
val getChanges : archiveHash -> Path.t list
(****)
val useWatcher : bool Prefs.t
unison-2.48.3/fswatchold.ml 000644 000766 000000 00000013400 12450317305 016524 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/fswatcherold.ml *)
(* Copyright 1999-2015, 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 .
*)
(* FIX: we should check that the child process has not died and
restart it if so... *)
(* FIX: the names of the paths being watched should get included
in the name of the watcher's state file *)
let debug = Util.debug "fswatch"
let watchinterval = 5
let watcherTemp archHash n = Os.fileInUnisonDir (n ^ archHash)
let watchercmd archHash root =
let fsmonfile =
Filename.concat (Filename.dirname Sys.executable_name) "fsmonitor.py" in
if not (Sys.file_exists fsmonfile) then
None
else begin
(* FIX: is the quoting of --follow parameters going to work on Win32?
(2/2012: tried adding Uutil.quotes -- maybe this is OK now?) *)
(* FIX -- need to find the program using watcherosx preference *)
let changefile = watcherTemp archHash "changes" in
let statefile = watcherTemp archHash "state" in
let paths = Safelist.map Path.toString (Prefs.read Globals.paths) in
let followpaths = Pred.extern Path.followPred in
let follow = Safelist.map
(fun s -> "--follow '" ^ Uutil.quotes s ^ "'")
followpaths in
(* BCP (per Josh Berdine, 5/2012): changed startup command from this...
let cmd = Printf.sprintf "fsmonitor.py %s --outfile %s --statefile %s %s %s\n"
... to this: *)
let cmd = Printf.sprintf "python \"%s\" \"%s\" --outfile \"%s\" --statefile \"%s\" %s %s\n"
fsmonfile
root
(System.fspathToPrintString changefile)
(System.fspathToPrintString statefile)
(String.concat " " follow)
(String.concat " " paths) in
debug (fun() -> Util.msg "watchercmd = %s\n" cmd);
Some (changefile,cmd)
end
module StringSet= Set.Make (String)
module RootMap = Map.Make (String)
type watcherinfo = {file: System.fspath;
mutable ch:Pervasives.in_channel option;
chars: Buffer.t;
mutable lines: string list}
let watchers : watcherinfo RootMap.t ref = ref RootMap.empty
let newWatchers = ref StringSet.empty
let trim_duplicates l =
let rec loop l = match l with
[] -> l
| [s] -> l
| s1::s2::rest ->
if Util.startswith s1 s2 || Util.startswith s2 s1 then
loop (s2::rest)
else
s1 :: (loop (s2::rest)) in
loop (Safelist.sort String.compare l)
let readAvailableLinesFromWatcher wi =
let ch = match wi.ch with Some(c) -> c | None -> assert false in
let rec loop () =
match try Some(input_char ch) with End_of_file -> None with
None ->
()
| Some(c) ->
if c = '\n' then begin
wi.lines <- Buffer.contents wi.chars :: wi.lines;
Buffer.clear wi.chars;
loop ()
end else begin
Buffer.add_char wi.chars c;
loop ()
end in
loop ()
let readChanges wi =
if wi.ch = None then
(* Watcher channel not built yet *)
if System.file_exists wi.file then begin
(* Build it and go *)
let c = System.open_in_bin wi.file in
wi.ch <- Some c;
readAvailableLinesFromWatcher wi;
end else begin
(* Wait for change file to be built *)
debug (fun() -> Util.msg
"Waiting for change file %s\n"
(System.fspathToPrintString wi.file))
end
else
(* Watcher running and channel built: go ahead and read *)
readAvailableLinesFromWatcher wi
let getChanges archHash =
if StringSet.mem archHash !newWatchers then
Fswatch.getChanges archHash
else begin
let wi = RootMap.find archHash !watchers in
readChanges wi;
let res = wi.lines in
wi.lines <- [];
List.map Path.fromString (trim_duplicates res)
end
let start archHash fspath =
if not (Prefs.read Fswatch.useWatcher) then
false
else if Fswatch.start archHash then begin
newWatchers := StringSet.add archHash !newWatchers;
true
end else if not (RootMap.mem archHash !watchers) then begin
(* Watcher process not running *)
match watchercmd archHash (Fspath.toString fspath) with
Some (changefile,cmd) ->
debug (fun() -> Util.msg
"Starting watcher on fspath %s\n"
(Fspath.toDebugString fspath));
let _ = System.open_process_out cmd in
let wi = {file = changefile; ch = None;
lines = []; chars = Buffer.create 80} in
watchers := RootMap.add archHash wi !watchers;
true
| None ->
false
end else begin
(* If already running, discard all pending changes *)
ignore (getChanges archHash);
true
end
let wait archHash =
if StringSet.mem archHash !newWatchers then
Fswatch.wait archHash
else if not (RootMap.mem archHash !watchers) then
raise (Util.Fatal "No file monitoring helper program found")
else begin
let wi = RootMap.find archHash !watchers in
let rec loop () =
readChanges wi;
if wi.lines = [] then begin
debug (fun() -> Util.msg "Sleeping for %d seconds...\n" watchinterval);
Lwt.bind (Lwt_unix.sleep (float watchinterval)) (fun () ->
loop ())
end else
Lwt.return ()
in
loop ()
end
unison-2.48.3/fswatchold.mli 000644 000766 000000 00000000157 12010741735 016702 0 ustar 00bcpierce wheel 000000 000000
val start : string -> Fspath.t -> bool
val getChanges : string -> Path.t list
val wait : string -> unit Lwt.t
unison-2.48.3/globals.ml 000644 000766 000000 00000027550 12450317305 016024 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/globals.ml *)
(* Copyright 1999-2015, 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 (Safelist.rev l)
let rawRoots () = Safelist.rev (Prefs.read rawroots)
let rawRootPair () =
match rawRoots () with
[r1; r2] -> (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 := 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 := !theroots
let roots () =
match !theroots with
[root1;root2] -> (root1,root2)
| _ -> assert false
let rootsList() = !theroots
let rootsInCanonicalOrder() = Common.sortRoots (!theroots)
let localRoot () = List.hd (rootsInCanonicalOrder ())
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.forceLocal 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.makeGlobal (Path.child parent c))
(Os.childrenOf lrfspath parent)
end
| _ -> [Path.makeGlobal 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 ignorePred =
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 ignorenotPred =
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 ignorePred p) && not (Pred.test ignorenotPred p)
let addRegexpToIgnore re =
let oldRE = Pred.extern ignorePred in
let newRE = re::oldRE in
Pred.intern ignorePred 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 "*" ""
let fatFilesystem =
Prefs.createBool "fat" ~local:true false
"use appropriate options for FAT filesystems"
("When this is set to {\\tt true}, Unison will use appropriate options \
to synchronize efficiently and without error a replica located on a \
FAT filesystem on a non-Windows machine: \
do not synchronize permissions ({\\tt perms = 0}); \
never use chmod ({\tt dontchmod = true}); \
treat filenames as case insensitive ({\\tt ignorecase = true}); \
do not attempt to synchronize symbolic links ({\\tt links = false}); \
ignore inode number changes when detecting updates \
({\\tt ignoreinodenumbers = true}). \
Any of these change can be overridden by explicitly setting \
the corresponding preference in the profile.")
unison-2.48.3/globals.mli 000644 000766 000000 00000007616 12450317305 016176 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/globals.mli *)
(* Copyright 1999-2015, 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
val rawRootPair : unit -> string * string
(* 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 a Local root *)
(* comes first *)
val rootsInCanonicalOrder : unit -> Common.root list
(* a local root *)
val localRoot : unit -> Common.root
(* 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
val ignorePred : Pred.t
val ignorenotPred : Pred.t
(* 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
val fatFilesystem : bool Prefs.t
unison-2.48.3/INSTALL 000644 000766 000000 00000000125 11346542164 015073 0 ustar 00bcpierce wheel 000000 000000 For installation instructions, see the the INSTALLATION section of the
user manual.
unison-2.48.3/INSTALL.gtk2 000644 000766 000000 00000003037 10440677010 015737 0 ustar 00bcpierce wheel 000000 000000 We 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.48.3/INSTALL.win32 000644 000766 000000 00000001106 11031221670 016017 0 ustar 00bcpierce wheel 000000 000000 Installation 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.48.3/INSTALL.win32-cygwin-gnuc 000644 000766 000000 00000022225 11346542164 020271 0 ustar 00bcpierce wheel 000000 000000 Installation notes to build Unison on Windows systems, with Cygwin GNU C
(unison-help@cis.upenn.edu)
[The following instructions were tested for Unison 2.32.52 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. Make sure the directory path name has no space in it or
the OCaml compiler will get confused later.
- In the main directory, type "make".
- If a text-only version is desired, build with "make UISTYLE=text"
regardless of whether the graphics libraries are installed or not.
- 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.)
- The text-only version can be run on any system that has cygwin installed:
$ cygcheck ./unison.exe
C:\cygwin\tmp\unison-2.32.52\unison.exe
C:\cygwin\bin\cygwin1.dll
C:\WINDOWS\system32\ADVAPI32.DLL
C:\WINDOWS\system32\KERNEL32.dll
C:\WINDOWS\system32\ntdll.dll
C:\WINDOWS\system32\RPCRT4.dll
C:\WINDOWS\system32\Secur32.dll
- For this to build with a graphical user interface under Cygwin you
need obviously X windows installed, together with some other
not-so-common packages (from Gnome, versions 2.0 as of the time of
this writing):
libgtk2.0-devel: Multi-platform GUI toolkit (development)
liblgtk2: OCaml interface to GTK2
Installing these packages with the Cygwin setup program will force the
installation of a large slew of other gnome and graphics packages.
- Then build Unison with "make UISTYLE=gtk2", or just "make"
since by default "make" builds with a graphics interface if the
necessary graphics libraries are installed.
- The graphics version needs many more libraries to run and hence is a
lot less portable:
$ cygcheck ./unison.exe
C:\cygwin\tmp\unison-2.32.52\unison.exe
C:\cygwin\bin\cygwin1.dll
C:\WINDOWS\system32\ADVAPI32.DLL
C:\WINDOWS\system32\KERNEL32.dll
C:\WINDOWS\system32\ntdll.dll
C:\WINDOWS\system32\RPCRT4.dll
C:\WINDOWS\system32\Secur32.dll
C:\cygwin\bin\cyggdk-x11-2.0-0.dll
C:\cygwin\bin\cyggdk_pixbuf-2.0-0.dll
C:\cygwin\bin\cyggcc_s-1.dll
C:\cygwin\bin\cyggio-2.0-0.dll
C:\cygwin\bin\cygglib-2.0-0.dll
C:\cygwin\bin\cygiconv-2.dll
C:\cygwin\bin\cygintl-8.dll
C:\cygwin\bin\cygpcre-0.dll
C:\cygwin\bin\cyggmodule-2.0-0.dll
C:\cygwin\bin\cyggobject-2.0-0.dll
C:\cygwin\bin\cygX11-6.dll
C:\cygwin\bin\cygxcb-1.dll
C:\cygwin\bin\cygXau-6.dll
C:\cygwin\bin\cygXdmcp-6.dll
C:\cygwin\bin\cygXcomposite-1.dll
C:\cygwin\bin\cygXcursor-1.dll
C:\cygwin\bin\cygXfixes-3.dll
C:\cygwin\bin\cygXrender-1.dll
C:\cygwin\bin\cygXdamage-1.dll
C:\cygwin\bin\cygXext-6.dll
C:\cygwin\bin\cygXi-6.dll
C:\cygwin\bin\cygXinerama-1.dll
C:\cygwin\bin\cygXrandr-2.dll
C:\cygwin\bin\cygcairo-2.dll
C:\cygwin\bin\cygfontconfig-1.dll
C:\cygwin\bin\cygexpat-1.dll
C:\cygwin\bin\cygfreetype-6.dll
C:\cygwin\bin\cygz.dll
C:\cygwin\bin\cygglitz-1.dll
C:\cygwin\bin\cygpixman-1-0.dll
C:\cygwin\bin\cygpng12.dll
C:\cygwin\bin\cygxcb-render-util-0.dll
C:\cygwin\bin\cygxcb-render-0.dll
C:\cygwin\bin\cygpango-1.0-0.dll
C:\cygwin\bin\cygpangocairo-1.0-0.dll
C:\cygwin\bin\cygpangoft2-1.0-0.dll
C:\cygwin\bin\cyggtk-x11-2.0-0.dll
C:\cygwin\bin\cygatk-1.0-0.dll
-------------------------------------------------------------------------
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.48.3/INSTALL.win32-msvc 000644 000766 000000 00000044646 11736345567 017035 0 ustar 00bcpierce wheel 000000 000000 Installation 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 is some general information 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.48.3/linkgtk.ml 000644 000766 000000 00000001425 12450317305 016035 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/linkgtk.ml *)
(* Copyright 1999-2015, 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.48.3/linkgtk2.ml 000644 000766 000000 00000001427 12450317305 016121 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/linkgtk2.ml *)
(* Copyright 1999-2015, 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.48.3/linktext.ml 000644 000766 000000 00000001427 12450317305 016236 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/linktext.ml *)
(* Copyright 1999-2015, 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.48.3/lock.ml 000644 000766 000000 00000003470 12450317305 015324 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/lock.ml *)
(* Copyright 1999-2015, 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 System.link oldFile newFile with Unix.Unix_error _ -> () end;
let res = try (System.stat oldFile).Unix.LargeFile.st_nlink = 2
with Unix.Unix_error _ -> false
in
System.unlink oldFile;
res
let flags = [Unix.O_WRONLY; Unix.O_CREAT; Unix.O_EXCL]
let create name mode =
try
Unix.close (System.openfile name flags mode);
true
with Unix.Unix_error (Unix.EEXIST, _, _) ->
false
let rec unique name i mode =
let nm = System.fspathAddSuffixToFinalName 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 System.unlink name with Unix.Unix_error _ -> ()
let is_locked name =
Util.convertUnixErrorsToTransient
"Lock.test"
(fun () -> System.file_exists name)
unison-2.48.3/lock.mli 000644 000766 000000 00000000525 12450317305 015473 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/lock.mli *)
(* Copyright 1999-2015, 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 : System.fspath -> bool
val release : System.fspath -> unit
val is_locked : System.fspath -> bool
unison-2.48.3/lwt/ 000755 000766 000000 00000000000 12467142517 014655 5 ustar 00bcpierce wheel 000000 000000 unison-2.48.3/main.ml 000644 000766 000000 00000021132 12450317305 015313 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/main.ml *)
(* Copyright 1999-2015, 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 catch_all f =
try
(* Util.msg "Starting catch_all...\n"; *)
f ();
(* Util.msg "Done catch_all...\n"; *)
with e ->
Util.msg "Unison failed: %s\n" (Uicommon.exn2string e); exit 1;;
let init () = begin
ignore (Gc.set {(Gc.get ()) with Gc.max_overhead = 150});
(* Make sure exception descriptions include backtraces *)
Printexc.record_backtrace true;
let argv = Prefs.scanCmdLine Uicommon.usageMsg 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 here 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 -> 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.48.3/Makefile 000644 000766 000000 00000025110 12171733505 015501 0 ustar 00bcpierce wheel 000000 000000 #######################################################################
# $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
.PHONY: all clean install doinstall installtext text \
setupdemo-old setupdemo modifydemo demo \
run runbatch runt rundebug runp runtext runsort runprefer \
prefsdocs runtest repeattest \
selftest selftestdebug selftestremote testmerge \
checkin installremote
.DELETE_ON_ERROR:
# to avoid problems when e.g. mkProjectInfo fails to run
INSTALL: $(NAME)$(EXEC_EXT)
# file isn't made for OS X, so check that it's there first
(if [ -f $(NAME) ]; then ./$(NAME) -doc install > INSTALLATION; fi)
########################################################################
## Miscellaneous developer-only switches
DEBUGGING=true
PROFILING=false
STATIC=false
# NAME, VERSION, and MAJORVERSION, automatically generated
-include Makefile.ProjectInfo
Makefile.ProjectInfo: mkProjectInfo $(wildcard ../.bzr/branch/last-revision)
./mkProjectInfo > $@
mkProjectInfo: mkProjectInfo.ml
ocamlc -o $@ unix.cma str.cma $^
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) NATIVE=false DEBUG=true text
./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:
-if [ -f `which $(ETAGS)` ]; then \
$(ETAGS) *.mli */*.mli *.ml */*.ml */*.m *.c */*.c *.txt \
; fi
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
ifneq ($(strip $(UIMACDIR)),)
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.48.3/Makefile.OCaml 000644 000766 000000 00000032602 12412035705 016472 0 ustar 00bcpierce wheel 000000 000000 ####################################################################
# 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
ifeq ($(shell uname),Linux)
OSARCH=Linux
endif
endif
endif
endif
ETAGS=etags
endif
endif
endif
ifeq (${OSCOMP},cross) # Cross-compilation under Linux
OSARCH=win32gnuc
EXEC_PREFIX=i686-w64-mingw32-
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 -1 | sed -e 's/.* //g' | sed -e 's/\\/\//g' | sed -e 's///g')
# Better(?) version, June 2005:
# OCAMLLIBDIR=$(shell ocamlc -v | tail -1 | sed -e 's/.* //g' | sed -e 's/\\/\//g' | tr -d '\r')
# Another try, Feb 2011, suggested by Ron Isaacson
OCAMLLIBDIR=$(shell ocamlc -v | tail -1 | sed -e 's/.* //g' | tr '\\' '/' | 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 (spiffier)
# UISTYLE=mac14 (even spiffier, 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=mac14
else
ifeq ($(wildcard $(LABLGTK2LIB)),$(LABLGTK2LIB))
UISTYLE=gtk2
else
UISTYLE=text
endif
endif
buildexecutable::
@echo UISTYLE = $(UISTYLE)
####################################################################
### Default parameters
# Generate backtrace information for exceptions
CAMLFLAGS+=-g
INCLFLAGS=-I lwt -I ubase -I system
CAMLFLAGS+=$(INCLFLAGS)
CAMLFLAGS+=-I system/$(SYSTEM) -I lwt/$(SYSTEM)
ifeq ($(OSARCH),win32)
# Win32 system
EXEC_EXT=.exe
OBJ_EXT=.obj
OUTPUT_SEL=/Fo
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
COBJS+=system/system_win_stubs$(OBJ_EXT) lwt/lwt_unix_stubs$(OBJ_EXT)
WINOBJS=system/system_win.cmo
SYSTEM=win
CLIBS+=-cclib "-link win32rc/unison.res" shell32.lib
STATICLIBS+=-cclib "-link win32rc/unison.res" shell32.lib
buildexecutable::
@echo Building for Windows
else
# Unix system, or Cygwin with GNU C compiler
OBJ_EXT=.o
OUTPUT_SEL="-o "
ifeq ($(OSARCH),win32gnuc)
CWD=.
EXEC_EXT=.exe
COBJS+=system/system_win_stubs$(OBJ_EXT) lwt/lwt_unix_stubs$(OBJ_EXT)
WINOBJS=system/system_win.cmo
SYSTEM=win
CLIBS+=-cclib win32rc/unison.res.lib
STATIC=false # Cygwin is not MinGW :-(
buildexecutable::
@echo Building for Windows with Cygwin GNU C
else
CWD=$(shell pwd)
EXEC_EXT=
WINOBJS=
SYSTEM=generic
# openpty is in the libutil library
ifneq ($(OSARCH),solaris)
ifneq ($(OSARCH),osx)
CLIBS+=-cclib -lutil
endif
endif
buildexecutable::
@echo Building for Unix
endif
endif
.PHONY: buildexecutable
buildexecutable::
@echo NATIVE = $(NATIVE)
@echo THREADS = $(THREADS)
@echo STATIC = $(STATIC)
@echo OSTYPE = $(OSTYPE)
@echo OSARCH = $(OSARCH)
ubase/projectInfo.ml: Makefile.ProjectInfo
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
ifeq ($(UISTYLE),mac14)
buildexecutable:: macexecutable
UIMACDIR=uimac14
else
buildexecutable:: $(NAME)$(EXEC_EXT)
endif
endif
endif
MINOSXVERSION=10.5
# XCODEFLAGS=-sdk macosx$(MINOSXVERSION)
ifeq ($(OSARCH),osx)
CAMLFLAGS+=-ccopt -mmacosx-version-min=$(MINOSXVERSION)
endif
# NOTE: the OCAMLLIBDIR is not getting passed correctly?
# The two cases for cltool are needed because Xcode 2.1+
# builds in build/Default/, and earlier versions use build/
.PHONY: macexecutable
macexecutable:
# sed -e's/@@VERSION@@/$(VERSION)/' $(UIMACDIR)/Info.plist.template > $(UIMACDIR)/Info.plist
(cd $(UIMACDIR); xcodebuild $(XCODEFLAGS) OCAMLLIBDIR="$(OCAMLLIBDIR)" SYMROOT=build)
if [ -e $(UIMACDIR)/build/Default ]; then \
gcc -mmacosx-version-min=$(MINOSXVERSION) $(UIMACDIR)/cltool.c -o $(UIMACDIR)/build/Default/Unison.app/Contents/MacOS/cltool -framework Carbon; \
else \
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/rx.cmo \
\
unicode_tables.cmo unicode.cmo bytearray.cmo \
$(WINOBJS) system/system_generic.cmo \
system/$(SYSTEM)/system_impl.cmo \
system.cmo \
\
ubase/projectInfo.cmo ubase/myMap.cmo ubase/safelist.cmo \
ubase/util.cmo ubase/uarg.cmo \
ubase/prefs.cmo ubase/trace.cmo ubase/proplist.cmo \
\
lwt/pqueue.cmo lwt/lwt.cmo lwt/lwt_util.cmo \
lwt/$(SYSTEM)/lwt_unix_impl.cmo lwt/lwt_unix.cmo \
\
uutil.cmo case.cmo pred.cmo \
fileutil.cmo name.cmo path.cmo fspath.cmo fs.cmo fingerprint.cmo \
abort.cmo osx.cmo external.cmo fswatch.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 fswatchold.cmo \
fpcache.cmo update.cmo copy.cmo stasher.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
## New Mac UI, 2014 version
ifeq ($(UISTYLE),mac14)
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
########################################################################
### Filesystem monitoring
ifeq ($(OSARCH),Linux)
-include fsmonitor/linux/Makefile src/fsmonitor/linux/Makefile
endif
ifeq ($(OSARCH),win32gnuc)
-include fsmonitor/windows/Makefile src/fsmonitor/windows/Makefile
endif
INCLFLAGS+=-I fsmonitor -I fsmonitor/linux -I fsmonitor/windows
####################################################################
### Static build setup
ifeq ($(STATIC), true)
CFLAGS+=-cclib -static
endif
####################################################################
### Dependencies
# Include an automatically generated list of dependencies
include .depend
# Additional dependencied depending on the system
system.cmo fspath.cmo fs.cmo: system/$(SYSTEM)/system_impl.cmo
system.cmx fspath.cmx fs.cmx: system/$(SYSTEM)/system_impl.cmx
lwt/lwt_unix.cmo: lwt/$(SYSTEM)/lwt_unix_impl.cmo
lwt/lwt_unix.cmx: lwt/$(SYSTEM)/lwt_unix_impl.cmx
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 */*/*.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=$(EXEC_PREFIX)ocamlcp
else
OCAMLC=$(EXEC_PREFIX)ocamlc
endif
OCAMLOPT=$(EXEC_PREFIX)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: win32rc/unison.rc win32rc/U.ico
windres win32rc/unison.rc win32rc/unison.res
win32rc/unison.res.lib: win32rc/unison.res
windres win32rc/unison.res win32rc/unison.res.lib
%.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) -ccopt $(OUTPUT_SEL)$(CWD)/$@ -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) -dstartup -output-obj -verbose -cclib -keep_private_externs $(CAMLFLAGS) -o u-b.o $(CFLAGS) $(CAMLLIBS) $(CLIBS) $(CAMLOBJS)
$(LD) -r -keep_private_externs -o $@ u-b.o $(COBJS)
$(RM) u-b.o
# Original:
# $(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
-$(RM) system/*.cm[iox] system/*.{o,obj} system/win/*~
-$(RM) system/generic/*.cm[iox] system/generic/*.{o,obj} system/generic/*~
-$(RM) system/win/*.cm[iox] system/win/*.{o,obj} system/win/*~
-$(RM) fsmonitor/*.cm[iox] fsmonitor/*.{o,obj}
.PHONY: paths
paths:
@echo PATH = $(PATH)
@echo OCAMLLIBDIR = $(OCAMLLIBDIR)
unison-2.48.3/mkProjectInfo.ml 000644 000766 000000 00000004030 12450317305 017137 0 ustar 00bcpierce wheel 000000 000000 (* 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 = 48
let pointVersionOrigin = 533 (* 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: 536 $";;
let pointVersion =
Scanf.sscanf revisionString "$Rev: %d " (fun x -> x) - 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.48.3/name.ml 000644 000766 000000 00000003765 12450317305 015323 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/name.ml *)
(* Copyright 1999-2015, 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 = (Case.ops())#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 = (Case.ops())#hash n
let normalize n = (Case.ops())#normalizeFilename n
(****)
let badEncoding s = (Case.ops())#badEncoding s
(* Windows file naming conventions are descripted here:
*)
let badWindowsFilenameRx =
Rx.case_insensitive
(Rx.rx
"(.*[\000-\031<>:\"/\\|?*].*)|\
((con|prn|aux|nul|com[1-9]|lpt[1-9])(\\..*)?)|\
(.*[. ])")
let badWindowsFilenameRelaxedRx =
Rx.case_insensitive (Rx.rx "(con|prn|aux|nul|com[1-9]|lpt[1-9])(\\..*)?")
(* FIX: should also check for a max filename length, not sure how much *)
let badFile s = Rx.match_string badWindowsFilenameRx s
unison-2.48.3/name.mli 000644 000766 000000 00000000514 12450317305 015461 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/name.mli *)
(* Copyright 1999-2015, 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
val normalize : t -> t
val badEncoding : t -> bool
val badFile : t -> bool
unison-2.48.3/NEWS 000644 000766 000000 00000310265 12467142516 014554 0 ustar 00bcpierce wheel 000000 000000
Changes in Version 2.48.3
Changes since 2.45:
* Incorporated a patch from Christopher Zimmermann to replace the
Uprintf module (which doesn't work with OCaml 4.02, causing Unison
to crash) with equivalent functionality from the standard library.
* Incorporated a refresh of the OSX GUI, contributed by Alan Shutko.
* Added a maxsizethreshold option, which prevents the transfer of
files larger than the size specified (in Kb).
* Added a "copyonconflict" preference, to make a copy of files that
would otherwise be overwritten or deleted in case of conflicting
changes. (This makes it possible to automatically resolve conflicts
in a fairly safe way when synchronizing continuously, in
combination with the "repeat = watch" and "prefer = newer"
preferences.
* File system monitoring:
+ The file watcher now fails when unable to watch a directory,
rather than silently ignoring the issue.
+ File system monitoring: more robust communication with the
helper program (in socket mode, the unison server will still
work properly despite unexpected unison client
disconnections).
+ A bytecode version of unison-fsmonitor is now produced by
"make NATIVE=false"
+ Improved search for unison-fsmonitor
+ Detect when the helper process exits.
+ More robust file watching helper programs for Windows and
Linux. They communicate with Unison through pipes (Unison
redirects stdin and stdout), using a race-free protocol.
+ Retries paths with failures using an exponential backoff
algorithm.
+ The information returned by the file watchers are used
independently for each replica; thus, when only one replica
has changes, Unison will only rescan this replica.
+ When available, used by the graphical UIs to speed up
rescanning (can be disabled by setting the new watch
preference to
+ Small fix to the way fsmonitor.py gets invoked when using the
file watching functionality, suggested by Josh Berdine. Unison
will now look for fsmonitor.py in the same directory where the
Unison executable itself lives.
* Minor:
+ Fixed a bug in export procedure that was messing up
documentation strings.
+ Incorporated a patch from Irányossy Knoblauch Artúr to make
temp file names fit within 143 characters (to make eCryptFS
happy).
+ Added a string to the Conflict direction to document the
reason of the conflict.
+ Log conflicts and problems in the text UI even if nothing is
propagated.
+ Use hash function from OCaml 3.x for comparing archives, even
when compiled with OCaml 4.x.
+ Do not restart Unison in case of uncaught exception when the
repeat preference is set. This seems safer. And it does not
work, for instance, in case of lost connection.
+ Fix Unix.readlink invalid argument error under Windows
+ Fix a crash when the output of the diff program is too large.
+ Fixed Makefile for cross-compiling towards Windows (updated to
MinGW-w64)
Changes since 2.40.63:
* New preference fastercheckUNSAFE, which can be used (with care!) to
achieve much faster update detection when all the common files in
the two replicas are known to be identical. See the manual for more
information.
This feature should still be considered experimental, but it's
ready for other people to try out.
* Added option clientHostName. If specified, it will be used to as
the client host name, overriding UNISONLOCALHOSTNAME and the actual
host name.
* OS X GUI:
+ fix crash under Lion, because of problems with the toolbar,
using the fix suggested in
http://blitzbasic.com/Community/posts.php?topic=95778.
+ uimacnew09 is now the standard graphical interface on OSX
+ A small improvement to the uimacnew09 interface from Alan
Schmitt and Steve Kalkwarf: when Unison is run with the -batch
flag, the interface will now automatically propagate changes
and terminate, without waiting for user interaction.
+ Show a modal warning window if there is no archive for the
hosts. The user can then choose to exit or proceed (proceed is
the default). The window is not shown if the batch preference
is true.
+ file details panel selectable
* GTK GUI:
+ New version of uigtk2.ml from Matt Zagrabelny that reorganizes
the icons in a slightly more intuitive way.
* Minor fixes:
+ Setting the prefer preference to older or newer now propagates
deletions when there is no conflict.
+ Correctly quote the path when running merge commands.
+ Add quotes to paths when calling external file watcher
utility.
+ Incorporate a patch to fsmonitor.py (the external filewatcher
utility) from Tomasz Zernicki to make it work better under
Windows.
+ Incorporated new version of fsmonitor.py from Christophe Gohle
+ Fixed incompatibility with OpenSSH 5.6.
+ Fixed fingerprint cache: do not cache file properties
+ Some spelling corrections in documentation and comments from
Stephane Glondu
+ Fixed O_APPEND mode for open under Windows
+ Fixed String.sub invalid argument error when an AppleDouble
file does not contain a finder information field
+ Trim duplicate paths when using "-repeat watch"
+ Unison now passes path arguments and -follow directives to
fsmonitor.py. This seems to work except for one small issue
with how fsmonitor.py treats -follow directives for
directories that don't exist (or maybe this is an issue with
how it treats any kind of monitoring when the thing being
monitored doesn't exist?). If we create a symlink to a
nonexistant directory, give Unison (hence fsmonitor.py) a
'follow' directive for the symlink, start unison, and then
create the directory, fsmonitor.py misses the change.
+ Lines added in profile files by unison always start at a new
line
Changes since 2.40.1:
* Added "BelowPath" patterns, that match a path as well as all paths
below (convenient to use with nodeletion,update,creationpartial
preferences)
* Added a "fat" preference that makes Unison use the right options
when one of the replica is on a FAT filesystem.
* Allow "prefer/force=newer" even when not synchronizing modification
times. (The reconciler will not be aware of the modification time
of unchanged files, so the synchronization choices of Unison can be
different from when "times=true", but the behavior remains sane:
changed files with the most recent modification time will be
propagated.)
* Minor fixes and improvements:
+ Compare filenames up to decomposition in case sensitive mode
when one host is running MacOSX and the unicode preference is
set to true.
+ Rsync: somewhat faster compressor
+ Make Unicode the default on all architectures (it was only the
default when a Mac OS X or Windows machine was involved).
Changes since 2.32:
* Major enhancement: Unicode support.
+ Unison should now handle unicode filenames correctly on all
platforms.
+ This functionality is controlled by a new preference unicode.
+ Unicode mode is now the default when one of the hosts is under
Windows or MacOS. This may make upgrades a bit more painful
(the archives cannot be reused), but this is a much saner
default.
* Partial transfer of directories. If an error occurs while
transferring a directory, the part transferred so far is copied
into place (and the archives are updated accordingly). The
"maxerrors" preference controls how many transfer error Unison will
accept before stopping the transfer of a directory (by default,
only one). This makes it possible to transfer most of a directory
even if there are some errors. Currently, only the first error is
reported by the GUIs.
Also, allow partial transfer of a directory when there was an error
deep inside this directory during update detection. At the moment,
this is only activated with the text and GTK UIs, which have been
modified so that they show that the transfer is going to be partial
and so that they can display all errors.
* Improvement to the code for resuming directory transfers:
+ if a file was not correctly transferred (or the source has
been modified since, with unchanged size), Unison performs a
new transfer rather than failing
+ spurious files are deleted (this can happen if a file is
deleted on the source replica before resuming the transfer;
not deleting the file would result in it reappearing on the
target replica)
* Experimental streaming protocol for transferring file contents (can
be disabled by setting the directive "stream" to false): file
contents is transfered asynchronously (without waiting for a
response from the destination after each chunk sent) rather than
using the synchronous RPC mechanism. As a consequence:
+ Unison now transfers the contents of a single file at a time
(Unison used to transfer several contents simultaneously in
order to hide the connection latency.)
+ the transfer of large files uses the full available bandwidth
and is not slowed done due to the connection latency anymore
+ we get performance improvement for small files as well by
scheduling many files simultaneously (as scheduling a file for
transfer consume little ressource: it does not mean allocating
a large buffer anymore)
* Changes to the internal implementation of the rsync algorithm:
+ use longer blocks for large files (the size of a block is the
square root of the size of the file for large files);
+ transmit less checksum information per block (we still have
less than one chance in a hundred million of transferring a
file incorrectly, and Unison will catch any transfer error
when fingerprinting the whole file)
+ avoid transfer overhead (which was 4 bytes per block)
For a 1G file, the first optimization saves a factor 50 on the
amount of data transferred from the target to the source (blocks
are 32768 bytes rather than just 700 bytes). The two other
optimizations save another factor of 2 (from 24 bytes per block
down to 10).
* Implemented an on-disk file fingerprint cache to speed-up update
detection after a crash: this way, Unison does not have do
recompute all the file fingerprints from scratch.
+ When Unison detects that the archive case-sensitivity mode
does not match the current settings, it populates the
fingerprint cache using the archive contents. This way,
changing the case-sensitivity mode should be reasonably fast.
* New preferences "noupdate=root", "nodeletion=root",
"nocreation=root" that prevent Unison from performing files
updates, deletions or creations on the given root. Also 'partial'
versions of 'noupdate', 'nodeletion' and 'nocreation'
* Limit the number of simultaneous external copy program ("copymax"
preference)
* New "links" preference. When set to false, Unison will report an
error on symlinks during update detection. (This is the default
when one host is running Windows but not Cygwin.) This is better
than failing during propagation.
* Added a preference "halfduplex" to force half-duplex communication
with the server. This may be useful on unreliable links (as a more
efficient alternative to "maxthreads = 1").
* Renamed preference "pretendwin" to "ignoreinodenumbers" (an alias
is kept for backwards compatibility).
* Ignore one-second differences when synchronizing modification time.
(Technically, this is an incompatible archive format change, but it
is backward compatible. To trigger a problem, a user would have to
synchronize modification times on a filesystem with a two-second
granularity and then downgrade to a previous version of Unison,
which does not work well in such a case. Thus, it does not seem
worthwhile to increment the archive format number, which would
impact all users.)
* Do not keep many files simultaneously opened anymore when the rsync
algorithm is in use.
* Add "ignorearchives" preference to ignore existing archives (to
avoid forcing users to delete them manually, in situations where
one archive has gotten deleted or corrupted).
* Mac OS
+ fixed rsync bug which could result in an "index out of bounds"
error when transferring resource forks.
+ Fixed bug which made Unison ignore finder information and
resource fork when compiled to 64bit on Mac OSX.
+ should now be 64 bit clean (the Growl framework is not up to
date, though)
+ Made the bridge between Objective C and Ocaml code GC friendly
(it was allocating ML values and putting them in an array
which was not registered with the GC)
+ use darker grey arrows (patch contributed by Eric Y. Kow)
* GTK user interface
+ assistant for creating profiles
+ profile editor
+ pop up a summary window when the replicas are not fully
synchronized after transport
+ display estimated remaining time and transfer rate on the
progress bar
+ allow simultaneous selection of several items
+ Do not reload the preference file before a new update
detection if it is unchanged
+ disabled scrolling to the first unfinished item during
transport. It goes way too fast when lot of small files are
synchronized, and it makes it impossible to browse the file
list during transport.
+ take into account the "height" preference again
+ the internal list of selected reconciler item was not always
in sync with what was displayed (GTK bug?); workaround
implemented
+ Do not display "Looking for change" messages during
propagation (when checking the targe is unchanged) but only
during update detection
+ Apply patch to fix some crashes in the OSX GUI, thanks to Onne
Gorter.
* Text UI
+ During update detection, display status by updating a single
line rather than generating a new line of output every so
often. Should be less confusing.
* Windows
+ Fastcheck is now the default under Windows. People mostly use
NTFS nowadays and the Unicode API provides an equivalent to
inode numbers for this filesystem.
+ Only use long UNC path for accessing replicas (as '..' is not
handled with this format of paths, but can be useful)
+ Windows text UI: now put the console into UTF-8 output mode.
This is the right thing to do when in Unicode mode, and is no
worse than what we had previously otherwise (the console use
some esoteric encoding by default). This only works when using
a Unicode font instead of the default raster font.
+ Don't get the home directory from environment variable HOME
under Windows (except for Cygwin binaries): we don't want the
behavior of Unison to depends on whether it is run from a
Cygwin shell (where HOME is set) or in any other way (where
HOME is usually not set).
* Miscellaneous fixes and improvements
+ Made a server waiting on a socket more resilient to unexpected
lost connections from the client.
+ Small patch to property setting code suggested by Ulrich
Gernkow.
+ Several fixes to the change transfer functions (both the
internal ones and external transfers using rsync). In
particular, limit the number of simultaneous transfer using an
rsync (as the rsync algorithm can use a large amount of memory
when processing huge files)
+ Keep track of which file contents are being transferred, and
delay the transfer of a file when another file with the same
contents is currently being transferred. This way, the second
transfer can be skipped and replaced by a local copy.
+ Experimental update detection optimization: do not read the
contents of unchanged directories
+ When a file transfer fails, turn off fastcheck for this file
on the next sync.
+ Fixed bug with case insensitive mode on a case sensitive
filesystem:
o if file "a/a" is created on one replica and directory "A"
is created on the other, the file failed to be
synchronized the first time Unison is run afterwards, as
Unison uses the wrong path "a/a" (if Unison is run again,
the directories are in the archive, so the right path is
used);
o if file "a" appears on one replica and file "A" appears
on the other with different contents, Unison was unable
to synchronize them.
+ Improved error reporting when the destination is updated
during synchronization: Unison now tells which file has been
updated, and how.
+ Limit the length of temporary file names
+ Case sensitivity information put in the archive (in a backward
compatible way) and checked when the archive is loaded
+ Got rid of the 16mb marshalling limit by marshalling to a
bigarray.
+ Resume copy of partially transferred files.
Changes since 2.31:
* Small user interface changes
+ Small change to text UI "scanning..." messages, to print just
directories (hopefully making it clearer that individual files
are not necessarily being fingerprinted).
* Minor fixes and improvements:
+ Ignore one hour differences when deciding whether a file may
have been updated. This avoids slow update detection after
daylight saving time changes under Windows. This makes Unison
slightly more likely to miss an update, but it should be safe
enough.
+ Fix a small bug that was affecting mainly windows users. We
need to commit the archives at the end of the sync even if
there are no updates to propagate because some files (in fact,
if we've just switched to DST on windows, a LOT of files)
might have new modtimes in the archive. (Changed the text UI
only. It's less clear where to change the GUI.)
+ Don't delete the temp file when a transfer fails due to a
fingerprint mismatch (so that we can have a look and see why!)
We've also added more debugging code togive more informative
error messages when we encounter the dreaded and longstanding
"assert failed during file transfer" bug
+ Incorrect paths ("path" directive) now result in an error
update item rather than a fatal error.
+ Create parent directories (with correct permissions) during
transport for paths which point to non-existent locations in
the destination replica.
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 = Regex
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.48.3/os.ml 000644 000766 000000 00000034071 12450317305 015016 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/os.ml *)
(* Copyright 1999-2015, 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"
(* Assumption: Prefs are not loaded on server, so clientHostName is always *)
(* set to myCanonicalHostName. *)
let localCanonicalHostName =
try System.getenv "UNISONLOCALHOSTNAME"
with Not_found -> Unix.gethostname()
let clientHostName : string Prefs.t =
Prefs.createString "clientHostName" localCanonicalHostName
"!set host name of client"
("When specified, the host name of the client will not be guessed" ^
"and the provided host name will be used to find the archive.")
let serverHostName = localCanonicalHostName
let myCanonicalHostName () =
if !Trace.runningasserver then serverHostName else Prefs.read clientHostName
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 isTempFile file =
Util.endswith file tempFileSuffixFixed &&
Util.startswith file tempFilePrefix
(*****************************************************************************)
(* 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.concat fspath path in
Fs.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 directory.Fs.readdir () 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 (Fs.opendir absolutePath)
with Unix.Unix_error (Unix.ENOENT, _, _) ->
(* FIX (in Ocaml): under Windows, when a directory is empty
(not even "." and ".."), FindFirstFile fails with
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
directory.Fs.closedir ();
result
with Unix.Unix_error _ as e ->
begin try
directory.Fs.closedir ()
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 isTempFile file 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.toDebugString (Fspath.concat fspath p)));
delete fspath p
end else
debug (fun()-> Util.msg
"keeping temp file %s since it is less than 30 days old\n"
(Fspath.toDebugString (Fspath.concat 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.concat fspath path in
match (Fileinfo.get false fspath path).Fileinfo.typ with
`DIRECTORY ->
begin try
Fs.chmod absolutePath 0o700
with Unix.Unix_error _ -> () end;
Safelist.iter
(fun child -> delete fspath (Path.child path child))
(allChildrenOf fspath path);
Fs.rmdir absolutePath
| `FILE ->
if Util.osType <> `Unix then begin
try
Fs.chmod absolutePath 0o600;
with Unix.Unix_error _ -> ()
end;
Fs.unlink absolutePath;
if Prefs.read Osx.rsrc then begin
let pathDouble = Fspath.appleDouble absolutePath in
if Fs.file_exists pathDouble then
Fs.unlink pathDouble
end
| `SYMLINK ->
(* Note that chmod would not do the right thing on links *)
Fs.unlink absolutePath
| `ABSENT ->
())
let rename fname sourcefspath sourcepath targetfspath targetpath =
let source = Fspath.concat sourcefspath sourcepath in
let source' = Fspath.toPrintString source in
let target = Fspath.concat targetfspath targetpath in
let target' = Fspath.toPrintString target in
if source = target then
raise (Util.Transient ("Rename ("^fname^"): identical source and target " ^ source'));
Util.convertUnixErrorsToTransient ("renaming " ^ source' ^ " to " ^ target')
(fun () ->
debug (fun() -> Util.msg "rename %s to %s\n" source' target');
Fs.rename source target;
if Prefs.read Osx.rsrc then begin
let sourceDouble = Fspath.appleDouble source in
let targetDouble = Fspath.appleDouble target in
if Fs.file_exists sourceDouble then
Fs.rename sourceDouble targetDouble
else if Fs.file_exists targetDouble then
Fs.unlink targetDouble
end)
let symlink =
if Util.isCygwin || (Util.osType != `Win32) then
fun fspath path l ->
Util.convertUnixErrorsToTransient
"writing symbolic link"
(fun () ->
let abspath = Fspath.concat fspath path in
Fs.symlink l abspath)
else
fun fspath path l ->
raise (Util.Transient
(Format.sprintf
"Cannot create symlink \"%s\": \
symlinks are not supported under Windows"
(Fspath.toPrintString (Fspath.concat fspath path))))
(* Create a new directory, using the permissions from the given props *)
let createDir fspath path props =
Util.convertUnixErrorsToTransient
"creating directory"
(fun () ->
let absolutePath = Fspath.concat fspath path in
Fs.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)
let pseudoFingerprint path size =
(Fingerprint.pseudo path size, Fingerprint.dummy)
let isPseudoFingerprint (fp,rfp) =
Fingerprint.ispseudo fp
(* FIX: not completely safe under Unix *)
(* (with networked file system such as NFS) *)
let safeFingerprint fspath path info optFp =
let rec retryLoop count info optFp optRessFp =
if count = 0 then
raise (Util.Transient
(Printf.sprintf
"Failed to fingerprint file \"%s\": \
the file keeps on changing"
(Fspath.toPrintString (Fspath.concat fspath path))))
else
let fp =
match optFp with
None -> Fingerprint.file fspath path
| Some fp -> fp
in
let ressFp =
match optRessFp 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', (fp, ressFp))
else
retryLoop (count - 1) info'
(if dataUnchanged then Some fp else None)
(if ressUnchanged then Some ressFp else None)
in
retryLoop 10 info (* Maximum retries: 10 times *)
(match optFp 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 (fpdata,fpress) (fpdata',fpress') =
if fpdata = fpdata' then "resource fork"
else if fpress = fpress' then "file contents"
else "both file contents and resource fork"
let fullfingerprint_dummy = (Fingerprint.dummy,Fingerprint.dummy)
let fullfingerprintHash (fp, rfp) =
Fingerprint.hash fp + 31 * Fingerprint.hash rfp
let fullfingerprintEqual (fp, rfp) (fp', rfp') =
Fingerprint.equal fp fp' && Fingerprint.equal rfp rfp'
(*****************************************************************************)
(* UNISON DIRECTORY *)
(*****************************************************************************)
(* Gives the fspath of the archive directory on the machine, depending on *)
(* which OS we use *)
let unisonDir =
try
System.fspathFromString (System.getenv "UNISON")
with Not_found ->
let genericName =
Util.fileInHomeDir (Printf.sprintf ".%s" Uutil.myName) in
if Osx.isMacOSX && not (System.file_exists genericName) then
Util.fileInHomeDir "Library/Application Support/Unison"
else
genericName
(* build a fspath representing an archive child path whose name is given *)
let fileInUnisonDir str = System.fspathConcat unisonDir str
(* Make sure archive directory exists *)
let createUnisonDir() =
try ignore (System.stat unisonDir)
with Unix.Unix_error(_) ->
Util.convertUnixErrorsToFatal
(Printf.sprintf "creating unison directory %s"
(System.fspathToPrintString unisonDir))
(fun () ->
ignore (System.mkdir unisonDir 0o700))
(*****************************************************************************)
(* TEMPORARY FILES *)
(*****************************************************************************)
(* Truncate a filename to at most [l] bytes, making sure of not
truncating an UTF-8 character. Assumption: [String.length s > l] *)
let rec truncate_filename s l =
if l > 0 && Char.code s.[l] land 0xC0 = 0x80 then
truncate_filename s (l - 1)
else
String.sub s 0 l
(* We need to be careful not to use longer temp-file names than the
file system permits. eCryptfs has the lowest file name length
limit we know of, at 143 bytes. *)
let maxFileNameLength = 143
(* 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 =
match Path.deconstructRev path with
None ->
assert false
| Some (name, parentPath) ->
let name = Name.toString name in
let nameLen = String.length name in
let prefixLen = String.length prefix in
let suffixLen = String.length s in
let maxLen = maxFileNameLength - prefixLen - suffixLen in
let name =
if nameLen <= maxLen then name else
let nameDigest = Digest.to_hex (Digest.string name) in
let nameDigestLen = String.length nameDigest in
let maxLen = maxLen - nameDigestLen in
assert (maxLen>0);
(truncate_filename name maxLen ^ nameDigest)
in
Path.child parentPath (Name.fromString (prefix ^ name ^ s))
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
unison-2.48.3/os.mli 000644 000766 000000 00000004636 12450317305 015173 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/os.mli *)
(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
val myCanonicalHostName : unit -> string
val tempPath : ?fresh:bool -> Fspath.t -> Path.local -> Path.local
val tempFilePrefix : string
val isTempFile : string -> bool
val includeInTempNames : string -> unit
val exists : Fspath.t -> Path.local -> bool
val createUnisonDir : unit -> unit
val fileInUnisonDir : string -> System.fspath
val unisonDir : System.fspath
val childrenOf : Fspath.t -> Path.local -> Name.t list
val readLink : Fspath.t -> Path.local -> string
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
val fullfingerprintHash : fullfingerprint -> int
val fullfingerprintEqual : fullfingerprint -> fullfingerprint -> bool
(* 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 *)
val pseudoFingerprint :
Path.local -> (* path of file to "fingerprint" *)
Uutil.Filesize.t -> (* size of file to "fingerprint" *)
fullfingerprint (* pseudo-fingerprint of this file (containing just
the file's length and path) *)
val isPseudoFingerprint :
fullfingerprint -> bool
unison-2.48.3/osx.ml 000644 000766 000000 00000045042 12450317305 015206 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/osx.ml *)
(* Copyright 1999-2015, 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 .
*)
(*
See
http://www.opensource.apple.com/source/copyfile/copyfile-42/copyfile.c
*)
let debug = Trace.debug "osx"
(****)
external isMacOSXPred : unit -> bool = "isMacOSX"
let isMacOSX = isMacOSXPred ()
(****)
let rsrcSync =
Prefs.createBoolWithDefault "rsrc"
"!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 = `True ||
(Prefs.read rsrcSync = `Default && b))
(****)
let doubleMagic = "\000\005\022\007"
let doubleVersion = "\000\002\000\000"
let doubleFiller = String.make 16 '\000'
let resource_fork_empty_tag = "This resource fork intentionally left blank "
let finfoLength = 32L
let emptyFinderInfo () = String.make 32 '\000'
let empty_resource_fork =
"\000\000\001\000" ^
"\000\000\001\000" ^
"\000\000\000\000" ^
"\000\000\000\030" ^
resource_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 dataFspath dataPath doubleFspath msg =
debug (fun () -> Util.msg "called 'fail'");
raise (Util.Transient
(Format.sprintf
"The AppleDouble Header file '%s' \
associated to data file %s is malformed: %s"
(Fspath.toPrintString doubleFspath)
(Fspath.toPrintString (Fspath.concat dataFspath dataPath)) msg))
let readDouble dataFspath dataPath doubleFspath inch len =
let buf = String.create len in
begin try
really_input inch buf 0 len
with End_of_file ->
fail dataFspath dataPath doubleFspath "truncated"
end;
buf
let readDoubleFromOffset dataFspath dataPath doubleFspath inch offset len =
LargeFile.seek_in inch offset;
readDouble dataFspath dataPath doubleFspath inch len
let writeDoubleFromOffset 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 dataFspath dataPath =
let doubleFspath = Fspath.appleDouble (Fspath.concat dataFspath dataPath) in
let inch =
try Fs.open_in_bin doubleFspath with Sys_error _ -> raise Not_found in
protect (fun () ->
Util.convertUnixErrorsToTransient "opening AppleDouble file" (fun () ->
let header = readDouble dataFspath dataPath doubleFspath inch 26 in
if String.sub header 0 4 <> doubleMagic then
fail dataFspath dataPath doubleFspath "bad magic number";
if String.sub header 4 4 <> doubleVersion then
fail dataFspath dataPath doubleFspath "bad version";
let numEntries = getInt2 header 24 in
let entries = ref [] in
for i = 1 to numEntries do
let entry = readDouble dataFspath dataPath doubleFspath 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;
(doubleFspath, 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 : (Fspath.t * int64) ressInfo;
finfo : string }
external getFileInfosInternal :
System.fspath -> bool -> string * int64 = "getFileInfos"
external setFileInfosInternal :
System.fspath -> string -> unit = "setFileInfos"
let defaultInfos typ =
match typ with
`FILE -> { ressInfo = NoRess; finfo = "F" }
| `DIRECTORY -> { ressInfo = NoRess; finfo = "D" }
| _ -> { ressInfo = NoRess; finfo = "" }
(* BCP: dead code
let noTypeCreator = String.make 10 '\000' *)
(* Remove trailing zeroes *)
let trim s =
let rec trim_rec s pos =
if pos > 0 && 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 dataFspath dataPath typ =
if not (Prefs.read rsrc) then defaultInfos typ else
match typ with
(`FILE | `DIRECTORY) as typ ->
Util.convertUnixErrorsToTransient "getting file information" (fun () ->
try
let (fInfo, rsrcLength) =
getFileInfosInternal
(Fspath.toSysPath (Fspath.concat dataFspath dataPath))
(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 (workingDir, realPath) =
Fspath.findWorkingDir dataFspath dataPath in
let (doubleFspath, inch, entries) =
openDouble workingDir realPath in
let (rsrcOffset, rsrcLength) =
try
let (offset, len) = Safelist.assoc `RSRC entries in
(* We need to check that the resource 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 resource_fork_empty_tag in
let buf = String.create len in
really_input inch buf 0 len;
buf = resource_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: resource fork length: %d\n"
(Fspath.toDebugString dataFspath) (Path.toString dataPath)
(Int64.to_int rsrcLength));
let finfo =
protect (fun () ->
try
let (ofs, len) = Safelist.assoc `FINFO entries in
if len < finfoLength then
fail dataFspath dataPath doubleFspath "bad finder info";
readDoubleFromOffset
dataFspath dataPath doubleFspath inch ofs 32
with Not_found ->
String.make 32 '\000')
(fun () -> close_in_noerr inch)
in
close_in inch;
let stats =
Util.convertUnixErrorsToTransient "stating AppleDouble file"
(fun () -> Fs.stat doubleFspath) 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,
(doubleFspath, 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 dataFspath dataPath finfo =
assert (finfo <> "");
Util.convertUnixErrorsToTransient "setting file information" (fun () ->
try
let p = Fspath.toSysPath (Fspath.concat dataFspath dataPath) in
let (fullFinfo, _) = getFileInfosInternal p false in
setFileInfosInternal p (insertInfo fullFinfo finfo)
with Unix.Unix_error ((Unix.EOPNOTSUPP | Unix.ENOSYS), _, _) ->
(* Not an HFS volume. Look for an AppleDouble file *)
let (workingDir, realPath) = Fspath.findWorkingDir dataFspath dataPath in
begin try
let (doubleFspath, inch, entries) = openDouble workingDir realPath in
begin try
let (ofs, len) = Safelist.assoc `FINFO entries in
if len < finfoLength then
fail dataFspath dataPath doubleFspath "bad finder info";
let fullFinfo =
protect
(fun () ->
let res =
readDoubleFromOffset
dataFspath dataPath doubleFspath inch ofs 32 in
close_in inch;
res)
(fun () -> close_in_noerr inch)
in
let outch =
Fs.open_out_gen [Open_wronly; Open_binary] 0o600 doubleFspath in
protect
(fun () ->
writeDoubleFromOffset 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."
(Fspath.toPrintString doubleFspath)))
end
with Not_found ->
(* No AppleDouble file, create one if needed. *)
if finfo <> "F" && finfo <> "D" then begin
let doubleFspath =
Fspath.appleDouble (Fspath.concat workingDir realPath) in
let outch =
Fs.open_out_gen
[Open_wronly; Open_creat; Open_excl; Open_binary] 0o600
doubleFspath
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 resource 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"; (* Resource 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_resource_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 "resource fork fingerprint: path %s, offset %d, len %d"
(Fspath.toString 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
(Fs.openfile
(Fspath.concat fspath (ressPath path))
[Unix.O_RDONLY] 0o444)
with Unix.Unix_error ((Unix.ENOENT | Unix.ENOTDIR), _, _) ->
let (doublePath, inch, entries) = openDouble fspath path in
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
(Fs.openfile
(Fspath.concat fspath (ressPath path))
[Unix.O_WRONLY;Unix.O_TRUNC] 0o600)
with Unix.Unix_error ((Unix.ENOENT | Unix.ENOTDIR), _, _) ->
let path = Fspath.appleDouble (Fspath.concat fspath path) in
let outch =
Fs.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 *)
(* FIX: should check for overflow! *)
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.48.3/osx.mli 000644 000766 000000 00000001652 12450317305 015356 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/osx.mli *)
(* Copyright 1999-2015, 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 : (Fspath.t * int64) ressInfo;
finfo : string }
val defaultInfos : [> `DIRECTORY | `FILE ] -> info
val getFileInfos : Fspath.t -> Path.local -> [> `DIRECTORY | `FILE ] -> info
val setFileInfos : Fspath.t -> Path.local -> string -> unit
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 openRessIn : Fspath.t -> Path.local -> in_channel
val openRessOut : Fspath.t -> Path.local -> Uutil.Filesize.t -> out_channel
unison-2.48.3/osxsupport.c 000644 000766 000000 00000007274 11326272571 016470 0 ustar 00bcpierce wheel 000000 000000 /* 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 = FSOPT_REPORT_FULLSIZE;
struct {
u_int32_t length;
char finderInfo [32];
off_t rsrcLength;
} __attribute__ ((packed)) 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 (EINVAL, "getattrlist", path);
} else {
if (attrBuf.length != sizeof (u_int32_t) + 32)
unix_error (EINVAL, "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 {
u_int32_t length;
char finderInfo [32];
} __attribute__ ((packed)) 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.48.3/path.ml 000644 000766 000000 00000016507 12450317305 015335 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/path.ml *)
(* Copyright 1999-2015, 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 str0 = str in
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
if name1 = ".." then
raise (Util.Transient
(Printf.sprintf
"Reference to parent directory '..' not allowed \
in path '%s'" str0));
let str_res =
String.sub str (pos + 1) (String.length str - pos - 1) in
if pos = 0 || name1 = "." then begin
loop p str_res
end else
loop (child p (Name.fromString name1)) str_res
with
Not_found ->
if str = ".." then
raise (Util.Transient
(Printf.sprintf
"Reference to parent directory '..' not allowed \
in path '%s'" str0));
if str = "." then p else child p (Name.fromString str)
| Invalid_argument _ ->
raise(Invalid_argument "Path.fromString") in
loop empty str
let toString path = path
let compare p1 p2 = (Case.ops())#compare p1 p2
let toDebugString path = String.concat " / " (toStringList path)
let addSuffixToFinalName path suffix = path ^ suffix
let addToFinalName path suffix =
let l = String.length path in
assert (l > 0);
let i = try String.rindex path '/' with Not_found -> -1 in
let j = try String.rindex path '.' with Not_found -> -1 in
let j = if j <= i then l else j in
String.sub path 0 j ^ suffix ^ String.sub path j (l - j)
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
(* Pref controlling whether symlinks are followed. *)
let followPred = Pred.create ~advanced:true "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 followPred (toString path)
let forceLocal p = p
let makeGlobal p = p
unison-2.48.3/path.mli 000644 000766 000000 00000002232 12450317305 015474 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/path.mli *)
(* Copyright 1999-2015, 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 : 'a path -> (Name.t * 'a path) 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 addToFinalName : local -> string -> local
(* Add to the final name, but before any file extension. *)
val compare : t -> t -> int
val followLink : local -> bool
val followPred : Pred.t
val forceLocal : t -> local
val makeGlobal : local -> t
unison-2.48.3/pixmaps.ml 000644 000766 000000 00000110301 12450317305 016045 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/pixmaps.ml *)
(* Copyright 1999-2015, 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 *)
"............................";
"............................";
"............................";
".....#......................";
"....###.....................";
"..####......................";
"##########################..";
"##########################..";
"..##........................";
"..####......................";
"....###.....................";
"............................";
"............................";
"............................"
|]
(***********************************************************************)
(* Busy-Interactive mous pointer *)
(***********************************************************************)
let left_ptr_watch = "\
\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\
\x0c\x00\x00\x00\x1c\x00\x00\x00\x3c\x00\x00\x00\
\x7c\x00\x00\x00\xfc\x00\x00\x00\xfc\x01\x00\x00\
\xfc\x3b\x00\x00\x7c\x38\x00\x00\x6c\x54\x00\x00\
\xc4\xdc\x00\x00\xc0\x44\x00\x00\x80\x39\x00\x00\
\x80\x39\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00"
(***********************************************************************)
(* Unison icon *)
(***********************************************************************)
let icon_data =
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\001\019\020\006\134\
\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\
\019\020\006\134\000\000\000\001\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\00022\016\152\159¢4ô\
12\016\153\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\00022\016\156\
\159¢4ô12\016\148\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000/0\015w¯²9ñúþRÿ\
¯²:ñ00\016x\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\00000\016|²µ;ò\
úþRÿ«®8ï//\015s\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
*+\014V\145\1470èúþRÿúþRÿ\
úþRÿ\145\1470è**\014V\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000+,\014Z\149\1511êúþRÿ\
úþRÿúþRÿ\141\143.ç()\013Q\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\030\031\n6\
rt%àúþRÿúþRÿúþRÿ\
úþRÿúþRÿsu&á\030\030\n6\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\"#\011:vx'âúþRÿúþRÿ\
úþRÿúþRÿúþRÿop$ß\
\029\029\t2\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\015\015\005\030XZ\029Ø\
ùýRÿúþRÿúþRÿúþRÿ\
úþRÿúþRÿùýRÿYZ\029Ø\
\015\015\005\030\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\014\014\004 \
\\]\030ÚùýRÿúþRÿúþRÿ\
úþRÿúþRÿúþRÿøüQÿ\
VW\028×\008\008\003\027\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\014FG\023Îó÷Pÿ\
úþRÿúþRÿúþRÿúþRÿ\
úþRÿúþRÿúþRÿó÷Pÿ\
GH\023Î\000\000\000\014\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\015IJ\024Ð\
ôøPÿúþRÿúþRÿúþRÿ\
úþRÿúþRÿúþRÿúýRÿ\
òõNÿEF\022Ì\000\000\000\012\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\005;<\019¿èëLÿúþRÿ\
úþRÿúþRÿúþRÿúþRÿ\
úþRÿúþRÿúþRÿúþRÿ\
èìLÿ;<\019¿\000\000\000\005\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\006<=\019ÁêëLÿ\
úüQÿúûQÿúûQÿúûPÿ\
úúPÿúúPÿùùPÿùùPÿ\
ùøPÿåäIÿ99\018½\000\000\000\004\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
45\017ªÖÚGüúþRÿúþRÿ\
úþRÿúþRÿúþRÿúþRÿ\
úþRÿúþRÿúþRÿúþRÿ\
úþRÿ×ÛGü45\017ª\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\00155\017Ù×FüúøPÿ\
ú÷Pÿù÷OÿùöOÿùöOÿ\
ùõOÿùõOÿùõOÿùôNÿ\
ùôNÿùóNÿÔÏBü42\016§\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\020\020\006\133\
IJ\024ê~\128)ä~\128)äÆÉA÷\
úýRÿúýRÿúüQÿúüQÿ\
úûQÿúûQÿúûQÿ¸¸<ô\
~~(ä}}(äII\023ê\020\020\006\134\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\020\020\006\138KI\023ê}{'ä}z'ä\
ÇÃ?øùòNÿùòMÿùòMÿ\
ùñMÿùñMÿøðMÿøðMÿ\
¯¨6ò}x&ä}x&äFC\021ë\
\020\019\006\129\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014\
\000\000\000\015\000\000\000\015\000\000\000\028}}(ã\
úùPÿúøPÿúøOÿú÷Oÿ\
ú÷OÿùöOÿùöOÿdb ×\
\000\000\000\015\000\000\000\015\000\000\000\015\000\000\000\014\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\014\000\000\000\015\000\000\000\015\000\000\000 \
\131}(åùîLÿùíKÿùíKÿ\
ùìKÿøìKÿøëKÿøëKÿ\
^Y\028Ð\000\000\000\015\000\000\000\015\000\000\000\015\
\000\000\000\013\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\014}z'ã\
ùôNÿùóNÿùóMÿùòMÿ\
ùòMÿøòMÿøñMÿdb\031×\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\
\130{'åøéJÿøéIÿøèIÿ\
øèIÿ÷èIÿ÷çIÿ÷çIÿ\
_Y\028Ð\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\014}x'ã\
ùðMÿùïMÿùïLÿùîLÿ\
ùîLÿøíLÿøíLÿd_\031×\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\
\130x&åøåIÿøäHÿøäHÿ\
øãHÿ÷ãHÿ÷âHÿ÷âHÿ\
_W\027Ð\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\014|v&ã\
øëKÿøêKÿøêJÿøéJÿ\
øéJÿ÷èJÿ÷èJÿd]\030×\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\
\130v%å÷àGÿ÷ßFÿ÷ßFÿ\
÷ÞFÿöÞFÿöÝFÿöÝFÿ\
_U\027Ð\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\014|t%ã\
øçIÿøæIÿøæHÿøåHÿ\
øåHÿ÷äHÿ÷äHÿd\\\029×\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\
\130s$å÷ÜEÿ÷ÛDÿ÷ÛDÿ\
÷ÚDÿöÚDÿöÙDÿöÙDÿ\
_T\026Ð\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\014|q$ã\
÷âGÿ÷áGÿ÷áFÿ÷àFÿ\
÷àFÿößFÿößFÿdZ\028×\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\
\129q#åö×CÿöÖBÿöÖBÿ\
öÕBÿõÕBÿõÔBÿõÔBÿ\
^R\025Ð\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\014|o#ã\
÷ÞFÿ÷ÝFÿ÷ÝEÿ÷ÜEÿ\
÷ÜEÿöÛEÿöÛEÿdX\028×\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\
\129o#åöÓBÿöÒAÿöÒAÿ\
öÑAÿõÑAÿõÐAÿõÐAÿ\
^P\025Ð\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\014{m\"ã\
öÙDÿöØDÿöØCÿö×Cÿ\
ö×CÿõÖCÿõÖCÿcV\027×\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\
\129l\"åõÎ@ÿõÍ?ÿõÍ?ÿ\
õÌ?ÿôÌ?ÿôË?ÿôË?ÿ\
^N\024Ð\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\014{j!ã\
öÔBÿöÓBÿöÓAÿöÒAÿ\
öÒAÿõÒAÿõÑAÿcU\026×\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\
\129j!åõÉ>ÿõÉ=ÿõÈ=ÿ\
õÈ=ÿôÈ=ÿôÇ=ÿôÇ=ÿ\
^L\023Ð\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\014{h ã\
öÐ@ÿõÏ@ÿõÏ?ÿõÎ?ÿ\
õÎ?ÿõÍ?ÿõÍ?ÿcR\026×\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\
\128g\031åôÅ<ÿôÄ;ÿôÄ;ÿ\
ôÃ;ÿôÃ;ÿôÂ;ÿôÂ;ÿ\
^K\022Ð\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\014{f ã\
õË?ÿõÊ>ÿõÊ>ÿõÉ>ÿ\
õÉ>ÿôÈ>ÿôÈ=ÿcP\025×\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\
\128e\030åôÀ:ÿô¿:ÿô¿9ÿ\
ô¾9ÿó¾9ÿó½9ÿó½9ÿ\
^I\022Ð\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\014{d\031ã\
õÇ=ÿôÆ=ÿôÆ<ÿôÅ<ÿ\
ôÅ<ÿôÄ<ÿôÄ<ÿcO\024×\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\
\128c\030åó¼9ÿó»8ÿó»8ÿ\
óº8ÿóº8ÿó¹8ÿó¹8ÿ\
^G\021Ð\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\014za\030ã\
ôÂ;ÿôÁ;ÿôÁ:ÿôÀ:ÿ\
ôÀ:ÿó¿:ÿó¿:ÿbM\024×\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\
\128`\029åó·7ÿó¶6ÿó¶6ÿ\
óµ6ÿòµ6ÿò´6ÿò´6ÿ\
]E\020Ð\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\014z_\029ã\
ô½9ÿó¼9ÿó¼8ÿó»8ÿ\
ó»8ÿó»8ÿóº8ÿbL\023×\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\
\127^\028åò²5ÿò²4ÿò±4ÿ\
ò±4ÿò±4ÿò°4ÿò°4ÿ\
]C\020Ð\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\014z]\028ã\
ó¹7ÿó¸7ÿó¸6ÿó·6ÿ\
ó·6ÿò¶6ÿò¶6ÿbJ\022×\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\
\127[\027åò®3ÿò2ÿò2ÿ\
ò¬2ÿñ¬2ÿñ«2ÿñ«2ÿ\
]B\019Ð\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\014zZ\027ã\
ó´6ÿò³6ÿò³5ÿò²5ÿ\
ò²5ÿò±5ÿò±5ÿbH\022×\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\
~Y\026åñ©2ÿñ¨1ÿñ¨1ÿ\
ñ§1ÿñ§1ÿñ¦1ÿñ¦1ÿ\
]@\018Ð\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\014yX\026ã\
ò°4ÿò¯4ÿò¯3ÿò®3ÿ\
ò®3ÿñ3ÿñ3ÿbF\021×\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\
~W\025åñ¥0ÿñ¤/ÿñ¤/ÿ\
ñ£/ÿð£/ÿð¢/ÿð¢/ÿ\
\\>\018Ð\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\014yV\025ã\
ò«2ÿòª2ÿòª1ÿò©1ÿ\
ò©1ÿñ¨1ÿñ¨1ÿbD\020×\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\
~T\024åñ .ÿñ\159-ÿñ\159-ÿ\
ñ\158-ÿð\158-ÿð\157-ÿð\157-ÿ\
\\<\017Ð\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\014yT\024ã\
ñ§0ÿñ¦0ÿñ¦/ÿñ¥/ÿ\
ñ¥/ÿð¤/ÿð¤/ÿaB\019×\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\
~R\023åð\156,ÿð\155+ÿð\155+ÿ\
ð\154+ÿï\154+ÿï\153+ÿï\153+ÿ\
\\;\016Ð\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\012uO\023ã\
ñ¢/ÿñ¡.ÿð¡.ÿð .ÿ\
ð .ÿð\159.ÿð\159-ÿb@\018×\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\
}O\022åï\151*ÿï\150*ÿï\150*ÿ\
ï\149*ÿï\149)ÿï\148)ÿï\147)ÿ\
[7\016Î\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\003jE\020à\
ð\157-ÿð\156,ÿð\156,ÿð\155,ÿ\
ð\155,ÿð\154,ÿð\154,ÿb?\018Ù\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\027\
\134R\023éï\144'ÿî\143'ÿî\142'ÿ\
î\141&ÿî\140&ÿî\140&ÿî\139%ÿ\
W3\014Ê\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000d@\018Ü\
ð\152+ÿð\152+ÿï\152*ÿï\151*ÿ\
ï\151*ÿï\150*ÿï\150*ÿd>\017Û\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000)\
\151V\023ðî\135$ÿí\134$ÿí\133#ÿ\
í\132#ÿí\131#ÿí\130\"ÿí\129\"ÿ\
U.\012Ç\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000a<\017×\
ï\147)ÿï\146)ÿï\145(ÿï\144(ÿ\
ï\144(ÿï\143'ÿï\142'ÿd<\016Ý\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0008\
¨Y\023ùí} ÿí| ÿí{ ÿ\
í{\031ÿíz\031ÿíy\031ÿíx\030ÿ\
R)\nÃ\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000^7\015Ó\
î\138%ÿî\137%ÿî\136$ÿî\135$ÿ\
î\134$ÿî\133#ÿî\132#ÿh:\015à\
\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\016\008\002L\
·Z\023ÿìs\028ÿìs\028ÿìr\028ÿ\
ìq\027ÿìp\027ÿìo\027ÿìn\026ÿ\
O$\tÀ\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000Z1\013Î\
í\129!ÿí\128!ÿí\127 ÿí~ ÿ\
í} ÿí|\031ÿí{\031ÿ\129C\017ç\
\000\000\000\023\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\"\016\004d\
ÄY\021ÿëj\024ÿëj\024ÿëi\024ÿ\
ëh\023ÿëg\023ÿëf\023ÿëe\022ÿ\
K \007¼\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000M'\n¿\
ìw\030ÿìv\030ÿìu\029ÿìt\029ÿ\
ìs\029ÿìr\028ÿìq\028ÿ\158L\019õ\
\000\000\0002\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000*\018\004z\
ÑW\020ÿê`\021ÿê`\021ÿê_\021ÿ\
ê^\020ÿê]\020ÿê\\\020ÿê[\019ÿ\
>\024\005¯\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000;\028\007¬\
ën\026ÿëm\026ÿël\025ÿëk\025ÿ\
ëj\025ÿëi\024ÿëh\024ÿÜa\022ÿ\
3\022\005\158\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000/\018\004£\
âU\017ÿéW\017ÿéW\017ÿéV\017ÿ\
éU\016ÿéT\016ÿéS\016ÿãP\015ÿ\
/\016\003\153\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000-\020\004\139\
Ú]\021ÿêc\022ÿêb\021ÿêa\021ÿ\
êa\021ÿê`\020ÿê_\020ÿê^\020ÿ\
]%\008Û\000\000\000\014\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\006X\030\005Õ\
èO\014ÿèN\013ÿèM\013ÿèL\013ÿ\
èL\012ÿèK\012ÿèJ\012ÿÆ>\tÿ\
%\012\002l\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\017\007\001N\
²F\015ýéZ\019ÿéY\018ÿéX\018ÿ\
éW\018ÿéV\017ÿéU\017ÿéU\017ÿ\
ÙN\015ÿ9\020\004Ê\000\000\000\016\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\002&\012\002É=\nü\
çE\011ÿçD\nÿçD\nÿçC\nÿ\
çB\tÿçA\tÿç@\tÿ\155*\005õ\
\004\001\0005\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\
_!\006ÙèQ\015ÿèP\014ÿèO\014ÿ\
èN\014ÿèM\013ÿèL\013ÿèL\013ÿ\
èK\012ÿÝF\011ÿ<\019\003Í\016\005\001X\
\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\008\002\000\0261\013\002ÁÅ5\006üæ=\007ÿ\
æ<\007ÿæ;\006ÿæ;\006ÿæ:\006ÿ\
æ9\005ÿæ8\005ÿæ7\005ÿO\019\001Ï\
\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
2\016\002¥ÜD\nÿçF\011ÿçE\nÿ\
çE\nÿçD\tÿçC\tÿçB\tÿ\
çA\008ÿç@\008ÿç?\008ÿ±0\005û\
5\014\002Ô6\014\002².\012\001\157(\n\001w\
\030\007\001^-\011\001\142.\011\001®N\019\002³\
\139!\002ôà5\004ÿæ5\004ÿæ4\003ÿ\
æ3\003ÿæ2\002ÿå1\002ÿå0\002ÿ\
å0\001ÿå/\001ÿÔ+\001ÿ/\t\000\148\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\t\002\000\024X\024\003Úç=\007ÿç<\006ÿ\
ç;\006ÿç:\006ÿç9\005ÿç9\005ÿ\
æ8\005ÿæ7\004ÿæ6\004ÿæ5\004ÿ\
æ4\003ÿæ3\003ÿå2\003ÿË+\002ÿ\
»'\002ÿÙ-\002ÿå/\001ÿå.\001ÿ\
å-\001ÿå,\000ÿå+\000ÿå+\000ÿ\
å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\
å+\000ÿå+\000ÿT\016\000Û\000\000\000\020\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000%\008\001U\153#\002ìæ3\003ÿ\
æ2\003ÿæ1\002ÿæ0\002ÿå/\001ÿ\
å/\001ÿå.\001ÿå-\000ÿå+\000ÿ\
å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\
å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\
å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\
å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\
å+\000ÿ\145\027\000ì%\007\000U\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\0003\n\000p\128\024\000ç\
å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\
å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\
å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\
å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\
å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\
å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\
\152\029\000ñ6\n\000y\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\030\006\000J\
j\020\000ÛÞ*\000ÿå+\000ÿå+\000ÿ\
å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\
å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\
å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\
å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\
å+\000ÿå+\000ÿã+\000ÿx\022\000Ý\
&\007\000_\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\0211\t\000 k\020\000à×(\000ÿ\
å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\
å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\
å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\
å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\
Û)\000ÿw\022\000æ7\n\000°\017\003\000$\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\n4\n\000\147\
G\013\000¿_\018\000Ý£\031\000ùË&\000ÿ\
ä+\000ÿå+\000ÿå+\000ÿå+\000ÿ\
å+\000ÿå+\000ÿå+\000ÿå+\000ÿ\
Ô(\000ÿ±!\000ýo\021\000ãO\015\000È\
9\011\000¦\000\000\000\018\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\002\003\001\000<)\008\000z\
-\t\000\1502\t\000¤:\011\000¬B\012\000´\
H\014\000º@\012\000²9\011\000ª.\t\000£\
,\008\000\136\004\001\000L\000\000\000\007\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
unison-2.48.3/pred.ml 000644 000766 000000 00000014515 12450317305 015330 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/pred.ml *)
(* Copyright 1999-2015, 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 : Case.mode;
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, BelowPath 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
let s =
Util.trimWhitespace (String.sub str l (String.length str - l)) in
g ((Case.ops())#normalizePattern s)
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);
("BelowPath ", fun str ->
if str<>"" && str.[0] = '/' then
raise (Prefs.IllegalValue
("Malformed pattern: "
^ "\"" ^ p ^ "\"\n"
^ "'BelowPath' patterns may not begin with a slash; "
^ "only relative paths are allowed."));
Rx.seq [Rx.globx str; Rx.rx "(/.*)?"]);
("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 ?(local=false) ?(advanced=false) fulldoc =
let pref =
Prefs.create name ~local []
((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 = (Case.ops())#mode;
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 handleCase rx =
if (Case.ops())#caseInsensitiveMatch then Rx.case_insensitive rx
else rx
in
let strings = Safelist.filterMap
(fun (rx,vo) ->
match vo with
None -> None
| Some v -> Some (handleCase rx,v))
compiledList in
p.compiled <- handleCase 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.ops())#mode 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.ops())#normalizeMatchedString s) in
debug (fun() -> Util.msg "%s '%s' = %b\n" p.name s res);
res
let assoc p s =
recompile_if_needed p;
let s = (Case.ops())#normalizeMatchedString s in
snd (Safelist.find (fun (rx,v) -> Rx.match_string rx s) p.associated_strings)
let assoc_all p s =
recompile_if_needed p;
let s = (Case.ops())#normalizeMatchedString s in
Safelist.map snd
(Safelist.filter (fun (rx,v) -> Rx.match_string rx s) p.associated_strings)
unison-2.48.3/pred.mli 000644 000766 000000 00000005131 12450317305 015473 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/pred.mli *)
(* Copyright 1999-2015, 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 -> ?local:bool -> ?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
(* Return all strings associated to a matching pattern. *)
val assoc_all : t -> string -> string list
(* 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.48.3/props.ml 000644 000766 000000 00000063422 12450317305 015542 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/props.ml *)
(* Copyright 1999-2015, 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
val validatePrefs : unit -> unit
val permMask : int Prefs.t
val dontChmod : bool Prefs.t
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$. If one of the replica is on \
a FAT [Windows] filesystem, you should consider using the \
{\tt fat} preference instead of this preference. If you need \
Unison not to set permissions at all, set the value of this \
preference to $0$ and set the preference {\tt dontchmod} to {\tt true}."
(* 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 0o4000 "" "-" "S" ^
bit 0o2000 "" "-" "s" ^
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 0o4000 "" "-" "S" ^
bit 0o2000 "" "-" "s" ^
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 validatePrefs () =
if Prefs.read dontChmod && (Prefs.read permMask <> 0) then raise (Util.Fatal
"If the 'dontchmod' preference is set, the 'perms' preference should be 0")
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.concat fspath path in
debug
(fun() ->
Util.msg "Setting permissions for %s to %s (%s)\n"
(Fspath.toDebugString abspath) (toString (fileperm2perm fp))
(Printf.sprintf "%o/%o" fp mask));
try
Fs.chmod abspath fp
with Unix.Unix_error (Unix.EOPNOTSUPP, _, _) as e ->
try
Util.convertUnixErrorsToTransient "setting permissions"
(fun () -> raise e)
with Util.Transient msg ->
raise (Util.Transient
(msg ^
". You can use preference \"fat\",\
or else set preference \"perms\" to 0 and \
preference \"dontchmod\" to true to avoid this error")))
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. \
If this is a FAT filesystem, you should set the \"fat\" option \
to true. \
Otherwise, you should probably set the \"perms\" option to 0o%o \
(or to 0 if you don't need to synchronize permissions)."
(Fspath.toPrintString (Fspath.concat fspath path))
(syncedPartsToString (fp, mask))
(syncedPartsToString (fp', mask))
((Prefs.read permMask) 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 : Fspath.t -> 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 -> Uutil.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.concat 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 = Fs.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 = Fs.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
(* Accept one hour differences and one second differences *)
let possible_deltas =
[ -3601L; 3601L; -3600L; 3600L; -3599L; 3599L; -1L; 1L; 0L ]
let hash t h =
Uutil.hash2
(match t with
Synced _ -> 1 (* As we are ignoring one-second differences,
we cannot provide a more accurate hash. *)
| NotSynced _ -> 0)
h
(* Times have a two-second granularity on FAT filesystems. They are
approximated upward under Windows, downward under Linux...
Ignoring one-second changes also makes Unison more robust when
dealing with systems with sub-second granularity (we have no control
on how this is may be rounded). *)
let similar 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 _ -> Format.sprintf "%s (%f)" (toString t) (extract t)
| NotSynced _ -> ""
(* 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.concat fspath path in
if not (Fs.canSetTime abspath) then
begin
(* Nb. This workaround was proposed by Dmitry Bely, to
work around the fact that Unix.utimes fails on readonly
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 =
(Fs.lstat abspath).Unix.LargeFile.st_perm in
Util.finalize
(fun()->
Fs.chmod abspath 0o600;
Fs.utimes abspath v v)
(fun()-> Fs.chmod abspath oldPerms)
end
else if false then begin
(* A special hack for Rasmus, who has a special situation that
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 ^ " " ^ Fspath.quotes abspath in
Util.msg "Running external program to set utimes:\n %s\n" cmd;
let (r,_) = Lwt_unix.run (External.runExternalProgram cmd) in
if r<>(Unix.WEXITED 0) then raise (Util.Transient "External time-setting command failed")
end else
Fs.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 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.toPrintString (Fspath.concat 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 (Uutil.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 String.length s > 0 && 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
let permMask = Perm.permMask
let dontChmod = Perm.dontChmod
let validatePrefs = Perm.validatePrefs
(* ------------------------------------------------------------------------- *)
(* Directory change stamps *)
(* ------------------------------------------------------------------------- *)
(* We are reusing the directory length to store a flag indicating that
the directory is unchanged *)
type dirChangedStamp = Uutil.Filesize.t
let freshDirStamp () =
let t =
(Unix.gettimeofday () +. sqrt 2. *. float (Unix.getpid ())) *. 1000.
in
Uutil.Filesize.ofFloat t
let changedDirStamp = Uutil.Filesize.zero
let setDirChangeFlag p stamp inode =
let stamp = Uutil.Filesize.add stamp (Uutil.Filesize.ofInt inode) in
(setLength p stamp, length p <> stamp)
let dirMarkedUnchanged p stamp inode =
let stamp = Uutil.Filesize.add stamp (Uutil.Filesize.ofInt inode) in
stamp <> changedDirStamp && length p = stamp
unison-2.48.3/props.mli 000644 000766 000000 00000002412 12450317305 015703 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/props.mli *)
(* Copyright 1999-2015, 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
val permMask : int Prefs.t
val dontChmod : bool Prefs.t
(* We are reusing the directory length to store a flag indicating that
the directory is unchanged *)
type dirChangedStamp
val freshDirStamp : unit -> dirChangedStamp
val changedDirStamp : dirChangedStamp
val setDirChangeFlag : t -> dirChangedStamp -> int -> t * bool
val dirMarkedUnchanged : t -> dirChangedStamp -> int -> bool
val validatePrefs: unit -> unit
unison-2.48.3/pty.c 000644 000766 000000 00000002656 11203276603 015027 0 ustar 00bcpierce wheel 000000 000000 /* 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
#define Nothing ((value) 0)
CAMLprim value setControllingTerminal(value fdVal) {
unix_error (ENOSYS, "setControllingTerminal", Nothing);
}
CAMLprim value c_openpty() {
unix_error (ENOSYS, "openpty", Nothing);
}
#endif
unison-2.48.3/README 000644 000766 000000 00000002221 11400470065 014710 0 ustar 00bcpierce wheel 000000 000000 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 INSTALLATION section of the user manual.
License and copying information can be found in the file COPYING
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
Credits:
OS X Unison Icon taken from Mac4Lin (LGPL)
http://sourceforge.net/projects/mac4lin/
Some icons in the OSX GUI are directly taken from Matt Ball's developer icons
(Creative Commons Attribution 3.0)
Others are based on Matt Ball's developer icons (Creative Commons Attribution 3.0)
http://www.mattballdesign.com/blog/2009/11/23/developer-icons-are-back-online/
OSX GUI elements from BWToolkit (three-clause BSD license)
http://www.brandonwalkin.com/bwtoolkit/
unison-2.48.3/recon.ml 000644 000766 000000 00000075537 12450317305 015517 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/recon.ml *)
(* Copyright 1999-2015, 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 = rc1; rc2 = rc2; direction = d; default_direction = default } as diff)
when force=`Force || isConflict default ->
if dir=`Replica1ToReplica2 then
diff.direction <- Replica1ToReplica2
else if dir=`Replica2ToReplica1 then
diff.direction <- Replica2ToReplica1
else if dir=`Merge then begin
if Globals.shouldMerge ri.path1 then diff.direction <- Merge
end else begin (* dir = `Older or dir = `Newer *)
match rc1.status, rc2.status with
`Deleted, _ ->
if isConflict default then
diff.direction <- Replica2ToReplica1
| _, `Deleted ->
if isConflict default then
diff.direction <- Replica1ToReplica2
| _ ->
let comp = Props.time rc1.desc -. Props.time rc2.desc in
let comp = if dir=`Newer then -. comp else comp in
if comp<0.0 then
diff.direction <- Replica1ToReplica2
else
diff.direction <- Replica2ToReplica1
end
| _ ->
()
let revertToDefaultDirection ri =
match ri.replicas with
Different diff -> diff.direction <- diff.default_direction
| _ -> ()
(* 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 (r1, r2) = Globals.rawRootPair () 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)
let noDeletion =
Prefs.createStringList "nodeletion"
"prevent file deletions on one replica"
("Including the preference \\texttt{-nodeletion \\ARG{root}} prevents \
Unison from performing any file deletion on root \\ARG{root}.\n\n\
This preference can be included twice, once for each root, if you \
want to prevent any deletion.")
let noUpdate =
Prefs.createStringList "noupdate"
"prevent file updates and deletions on one replica"
("Including the preference \\texttt{-noupdate \\ARG{root}} prevents \
Unison from performing any file update or deletion on root \
\\ARG{root}.\n\n\
This preference can be included twice, once for each root, if you \
want to prevent any update.")
let noCreation =
Prefs.createStringList "nocreation"
"prevent file creations on one replica"
("Including the preference \\texttt{-nocreation \\ARG{root}} prevents \
Unison from performing any file creation on root \\ARG{root}.\n\n\
This preference can be included twice, once for each root, if you \
want to prevent any creation.")
let noDeletionPartial =
Pred.create "nodeletionpartial" ~advanced:true
("Including the preference \
\\texttt{nodeletionpartial = \\ARG{PATHSPEC} -> \\ARG{root}} prevents \
Unison from performing any file deletion in \\ARG{PATHSPEC} \
on root \\ARG{root} (see \\sectionref{pathspec}{Path Specification} \
for more information). It is recommended to use {\\tt BelowPath} \
patterns when selecting a directory and all its contents.")
let noUpdatePartial =
Pred.create "noupdatepartial" ~advanced:true
("Including the preference \
\\texttt{noupdatepartial = \\ARG{PATHSPEC} -> \\ARG{root}} prevents \
Unison from performing any file update or deletion in \
\\ARG{PATHSPEC} on root \\ARG{root} (see \
\\sectionref{pathspec}{Path Specification} for more information). \
It is recommended to use {\\tt BelowPath} \
patterns when selecting a directory and all its contents.")
let noCreationPartial =
Pred.create "nocreationpartial" ~advanced:true
("Including the preference \
\\texttt{nocreationpartial = \\ARG{PATHSPEC} -> \\ARG{root}} prevents \
Unison from performing any file creation in \\ARG{PATHSPEC} \
on root \\ARG{root} (see \\sectionref{pathspec}{Path Specification} \
for more information). \
It is recommended to use {\\tt BelowPath} \
patterns when selecting a directory and all its contents.")
let maxSizeThreshold =
Prefs.createInt "maxsizethreshold" (-1)
"!prevent transfer of files bigger than this (if >=0, in Kb)"
("A number indicating above what filesize (in kilobytes) Unison should "
^ "flag a conflict instead of transferring the file. "
^ "This conflict remains even in the presence of force or prefer options. "
^ "A negative number will allow every transfer independently of the size. "
^ "The default is -1. ")
let partialCancelPref actionKind =
match actionKind with
`DELETION -> noDeletionPartial
| `UPDATE -> noUpdatePartial
| `CREATION -> noCreationPartial
let cancelPref actionKind =
match actionKind with
`DELETION -> noDeletion
| `UPDATE -> noUpdate
| `CREATION -> noCreation
let actionKind fromRc toRc =
let fromTyp = fromRc.typ in
let toTyp = toRc.typ in
if fromTyp = toTyp then `UPDATE else
if toTyp = `ABSENT then `CREATION else
`DELETION
let shouldCancel path rc1 rc2 root2 =
let test kind =
List.mem root2 (Prefs.read (cancelPref kind))
||
List.mem root2 (Pred.assoc_all (partialCancelPref kind) path)
in
let testSize rc =
Prefs.read maxSizeThreshold >= 0
&& Props.length rc.desc >=
Uutil.Filesize.ofInt64
(Int64.mul (Int64.of_int 1000)
(Int64.of_int (Prefs.read maxSizeThreshold)))
in
match actionKind rc1 rc2 with
`UPDATE ->
if test `UPDATE then true, "would update a file with noupdate or noupdatepartial set"
else testSize rc1, "would transfer a file of size greater than maxsizethreshold"
| `DELETION ->
if test `UPDATE then true, "would update a file with noupdate or noupdatepartial set"
else test `DELETION, "would delete a file with nodeletion or nodeletionpartial set"
| `CREATION ->
if test `CREATION then true, "would create a file with nocreation or nocreationpartial set"
else testSize rc1, "would transfer a file of size greater than maxsizethreshold"
let filterRi root1 root2 ri =
match ri.replicas with
Problem _ ->
()
| Different diff ->
let cancel,reason =
match diff.direction with
Replica1ToReplica2 ->
shouldCancel (Path.toString ri.path1) diff.rc1 diff.rc2 root2
| Replica2ToReplica1 ->
shouldCancel (Path.toString ri.path1) diff.rc2 diff.rc1 root1
| Conflict _ | Merge ->
false,""
in
if cancel
then
diff.direction <- Conflict reason
let filterRis ris =
let (root1, root2) = Globals.rawRootPair () in
Safelist.iter (fun ri -> filterRi root1 root2 ri) ris
(* 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.path1 in
if rootp<>"" then begin
let dir = root2direction rootp in
setDirection ri dir forcep
end) ris;
filterRis 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 *)
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);
let checkPref extract (pref, prefName) =
try
let root =
List.find (fun r -> not (List.mem r (Globals.rawRoots ())))
(extract pref)
in
let (r1, r2) = Globals.rawRootPair () in
raise (Util.Fatal (Printf.sprintf
"%s (given as argument to '%s' preference)\n\
is not one of the current roots:\n %s\n %s" root prefName r1 r2))
with Not_found ->
()
in
List.iter (checkPref Prefs.read)
[noDeletion, "nodeletion"; noUpdate, "noupdate"; noCreation, "nocreation"];
List.iter (checkPref Pred.extern_associated_strings)
[noDeletionPartial, "nodeletionpartial";
noUpdatePartial, "noupdatepartial";
noCreationPartial, "nocreationpartial"]
(* ------------------------------------------------------------------------- *)
(* 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 _ ->
()
let rec collectErrors ui rem =
match ui with
NoUpdates ->
rem
| Error err ->
err :: rem
| Updates (uc, _) ->
match uc with
Dir (_, children, _, _) ->
Safelist.fold_right
(fun (_, uiSub) rem -> collectErrors uiSub rem) children rem
| Absent | File _ | Symlink _ ->
rem
(* lifting errors in individual updates to replica problems *)
let propagateErrors allowPartial (rplc: Common.replicas): Common.replicas =
match rplc with
Problem _ ->
rplc
| Different diff when allowPartial ->
Different { diff with
errors1 = collectErrors diff.rc1.ui [];
errors2 = collectErrors diff.rc2.ui [] }
| Different diff ->
try
checkForError diff.rc1.ui;
try
checkForError diff.rc2.ui;
rplc
with UpdateError err ->
Problem ("[root 2]: " ^ err)
with UpdateError err ->
Problem ("[root 1]: " ^ err)
type singleUpdate = Rep1Updated | Rep2Updated
let update2replicaContent path (conflict: bool) ui props ucNew oldType:
Common.replicaContent =
let size = Update.updateSize path ui in
match ucNew with
Absent ->
{typ = `ABSENT; status = `Deleted; desc = Props.dummy;
ui = ui; size = size; props = props}
| File (desc, ContentsSame) ->
{typ = `FILE; status = `PropsChanged; desc = desc;
ui = ui; size = size; props = props}
| File (desc, _) when oldType <> `FILE ->
{typ = `FILE; status = `Created; desc = desc;
ui = ui; size = size; props = props}
| File (desc, ContentsUpdated _) ->
{typ = `FILE; status = `Modified; desc = desc;
ui = ui; size = size; props = props}
| Symlink l when oldType <> `SYMLINK ->
{typ = `SYMLINK; status = `Created; desc = Props.dummy;
ui = ui; size = size; props = props}
| Symlink l ->
{typ = `SYMLINK; status = `Modified; desc = Props.dummy;
ui = ui; size = size; props = props}
| Dir (desc, _, _, _) when oldType <> `DIRECTORY ->
{typ = `DIRECTORY; status = `Created; desc = desc;
ui = ui; size = size; props = props}
| Dir (desc, _, PropsUpdated, _) ->
{typ = `DIRECTORY; status = `PropsChanged; desc = desc;
ui = ui; size = size; props = props}
| 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) *)
{typ = `DIRECTORY; status = `Modified; desc = desc;
ui = ui; size = size; props = props}
| Dir (desc, _, PropsSame, _) ->
{typ = `DIRECTORY; status = `Unchanged; desc =desc;
ui = ui; size = size; props = props}
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-updating *)
let describeUpdate path props' ui props
: Common.replicaContent * Common.replicaContent =
match ui with
Updates (ucNewStatus, prev) ->
let typ = oldType prev in
(update2replicaContent path false ui props ucNewStatus typ,
{typ = typ; status = `Unchanged; desc = oldDesc prev;
ui = NoUpdates; size = Update.updateSize path NoUpdates;
props = props'})
| _ -> 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 allowPartial path props' ui props whatIsUpdated
(result: (Name.t * Name.t, Common.replicas) Tree.u)
: (Name.t * Name.t, Common.replicas) Tree.u =
let different() =
let rcUpdated, rcNotUpdated = describeUpdate path props' ui props in
match whatIsUpdated with
Rep2Updated ->
Different {rc1 = rcNotUpdated; rc2 = rcUpdated;
direction = Replica2ToReplica1;
default_direction = Replica2ToReplica1;
errors1 = []; errors2 = []}
| Rep1Updated ->
Different {rc1 = rcUpdated; rc2 = rcNotUpdated;
direction = Replica1ToReplica2;
default_direction = Replica1ToReplica2;
errors1 = []; errors2 = []} 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 allowPartial (Path.child path theName)
[] uiChild [] whatIsUpdated
(Tree.enter result (theName, theName))))
r children
| Updates _ ->
Tree.add result (propagateErrors allowPartial (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,name,ui)) children2)
| _,[] ->
Safelist.rev_append r
(Safelist.map
(fun (name,ui) -> (name,ui,name,NoUpdates)) children1)
| (name1,ui1)::rem1, (name2,ui2)::rem2 ->
let dif = Name.compare name1 name2 in
if dif = 0 then
loop ((name1,ui1,name2,ui2)::r) rem1 rem2
else if dif < 0 then
loop ((name1,ui1,name1,NoUpdates)::r) rem1 children2
else
loop ((name2,NoUpdates,name2,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 * Name.t, Common.updateContent * Common.updateContent) *)
(* Tree.u *)
(* unequals: (Name.t * Name.t, Common.replicas) Tree.u *)
(* -- *)
let rec reconcile
allowPartial path ui1 props1 ui2 props2 counter equals unequals =
let different uc1 uc2 reason oldType equals unequals =
(equals,
Tree.add unequals
(propagateErrors allowPartial
(Different {rc1 = update2replicaContent
path true ui1 props1 uc1 oldType;
rc2 = update2replicaContent
path true ui2 props2 uc2 oldType;
direction = Conflict reason;
default_direction = Conflict reason;
errors1 = []; errors2 = []}))) in
let toBeMerged uc1 uc2 oldType equals unequals =
(equals,
Tree.add unequals
(propagateErrors allowPartial
(Different {rc1 = update2replicaContent
path true ui1 props1 uc1 oldType;
rc2 = update2replicaContent
path true ui2 props2 uc2 oldType;
direction = Merge; default_direction = Merge;
errors1 = []; errors2 = []}))) in
match (ui1, ui2) with
(Error s, _) ->
(equals, Tree.add unequals (Problem s))
| (_, Error s) ->
(equals, Tree.add unequals (Problem s))
| (NoUpdates, _) ->
(equals,
reconcileNoConflict
allowPartial path props1 ui2 props2 Rep2Updated unequals)
| (_, NoUpdates) ->
(equals,
reconcileNoConflict
allowPartial path props2 ui1 props1 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 "properties changed on both sides" in
(equals,
Tree.add unequals
(Different
{rc1 = update2replicaContent path false ui1 [] uc1 `DIRECTORY;
rc2 = update2replicaContent path false ui2 [] uc2 `DIRECTORY;
direction = action; default_direction = action;
errors1 = []; errors2 = []}))
in
(* Apply reconcile on children. *)
Safelist.fold_left
(fun (equals, unequals) (name1,ui1,name2,ui2) ->
let (eq, uneq) =
reconcile
allowPartial (Path.child path name1) ui1 [] ui2 [] counter
(Tree.enter equals (name1, name2))
(Tree.enter unequals (name1, name2))
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' "properties changed on both sides"
(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 "contents changed on both sides"
(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 "symbolic links changed on both sides"
(oldType prev) equals unequals
| (Updates (uc1, prev), Updates (uc2, _)) ->
different uc1 uc2 "conflicting updates"
(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 p1 p2 t =
match Path.deconstruct p1, Path.deconstruct p2 with
None, None ->
t
| Some (nm1, p1'), Some (nm2, p2') ->
enterPath p1' p2' (Tree.enter t (nm1, nm2))
| _ ->
assert false (* Cannot happen, as the paths are equal up to case *)
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 allowPartial
(pathUpdatesList:
((Path.local * Common.updateItem * Props.t list) *
(Path.local * Common.updateItem * Props.t 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)
((path1,ui1,props1),(path2,ui2,props2)) ->
(* We make the paths global as we may concatenate them with
names from the other replica *)
let path1 = Path.makeGlobal path1 in
let path2 = Path.makeGlobal path2 in
let (equals, unequals) =
reconcile allowPartial
path1 ui1 props1 ui2 props2 (counter, archiveUpdated)
(enterPath path1 path2 equals)
(enterPath path1 path2 unequals)
in
(leavePath path1 equals, leavePath path1 unequals,
if dangerousPath ui1 ui2 then path1 :: dangerous else dangerous))
(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.empty)
(fun (p1, p2) (nm1, nm2) -> (Path.child p1 nm1, Path.child p2 nm2)) [] in
let unsorted =
Safelist.map
(fun ((p1, p2), rplc) -> {path1 = p1; path2 = p2; 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 ?(allowPartial = false) updatesList =
Trace.status "Reconciling changes";
debug (fun() -> Util.msg "reconcileAll\n");
reconcileList allowPartial updatesList
unison-2.48.3/recon.mli 000644 000766 000000 00000003201 12450317305 015643 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/recon.mli *)
(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
val reconcileAll :
?allowPartial:bool (* whether we allow partial synchronization
of directories (default to false) *)
-> ((Path.local * Common.updateItem * Props.t list) *
(Path.local * Common.updateItem * Props.t list)) list
(* 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*)
(* 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.48.3/remote.ml 000644 000766 000000 00000147124 12450317305 015674 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/remote.ml *)
(* Copyright 1999-2015, 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 "remote"
let debugV = Trace.debug "remote_emit+"
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 _ =
if Sys.os_type = "Unix" then
ignore(Sys.set_signal Sys.sigpipe Sys.Signal_ignore)
let _ =
if Sys.os_type = "Unix" then
ignore(Sys.set_signal Sys.sigpipe Sys.Signal_ignore)
(*
Flow-control mechanism (only active under Windows).
Only one side is allowed to send messages at any given time.
Once it has finished sending messages, a special message is sent
meaning that the destination is now allowed to send messages.
Threads behave in a very controlled way: they only perform possibly
blocking I/Os through the remote module, and never call
Lwt_unix.yield. This mean that when one side gives up its right to
write, we know that no matter how long we wait, it will not have
anything to write. This ensures that there is no deadlock.
A more robust protocol would be to give up write permission
whenever idle (not just after having sent at least one message).
But then, there is the risk that the two sides exchange spurious
messages.
*)
(****)
let intSize = 5
let intHash x = ((x * 791538121) lsr 23 + 17) land 255
let encodeInt m =
let int_buf = Bytearray.create intSize 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.{4} <- Char.chr (intHash m);
(int_buf, 0, intSize)
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
let m = (b3 lsl 24) lor (b2 lsl 16) lor (b1 lsl 8) lor b0 in
if Char.code (int_buf.{i + 4}) <> intHash m then
raise (Util.Fatal
"Protocol error: corrupted message received;\n\
if it happens to you in a repeatable way, \n\
please post a report on the unison-users mailing list.");
m
(*************************************************************************)
(* LOW-LEVEL IO *)
(*************************************************************************)
let lostConnection () =
Lwt.fail (Util.Fatal "Lost connection with the server")
let catchIoErrors 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, _, _)
| Unix.Unix_error(Unix.EUNKNOWNERR (-64), _, _)
(* ERROR_NETNAME_DELETED *)
| Unix.Unix_error(Unix.EUNKNOWNERR (-233), _, _) ->
(* ERROR_PIPE_NOT_CONNECTED *)
(* Client has closed its end of the connection *)
lostConnection ()
| _ ->
Lwt.fail e)
(****)
let receivedBytes = ref 0.
let emittedBytes = ref 0.
(****)
(* I/O buffers *)
type ioBuffer =
{ channel : Lwt_unix.file_descr;
buffer : string;
mutable length : int;
mutable opened : bool }
let bufferSize = 16384
(* No point in making this larger, as the Ocaml Unix library uses a
buffer of this size *)
let makeBuffer ch =
{ channel = ch; buffer = String.create bufferSize;
length = 0; opened = true }
(****)
(* Low-level inputs *)
let fillInputBuffer conn =
assert (conn.length = 0);
catchIoErrors
(fun () ->
Lwt_unix.read conn.channel conn.buffer 0 bufferSize >>= fun len ->
debugV (fun() ->
if len = 0 then
Util.msg "grab: EOF\n"
else
Util.msg "grab: %s\n"
(String.escaped (String.sub conn.buffer 0 len)));
if len = 0 then
lostConnection ()
else begin
receivedBytes := !receivedBytes +. float len;
conn.length <- len;
Lwt.return ()
end)
let rec grabRec conn s pos len =
if conn.length = 0 then begin
fillInputBuffer conn >>= fun () ->
grabRec conn s pos len
end else begin
let l = min (len - pos) conn.length in
Bytearray.blit_from_string conn.buffer 0 s pos l;
conn.length <- conn.length - l;
if conn.length > 0 then
String.blit conn.buffer l conn.buffer 0 conn.length;
if pos + l < len then
grabRec conn s (pos + l) len
else
Lwt.return ()
end
let grab conn s len =
assert (len > 0);
assert (Bytearray.length s <= len);
grabRec conn s 0 len
let peekWithoutBlocking conn =
String.sub conn.buffer 0 conn.length
(****)
(* Low-level outputs *)
let rec sendOutput conn =
catchIoErrors
(fun () ->
begin if conn.opened then
Lwt_unix.write conn.channel conn.buffer 0 conn.length
else
Lwt.return conn.length
end >>= fun len ->
debugV (fun() ->
Util.msg "dump: %s\n"
(String.escaped (String.sub conn.buffer 0 len)));
emittedBytes := !emittedBytes +. float len;
conn.length <- conn.length - len;
if conn.length > 0 then
String.blit
conn.buffer len conn.buffer 0 conn.length;
Lwt.return ())
let rec fillBuffer2 conn s pos len =
if conn.length = bufferSize then
sendOutput conn >>= fun () ->
fillBuffer2 conn s pos len
else begin
let l = min (len - pos) (bufferSize - conn.length) in
Bytearray.blit_to_string s pos conn.buffer conn.length l;
conn.length <- conn.length + l;
if pos + l < len then
fillBuffer2 conn s (pos + l) len
else
Lwt.return ()
end
let rec fillBuffer conn l =
match l with
(s, pos, len) :: rem ->
assert (pos >= 0);
assert (len >= 0);
assert (pos <= Bytearray.length s - len);
fillBuffer2 conn s pos len >>= fun () ->
fillBuffer conn rem
| [] ->
Lwt.return ()
let rec flushBuffer conn =
if conn.length > 0 then
sendOutput conn >>= fun () ->
flushBuffer conn
else
Lwt.return ()
(****)
(* Output scheduling *)
type kind = Normal | Idle | Last | Urgent
type outputQueue =
{ mutable available : bool;
mutable canWrite : bool;
mutable flowControl : bool;
writes : (kind * (unit -> unit Lwt.t) * unit Lwt.t) Queue.t;
urgentWrites : (kind * (unit -> unit Lwt.t) * unit Lwt.t) Queue.t;
idleWrites : (kind * (unit -> unit Lwt.t) * unit Lwt.t) Queue.t;
flush : outputQueue -> unit Lwt.t }
let rec performOutputRec q (kind, action, res) =
action () >>= fun () ->
Lwt.wakeup res ();
popOutputQueues q
and popOutputQueues q =
if not (Queue.is_empty q.urgentWrites) then
performOutputRec q (Queue.take q.urgentWrites)
else if not (Queue.is_empty q.writes) && q.canWrite then
performOutputRec q (Queue.take q.writes)
else if not (Queue.is_empty q.idleWrites) && q.canWrite then
performOutputRec q (Queue.take q.idleWrites)
else begin
q.available <- true;
(* Flush asynchronously the output *)
Lwt.ignore_result (q.flush q);
Lwt.return ()
end
(* Perform an output action in an atomic way *)
let performOutput q kind action =
if q.available && (kind = Urgent || q.canWrite) then begin
q.available <- false;
performOutputRec q (kind, action, Lwt.wait ())
end else begin
let res = Lwt.wait () in
Queue.add (kind, action, res)
(match kind with
Urgent -> q.urgentWrites
| Normal -> q.writes
| Idle -> q.idleWrites
| Last -> assert false);
res
end
let allowWrites q =
assert (not q.canWrite);
q.canWrite <- true;
q.available <- false;
(* We yield to let the receiving thread restart and to let some time
to the requests to be processed *)
Lwt.ignore_result (Lwt_unix.yield () >>= fun () -> popOutputQueues q)
let disableFlowControl q =
q.flowControl <- false;
if not q.canWrite then allowWrites q
let outputQueueIsEmpty q = q.available
let makeOutputQueue isServer flush =
{ available = true; canWrite = isServer; flowControl = true;
writes = Queue.create (); urgentWrites = Queue.create ();
idleWrites = Queue.create ();
flush = flush }
(****)
type connection =
{ inputBuffer : ioBuffer;
outputBuffer : ioBuffer;
outputQueue : outputQueue }
let maybeFlush pendingFlush q buf =
(* We return immediately if a flush is already scheduled, or if the
output buffer is already empty. *)
(* If we are doing flow control and we can write, we need to send
a write token even when the buffer is empty. *)
if
!pendingFlush || (buf.length = 0 && not (q.flowControl && q.canWrite))
then
Lwt.return ()
else begin
pendingFlush := true;
(* Wait a bit, in case there are some new requests being processed *)
Lwt_unix.yield () >>= fun () ->
pendingFlush := false;
(* If there are other writes scheduled, we do not flush yet *)
if outputQueueIsEmpty q then begin
performOutput q Last
(fun () ->
if q.flowControl then begin
debugE (fun() -> Util.msg "Sending write token\n");
q.canWrite <- false;
fillBuffer buf [encodeInt 0] >>= fun () ->
flushBuffer buf
end else
flushBuffer buf) >>= fun () ->
Lwt.return ()
end else
Lwt.return ()
end
let makeConnection isServer inCh outCh =
let pendingFlush = ref false in
let outputBuffer = makeBuffer outCh in
{ inputBuffer = makeBuffer inCh;
outputBuffer = outputBuffer;
outputQueue =
makeOutputQueue isServer
(fun q -> maybeFlush pendingFlush q outputBuffer) }
(* Send message [l] *)
let dump conn l =
performOutput
conn.outputQueue Normal (fun () -> fillBuffer conn.outputBuffer l)
(* Send message [l] when idle *)
let dumpIdle conn l =
performOutput
conn.outputQueue Idle (fun () -> fillBuffer conn.outputBuffer l)
(* Send message [l], even if write are disabled. This is used for
aborting rapidly a stream. This works as long as only one small
message is written at a time (the write will succeed as the pipe
will not be full) *)
let dumpUrgent conn l =
performOutput conn.outputQueue Urgent
(fun () ->
fillBuffer conn.outputBuffer l >>= fun () ->
flushBuffer conn.outputBuffer)
(****)
(* Initialize the connection *)
let setupIO isServer inCh outCh =
makeConnection isServer inCh outCh
(* 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
let safeMarshal marshalPayload tag data rem =
let (rem', length) = marshalPayload data rem in
let l = Bytearray.length tag in
debugE (fun() ->
let start = first_chars (min length 10) rem' in
let start = if length > 10 then start ^ "..." else start in
let start = String.escaped start in
Util.msg "send [%s] '%s' %d bytes\n"
(Bytearray.to_string tag) start length);
(encodeInt (l + length) :: (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. *)
let connectionsByHosts = ref []
(* Gets the Read/Write file descriptors for a host;
the connection must have been set up by canonizeRoot before calling *)
let hostConnection host =
try Safelist.assoc host !connectionsByHosts
with Not_found ->
raise(Util.Fatal "Remote.hostConnection")
(* connectedHosts is a list of command-line roots and their corresponding
canonical host names.
Local command-line roots are not in the list.
Although there can only be one remote host per sync, it's possible
connectedHosts to hold more than one hosts if more than one sync is
performed.
It's also possible for there to be two connections open for the
same canonical root.
*)
let connectedHosts = ref []
(**********************************************************************
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 intSize in
grab conn.inputBuffer int_buf intSize >>= (fun () ->
let length = decodeInt int_buf 0 in
assert (length >= 0);
(* Get packet *)
let buf = Bytearray.create length in
grab conn.inputBuffer 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 serverstream =
connection -> Bytearray.t -> unit
let serverStreams = ref (Util.StringMap.empty : serverstream Util.StringMap.t)
type header =
NormalResult
| TransientExn of string
| FatalExn of string
| Request of string
| Stream of string
| StreamAbort
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, intSize) :: marshalHeader NormalResult (marshal [])))
(function
Util.Transient s ->
debugE (fun () ->
Util.msg "Sending transient exception (id: %d)\n" (decodeInt id 0));
dump conn ((id, 0, intSize) :: marshalHeader (TransientExn s) [])
| Util.Fatal s ->
debugE (fun () ->
Util.msg "Sending fatal exception (id: %d)\n" (decodeInt id 0));
dump conn ((id, 0, intSize) :: marshalHeader (FatalExn s) [])
| e ->
Lwt.fail e)
let streamAbortedSrc = ref 0
let streamAbortedDst = ref false
let streamError = Hashtbl.create 7
let abortStream conn id =
if not !streamAbortedDst then begin
streamAbortedDst := true;
let request = encodeInt id :: marshalHeader StreamAbort [] in
dumpUrgent conn request
end else
Lwt.return ()
let processStream conn id cmdName buf =
let id = decodeInt id 0 in
if Hashtbl.mem streamError id then
abortStream conn id
else begin
begin try
let cmd =
try Util.StringMap.find cmdName !serverStreams
with Not_found -> raise (Util.Fatal (cmdName ^ " not registered!"))
in
cmd conn buf;
Lwt.return ()
with e ->
Hashtbl.add streamError id e;
abortStream conn id
end
end
(* Message ids *)
type msgId = int
module MsgIdMap = Map.Make (struct type t = msgId let compare = compare end)
(* An integer just a little smaller than the maximum representable in
30 bits *)
let hugeint = 1000000000
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 =
begin
debugE (fun () -> Util.msg "Waiting for next message\n");
(* Get the message ID *)
let id = Bytearray.create intSize in
grab conn.inputBuffer id intSize >>= (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.outputQueue;
receive conn
end else begin
debugE
(fun () -> Util.msg "Message received (id: %d)\n" num_id);
(* 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
| Stream cmdName ->
receivePacket conn >>= fun buf ->
processStream conn id cmdName buf >>= fun () ->
receive conn
| StreamAbort ->
streamAbortedSrc := num_id;
receive conn
end)
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 ::
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
let streamReg = Lwt_util.make_region 1
let streamingActivated =
Prefs.createBool "stream" true
("!use a streaming protocol for transferring file contents")
"When this preference is set, Unison will use an experimental \
streaming protocol for transferring file contents more efficiently. \
The default value is \\texttt{true}."
let registerStreamCmd
(cmdName : string)
marshalingFunctionsArgs
(serverSide : connection -> 'a -> unit)
=
let cmd =
registerSpecialServerCmd
cmdName marshalingFunctionsArgs defaultMarshalingFunctions
(fun conn v -> serverSide conn v; Lwt.return ())
in
let ping =
registerServerCmd (cmdName ^ "Ping")
(fun conn (id : int) ->
try
let e = Hashtbl.find streamError id in
Hashtbl.remove streamError id;
streamAbortedDst := false;
Lwt.fail e
with Not_found ->
Lwt.return ())
in
(* Check that this command name has not already been bound *)
if (Util.StringMap.mem cmdName !serverStreams) then
raise (Util.Fatal (cmdName ^ " already registered!"));
(* Create marshaling and unmarshaling functions *)
let ((marshalArgs,unmarshalArgs) : 'a marshalingFunctions) =
makeMarshalingFunctions marshalingFunctionsArgs (cmdName ^ "-str") in
(* Create a server function and remember it *)
let server conn buf =
let args = unmarshalArgs buf in
serverSide conn args
in
serverStreams := Util.StringMap.add cmdName server !serverStreams;
(* Create a client function and return it *)
let client conn id serverArgs =
debugE (fun () -> Util.msg "Sending stream chunk (id: %d)\n" id);
if !streamAbortedSrc = id then raise (Util.Transient "Streaming aborted");
let request =
encodeInt id ::
marshalHeader (Stream cmdName) (marshalArgs serverArgs [])
in
dumpIdle conn request
in
fun conn sender ->
if not (Prefs.read streamingActivated) then
sender (fun v -> cmd conn v)
else begin
(* At most one active stream at a time *)
let id = newMsgId () in (* Message ID *)
Lwt.try_bind
(fun () ->
Lwt_util.run_in_region streamReg 1
(fun () -> sender (fun v -> client conn id v)))
(fun v -> ping conn id >>= fun () -> Lwt.return v)
(fun e ->
debugE (fun () ->
Util.msg "Pinging remote end after streaming error\n");
ping conn id >>= fun () -> Lwt.fail e)
end
let commandAvailable =
registerRootCmd "commandAvailable"
(fun (_, cmdName) -> Lwt.return (Util.StringMap.mem cmdName !serverCmds))
(****************************************************************************
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.inputBuffer buffer 1 >>= (fun () ->
if buffer.{0} <> connectionHeader.[pos] then
let prefix =
String.sub connectionHeader 0 pos ^ Bytearray.to_string buffer in
let rest = peekWithoutBlocking conn.inputBuffer 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 halfduplex =
Prefs.createBool "halfduplex" false
"!force half-duplex communication with the server"
"When this flag is set to {\\tt true}, Unison network communication \
is forced to be half duplex (the client and the server never \
simultaneously emit data). If you experience unstabilities with \
your network link, this may help. The communication is always \
half-duplex when synchronizing with a Windows machine due to a \
limitation of Unison current implementation that could result \
in a deadlock."
let negociateFlowControlLocal conn () =
disableFlowControl conn.outputQueue;
Lwt.return false
let negociateFlowControlRemote =
registerServerCmd "negociateFlowControl" negociateFlowControlLocal
let negociateFlowControl conn =
(* Flow control negociation can be done asynchronously. *)
if not (Prefs.read halfduplex) then
Lwt.ignore_result
(negociateFlowControlRemote conn () >>= fun needed ->
if not needed then
negociateFlowControlLocal conn ()
else
Lwt.return true)
(****)
let initConnection in_ch out_ch =
let conn = setupIO false in_ch out_ch in
checkHeader
conn (Bytearray.create 1) 0 (String.length connectionHeader) >>= (fun () ->
Lwt.ignore_result (receive conn);
negociateFlowControl conn;
Lwt.return conn)
let rec findFirst f l =
match l with
[] -> Lwt.return None
| x :: r -> f x >>= fun v ->
match v with
None -> findFirst f r
| Some _ as v -> Lwt.return v
let printAddr host addr =
match addr with
Unix.ADDR_UNIX s ->
assert false
| Unix.ADDR_INET (s, p) ->
Format.sprintf "%s[%s]:%d" host (Unix.string_of_inet_addr s) p
let buildSocket host port kind =
let attemptCreation ai =
Lwt.catch
(fun () ->
let socket =
Lwt_unix.socket
ai.Unix.ai_family ai.Unix.ai_socktype ai.Unix.ai_protocol
in
Lwt.catch
(fun () ->
begin match kind with
`Connect ->
(* Connect (synchronously) to the remote host *)
Lwt_unix.connect socket ai.Unix.ai_addr
| `Bind ->
(* Allow reuse of local addresses for bind *)
Lwt_unix.setsockopt socket Unix.SO_REUSEADDR true;
(* Bind the socket to portnum on the local host *)
Lwt_unix.bind socket ai.Unix.ai_addr;
(* Start listening, allow up to 1 pending request *)
Lwt_unix.listen socket 1;
Lwt.return ()
end >>= fun () ->
Lwt.return (Some socket))
(fun e ->
match e with
Unix.Unix_error _ ->
Lwt_unix.close socket;
Lwt.fail e
| _ ->
Lwt.fail e))
(fun e ->
match e with
Unix.Unix_error (error, _, _) ->
begin match error with
Unix.EAFNOSUPPORT | Unix.EPROTONOSUPPORT | Unix.EINVAL ->
()
| _ ->
let msg =
match kind with
`Connect ->
Printf.sprintf "Can't connect to server %s: %s\n"
(printAddr host ai.Unix.ai_addr)
(Unix.error_message error)
| `Bind ->
Printf.sprintf
"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)
in
Util.warn msg
end;
Lwt.return None
| _ ->
Lwt.fail e)
in
let options =
match kind with
`Connect -> [ Unix.AI_SOCKTYPE Unix.SOCK_STREAM ]
| `Bind -> [ Unix.AI_SOCKTYPE Unix.SOCK_STREAM ; Unix.AI_PASSIVE ]
in
findFirst attemptCreation (Unix.getaddrinfo host port options) >>= fun res ->
match res with
Some socket ->
Lwt.return socket
| None ->
let msg =
match kind with
`Connect ->
Printf.sprintf
"Failed to connect to the server on host %s:%s" host port
| `Bind ->
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
in
Lwt.fail (Util.Fatal msg)
let buildSocketConnection host port =
buildSocket host port `Connect >>= fun socket ->
initConnection socket socket
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) = Lwt_unix.pipe_out () in
let (i2,o2) = Lwt_unix.pipe_in () 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. *)
Lwt_unix.set_close_on_exec i2;
Lwt_unix.set_close_on_exec o1;
(* We add CYGWIN=binmode to the environment before calling
ssh because the cygwin implementation on Windows sometimes
puts the pipe in text mode (which does end of line
translation). Specifically, if unison is invoked from
a DOS command prompt or other non-cygwin context, the pipe
goes into text mode; this does not happen if unison is
invoked from cygwin's bash. By setting CYGWIN=binmode
we force the pipe to remain in binary mode. *)
System.putenv "CYGWIN" "binmode";
debug (fun ()-> Util.msg "Shell connection: %s (%s)\n"
shellCmd (String.concat ", " args));
let term =
Util.convertUnixErrorsToFatal "starting shell connection" (fun () ->
match termInteract with
None ->
ignore (System.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 canonizeLocally s unicode =
(* We need to select the proper API in order to compute correctly the
canonical fspath *)
Fs.setUnicodeEncoding unicode;
Fspath.canonize s
let canonizeOnServer =
registerServerCmd "canonizeOnServer"
(fun _ (s, unicode) ->
Lwt.return (Os.myCanonicalHostName (), canonizeLocally s unicode))
let canonize clroot = (* connection for clroot must have been set up already *)
match clroot with
Clroot.ConnectLocal s ->
(Common.Local, canonizeLocally s (Case.useUnicodeAPI ()))
| _ ->
match
try
Some (Safelist.assoc clroot !connectedHosts)
with Not_found ->
None
with
None -> raise (Util.Fatal "Remote.canonize")
| Some (h, fspath, _) -> (Common.Remote h, fspath)
let listReplace v l = v :: Safelist.remove_assoc (fst v) l
let rec hostFspath clroot =
try
let (_, _, ioServer) = Safelist.assoc clroot !connectedHosts in
Some (Lwt.return ioServer)
with Not_found ->
None
let canonizeRoot rootName clroot termInteract =
let unicode = Case.useUnicodeAPI () in
let finish ioServer s =
(* We need to always compute the fspath as it depends on
unicode settings *)
canonizeOnServer ioServer (s, unicode) >>= (fun (host, fspath) ->
connectedHosts :=
listReplace (clroot, (host, fspath, ioServer)) !connectedHosts;
connectionsByHosts := listReplace (host, ioServer) !connectionsByHosts;
Lwt.return (Common.Remote host,fspath)) in
match clroot with
Clroot.ConnectLocal s ->
Lwt.return (Common.Local, canonizeLocally s unicode)
| Clroot.ConnectBySocket(host,port,s) ->
begin match hostFspath clroot with
Some x -> x
| None -> buildSocketConnection host port
end >>= fun ioServer ->
finish ioServer s
| Clroot.ConnectByShell(shell,host,userOpt,portOpt,s) ->
begin match hostFspath clroot with
Some x -> x
| None -> buildShellConnection
shell host userOpt portOpt rootName termInteract
end >>= fun ioServer ->
finish ioServer s
(* A new interface, useful for terminal interaction, it should
eventually replace canonizeRoot and buildShellConnection *)
(* 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
* Lwt_unix.file_descr
* Lwt_unix.file_descr
* Unix.file_descr
* string option
* Lwt_unix.file_descr option
* Clroot.clroot
* int)
let openConnectionStart clroot =
match clroot with
Clroot.ConnectLocal s ->
None
| Clroot.ConnectBySocket(host,port,s) ->
Lwt_unix.run
(begin match hostFspath clroot with
Some x -> x
| None -> buildSocketConnection host port
end >>= fun ioServer ->
(* We need to always compute the fspath as it depends on
unicode settings *)
let unicode = Case.useUnicodeAPI () in
canonizeOnServer ioServer (s, unicode) >>= fun (host, fspath) ->
connectedHosts :=
listReplace (clroot, (host, fspath, ioServer)) !connectedHosts;
connectionsByHosts :=
listReplace (host, ioServer) !connectionsByHosts;
Lwt.return ());
None
| Clroot.ConnectByShell(shell,host,userOpt,portOpt,s) ->
match hostFspath clroot with
Some x ->
let unicode = Case.useUnicodeAPI () in
(* We recompute the fspath as it may have changed due to
unicode settings *)
Lwt_unix.run
(x >>= fun ioServer ->
canonizeOnServer ioServer (s, unicode) >>= fun (host, fspath) ->
connectedHosts :=
listReplace (clroot, (host, fspath, ioServer)) !connectedHosts;
connectionsByHosts :=
listReplace (host, ioServer) !connectionsByHosts;
Lwt.return ());
None
| None ->
let remoteCmd =
(if Prefs.read serverCmd="" then Uutil.myName
else Prefs.read serverCmd)
^ (if Prefs.read addversionno then "-" ^ Uutil.myMajorVersion else "")
^ " -server" in
let userArgs =
match userOpt with
None -> []
| Some user -> ["-l"; user] in
let portArgs =
match portOpt with
None -> []
| Some port -> ["-p"; port] in
let shellCmd =
(if shell = "ssh" then
Prefs.read sshCmd
else if shell = "rsh" then
Prefs.read rshCmd
else
shell) in
let shellCmdArgs =
(if shell = "ssh" then
Prefs.read sshargs
else if shell = "rsh" then
Prefs.read rshargs
else
"") in
let preargs =
([shellCmd]@userArgs@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) = Lwt_unix.pipe_out() in
let (i2,o2) = Lwt_unix.pipe_in() 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. *)
Lwt_unix.set_close_on_exec i2;
Lwt_unix.set_close_on_exec o1;
(* We add CYGWIN=binmode to the environment before calling
ssh because the cygwin implementation on Windows sometimes
puts the pipe in text mode (which does end of line
translation). Specifically, if unison is invoked from
a DOS command prompt or other non-cygwin context, the pipe
goes into text mode; this does not happen if unison is
invoked from cygwin's bash. By setting CYGWIN=binmode
we force the pipe to remain in binary mode. *)
System.putenv "CYGWIN" "binmode";
debug (fun ()-> Util.msg "Shell connection: %s (%s)\n"
shellCmd (String.concat ", " args));
let (term,pid) =
Terminal.create_session shellCmd argsarray i1 o2 Unix.stderr in
(* after terminal interact, remember to close i1 and o2 *)
Some(i1,i2,o1,o2,s,term,clroot,pid)
let openConnectionPrompt = function
(i1,i2,o1,o2,s,Some fdTerm,clroot,pid) ->
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 until everything is written... *)
ignore (Lwt_unix.run (Lwt_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;
Lwt_unix.run
(initConnection i2 o1 >>= fun ioServer ->
let unicode = Case.useUnicodeAPI () in
canonizeOnServer ioServer (s, unicode) >>= fun (host, fspath) ->
connectedHosts :=
listReplace (clroot, (host, fspath, ioServer)) !connectedHosts;
connectionsByHosts :=
listReplace (host, ioServer) !connectionsByHosts;
Lwt.return ())
let openConnectionCancel (i1,i2,o1,o2,s,fdopt,clroot,pid) =
try Unix.kill pid Sys.sigkill with Unix.Unix_error _ -> ();
try Unix.close i1 with Unix.Unix_error _ -> ();
try Lwt_unix.close i2 with Unix.Unix_error _ -> ();
try Lwt_unix.close o1 with Unix.Unix_error _ -> ();
try Unix.close o2 with Unix.Unix_error _ -> ();
match fdopt with
None -> ()
| Some fd -> (try Lwt_unix.close fd with Unix.Unix_error _ -> ())
(****************************************************************************)
(* 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 true in_ch out_ch in
Lwt.catch
(fun e ->
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))
(fun e ->
match e with
Util.Fatal "Lost connection with the server" ->
debug (fun () -> Util.msg "Connection closed by the client\n");
(* We prevents new writes and wait for any current write to
terminate. As we don't have a good way to wait for the
writer to terminate, we just yield a bit. *)
let rec wait n =
if n = 0 then Lwt.return () else begin
Lwt_unix.yield () >>= fun () ->
wait (n - 1)
end
in
conn.outputBuffer.opened <- false;
wait 10
| _ ->
Lwt.fail e)
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 listening = Lwt_unix.run (buildSocket host port `Bind) in
Util.msg "server started\n";
let rec handleClients () =
let (connected, _) =
Lwt_unix.run (Lwt_unix.accept listening)
in
Lwt_unix.setsockopt connected Unix.SO_KEEPALIVE true;
begin try
(* Accept a connection *)
Lwt_unix.run (commandLoop connected connected)
with Util.Fatal "Lost connection with the server" -> () end;
(* The client has closed its end of the connection *)
begin try Lwt_unix.close connected with Unix.Unix_error _ -> () end;
if not (Prefs.read killServer) then handleClients ()
in
handleClients ())
let beAServer () =
begin try
let home = System.getenv "HOME" in
Util.convertUnixErrorsToFatal
"changing working directory"
(fun () -> System.chdir (System.fspathFromString home))
with Not_found ->
Util.msg
"Environment variable HOME unbound: \
executing server in current directory\n"
end;
Lwt_unix.run
(commandLoop
(Lwt_unix.of_unix_file_descr Unix.stdin)
(Lwt_unix.of_unix_file_descr Unix.stdout))
unison-2.48.3/remote.mli 000644 000766 000000 00000011006 12450317305 016032 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/remote.mli *)
(* Copyright 1999-2015, 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 *)
(* Test whether a command exits on some root *)
val commandAvailable :
Common.root -> (* root *)
string -> (* command name *)
bool Lwt.t
(* 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 intSize : int
val encodeInt : int -> Bytearray.t * int * int
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 *)
val streamingActivated : bool Prefs.t
val registerStreamCmd :
string ->
('a ->
(Bytearray.t * int * int) list -> (Bytearray.t * int * int) list * int) *
(Bytearray.t -> int -> 'a) ->
(connection -> 'a -> unit) ->
connection -> (('a -> unit Lwt.t) -> 'b Lwt.t) -> 'b Lwt.t
unison-2.48.3/ROADMAP.txt 000644 000766 000000 00000005677 10454343354 015706 0 ustar 00bcpierce wheel 000000 000000 FINDING 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.48.3/sortri.ml 000644 000766 000000 00000011633 12450317305 015716 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/sortri.ml *)
(* Copyright 1999-2015, 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.path1)
let shouldSortLast ri =
Pred.test sortlast (Path.toString ri.path1)
let newItem ri =
let newItem1 ri =
match ri.replicas with
Different diff -> diff.rc1.status = `Created
| _ -> false in
let newItem2 ri =
match ri.replicas with
Different diff -> diff.rc2.status = `Created
| _ -> 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 partiallyProblematic;
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.path1) (Path.toString ri2.path1) cmp);
cmp
let sortReconItems items = Safelist.stable_sort (compareReconItems()) items
unison-2.48.3/sortri.mli 000644 000766 000000 00000001474 12450317305 016071 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/sortri.mli *)
(* Copyright 1999-2015, 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.48.3/stasher.ml 000644 000766 000000 00000051626 12450317305 016053 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/stasher.ml *)
(* $I2: Last modified by lescuyer *)
(* Copyright 1999-2015, 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 (System.getenv "UNISONBACKUPDIR"))
with Not_found ->
try Fspath.canonize (Some (System.getenv "UNISONMIRRORDIR"))
with Not_found ->
if Prefs.read backupdir <> ""
then Fspath.canonize (Some (Prefs.read backupdir))
else Fspath.canonize
(Some (System.fspathToString (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.toDebugString sFspath) (Path.toString backdir));
if not (Os.exists sFspath Path.empty) then
Os.createDir sFspath Path.empty Props.dirDefault;
match Path.deconstructRev backdir with
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 false 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.toDebugString sFspath) (Path.toString path0)
(Fspath.toDebugString fspath) (Path.toString path)
(showContent sourceTyp fspath path));
None
end else begin
debug (fun()-> Util.msg
"stashed [%s / %s] = %s is not equal to new [%s / %s] = %s (or one is a dir): stash!\n"
(Fspath.toDebugString sFspath) (Path.toString path0)
(showContent path0Typ sFspath path0)
(Fspath.toDebugString 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]) arch =
debug (fun () -> Util.msg
"backup: %s / %s\n"
(Fspath.toDebugString fspath)
(Path.toString path));
Util.convertUnixErrorsToTransient "backup" (fun () ->
let (workingDir,realPath) = Fspath.findWorkingDir fspath path in
let disposeIfNeeded() =
if finalDisposition = `AndRemove then
Os.delete workingDir realPath in
if not (Os.exists workingDir realPath) then
debug (fun () -> Util.msg
"File %s in %s does not exist, so no need to back up\n"
(Path.toString path) (Fspath.toDebugString fspath))
else if shouldBackup path then begin
match backupPath fspath path with
None -> disposeIfNeeded()
| Some (backRoot, backPath) ->
debug (fun () -> Util.msg "Backing up %s / %s to %s in %s\n"
(Fspath.toDebugString fspath) (Path.toString path)
(Path.toString backPath) (Fspath.toDebugString backRoot));
let byCopying() =
Copy.recursively fspath path backRoot backPath;
disposeIfNeeded() in
begin if finalDisposition = `AndRemove then
try
(*FIX: this does the wrong thing with followed symbolic links!*)
Os.rename "backup" workingDir realPath backRoot backPath
with Util.Transient _ ->
debug (fun () -> Util.msg "Rename failed -- copying instead\n");
byCopying()
else
byCopying()
end;
Update.iterFiles backRoot backPath arch Xferhint.insertEntry
end else begin
debug (fun () -> Util.msg "Path %s / %s does not need to be backed up\n"
(Fspath.toDebugString 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.toDebugString 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)
let _ =
Update.setStasherFun (fun fspath path -> stashCurrentVersion fspath path None)
(*------------------------------------------------------------------------------------*)
(* 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.toDebugString 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 &&
(* FIX: should check that the existing file has the same size, to
avoid computing the fingerprint if it is obviously going to be
different... *)
(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.toDebugString dir));
Some (Fspath.concat dir path)
end else
if i = Prefs.read maxbackups then begin
debug (fun () ->
Util.msg "No recent version was available for %s on this root.\n"
(Fspath.toDebugString (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.48.3/stasher.mli 000644 000766 000000 00000002564 11322371212 016213 0 ustar 00bcpierce wheel 000000 000000 (* 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 else
deleted if no backup is needed. *)
val backup:
Fspath.t -> Path.local ->
[`AndRemove | `ByCopying] -> Update.archive -> 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.48.3/strings.ml 000644 000766 000000 00001105250 12467142505 016073 0 ustar 00bcpierce wheel 000000 000000 (* DO NOT MODIFY.
This file has been automatically generated, see docs.ml. *)
let docs =
("about", ("About Unison",
"Unison File Synchronizer\n\
Version 2.48.3\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.), uni-directional\n\
\032 mirroring utilities (rsync (http://samba.anu.edu.au/rsync/), etc.), and\n\
\032 other synchronizers (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 (OSX,\n\
\032 Solaris, Linux, etc.) systems. Moreover, Unison works across\n\
\032 platforms, allowing you to synchronize a Windows laptop with a Unix\n\
\032 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 replicas\n\
\032 and its own private structures in a sensible state at all times,\n\
\032 even in case of abnormal termination or communication 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 based on\n\
\032 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 many\n\
\032 people and will generally get high priority. Other bug reports will be\n\
\032 looked at as time permits. Bugs should be reported to the users list at\n\
\032 unison-users@yahoogroups.com (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 held\n\
\032 to high standards of clear design and clean coding.) If you want to\n\
\032 contribute to Unison, start by downloading the developer tarball from\n\
\032 the download page. For some details on how the code is organized, etc.,\n\
\032 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 under\n\
\032 the terms of the GNU General Public License as published by the Free\n\
\032 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. Pre-built\n\
\032 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 (on\n\
\032 Linux/Windows) or the native UI framework (on OSX).\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 path\n\
\032 (if you're going to invoke it from the command line) or on your desktop\n\
\032 (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 directories\n\
\032 on a single machine, with a remote machine over a direct socket\n\
\032 connection, or with a remote machine using ssh for authentication and\n\
\032 secure transfer. If you intend to use the last option, you may need to\n\
\032 install ssh; see the section \"Installing Ssh\" .\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 new\n\
\032 version of Unison will sometimes introduce a different format for the\n\
\032 archive files used to remember information about the previous state of\n\
\032 the replicas. In this case, the old archive will be ignored (not\n\
\032 deleted -- if you roll back to the previous version of Unison, you will\n\
\032 find the old archives intact), which means that any differences between\n\
\032 the replicas will show up as conflicts that need to be resolved\n\
\032 manually.\n\
\n\
Building Unison from Scratch\n\
\n\
\032 If a pre-built image is not available, you will need to compile it from\n\
\032 scratch; the sources are available from the same place as the 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 Unison can be built with or without a graphical user interface (GUI).\n\
\032 The build system will decide automatically depending on the libraries\n\
\032 installed on your system, but you can also type make UISTYLE=text to\n\
\032 build Unison without GUI.\n\
\n\
\032 You'll need the Objective Caml compiler, available from\n\
\032 http://caml.inria.fr. OCaml is available from most package managers\n\
\032 Building and installing OCaml on Unix systems is very straightforward;\n\
\032 just follow the instructions in the distribution. You'll probably want\n\
\032 to build the native-code compiler in addition to the bytecode compiler,\n\
\032 as Unison runs much faster when compiled to native code, but this is\n\
\032 not absolutely necessary. (Quick start: on many systems, the following\n\
\032 sequence of commands will get you a working and installed compiler:\n\
\032 first do make 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\
\032 Unison's build system is not parallelizable, so don't use make flags\n\
\032 which cause it to start processes in parallel, e.g. -j for GNU make.\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 some additional things:\n\
\032 * The Gtk2 development libraries (package libgtk2.0-dev on debian\n\
\032 based systems).\n\
\032 * OCaml bindings for Gtk2. Install them from your software\n\
\032 repositories (package liblablgtk2-ocaml on debian based systems).\n\
\032 Also available from\n\
\032 http://wwwfun.kurims.kyoto-u.ac.jp/soft/olabl/lablgtk.html.\n\
\032 * Pango, a text rendering library and a part of Gtk2. On some systems\n\
\032 (e.g. Ubuntu) the bindings between Pango and OCaml need to be\n\
\032 installed explicitly (package liblablgtk-extras-ocaml-dev on\n\
\032 Ubuntu).\n\
\n\
\032 Type make to build Unison. If Gtk2 is available on the system, Unison\n\
\032 with a GUI will be built 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. Or\n\
\032 just type make install to install Unison to $HOME/bin/unison.\n\
\n\
Mac OS X\n\
\n\
\032 To build the text-only user interface, follow the instructions above\n\
\032 for building on Unix systems. You should do this first, even if you are\n\
\032 also planning on building the GUI, just to make sure it works.\n\
\n\
\032 To build the basic GUI version, you'll first need to download and\n\
\032 install the XCode developer tools from Apple. Once this is done, just\n\
\032 type make UISTYLE=macnew in the src directory, and if things go well\n\
\032 you should get an application that you can move from\n\
\032 uimacnew/build/Default/Unison.app to wherever you want it.\n\
\n\
\032 There is also an experimental GUI with a somewhat smoother look and\n\
\032 feel. To compile this one (once you've got the basic one working),\n\
\032 proceed as follows:\n\
\032 1. Go to the uimacnew09 directory and double-click the file\n\
\032 BWToolkit.ibplugin.\n\
\032 2. Go back up to the src directory and type make UISTYLE=macnew09.\n\
\032 3. You should get an application built for you at\n\
\032 uimacnew09/build/Default/Unison.app.\n\
\n\
Windows\n\
\n\
\032 Although the binary distribution should work on any version of Windows,\n\
\032 some people may want to build Unison from scratch on those 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 called\n\
\032 unison.exe.\n\
\n\
Native version:\n\
\n\
\032 Building a more efficient, native version of Unison on Windows requires\n\
\032 a little more work. See the file INSTALL.win32 in the source code\n\
\032 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 been\n\
\032 selected as default when the executable you are running was built. You\n\
\032 can force the text interface even if graphical is the default by adding\n\
\032 -ui text. The other command-line arguments to both versions are\n\
\032 identical.\n\
\n\
\032 The graphical version can also be run directly by clicking on its icon,\n\
\032 but this may require a little set-up (see the section \"Click-starting\n\
\032 Unison\" ). For this tutorial, we assume that you're starting it from\n\
\032 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 and/or\n\
\032 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 (You may need to add -ui text, depending how your unison binary was\n\
\032 built.)\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 replica,\n\
\032 and that the default action is therefore to propagate the new version\n\
\032 to the first replica. To follow Unison's recommendation, press the \"f\"\n\
\032 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 Unison\n\
\032 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 same\n\
\032 (as with the file b), then no propagation is necessary and nothing is\n\
\032 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 overridden 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 force\n\
\032 the change to be propagated from right to left or from left to\n\
\032 right, or else press \"/\" to skip this file and leave both replicas\n\
\032 alone. When it reaches the end of the list of modified files,\n\
\032 Unison will ask you one more time whether it should proceed with\n\
\032 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 annotated\n\
\032 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. But\n\
\032 some flexibility on the version of Unison at the client side can be\n\
\032 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\" process\n\
\032 on the server) and also more secure (especially if you use 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 http://www.openssh.org. See\n\
\032 section [1]A.2 for installation 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 ssh documentation for information on\n\
\032 how to set this up. The examples in this section use ssh, but you can\n\
\032 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 something\n\
\032 is wrong with your ssh setup (e.g., \"permission denied\") or else the\n\
\032 search path that's being used when executing commands on the server\n\
\032 doesn't contain the unison executable (e.g., \"command not 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 from\n\
\032 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\
\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 for\n\
\032 the ssh program using the \"-sshcmd\" option. Extra arguments can be\n\
\032 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 is\n\
\032 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, to\n\
\032 do this they must understand the protocol that Unison uses to\n\
\032 communicate between client and server, but all they need for this is\n\
\032 a copy of the Unison sources.) The socket method is provided only\n\
\032 for expert users with specific needs; everyone else should use the\n\
\032 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 and\n\
\032 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 already\n\
\032 in use, Unison will exit with an error message.) Note that paths\n\
\032 specified by the client will be interpreted relative to the directory\n\
\032 in which you start the server process; this behavior is different from\n\
\032 the ssh case, where the path is relative to your home directory on the\n\
\032 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 from\n\
\032 the client to the server (a.tmp will be created on the server in the\n\
\032 directory that the server was started from). After finishing the first\n\
\032 synchronization, change a few files and try synchronizing again. You\n\
\032 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 to\n\
\032 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 treat\n\
\032 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\
\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\
\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 operation\n\
\032 typically needs to be initiated from the machine with the most recent\n\
\032 changes. the section \"Profile\" covers the syntax of Unison profiles,\n\
\032 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 mailing\n\
\032 lists, to receive announcements of new versions. See the section\n\
\032 \"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 assumed\n\
\032 to be file:. Under Windows, it is possible to synchronize with a remote\n\
\032 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 that\n\
\032 the path separator character is always a forward slash, no matter what\n\
\032 operating system Unison is running on. Forward slashes are converted to\n\
\032 backslashes as necessary when paths are converted to filenames in the\n\
\032 local filesystem on a particular host. (For example, suppose that we\n\
\032 run Unison on a Windows system, synchronizing the local root c:\\pierce\n\
\032 with the root ssh://saul.cis.upenn.edu/home/bcpierce on a Unix server.\n\
\032 Then the path current/todo.txt refers to the file\n\
\032 c:\\pierce\\current\\todo.txt on the client and\n\
\032 /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 a\n\
\032 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 the\n\
\032 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 contents\n\
\032 are different from its contents the last time it was successfully\n\
\032 synchronized. Note that whether a path is updated has nothing to do\n\
\032 with its last modification time--Unison considers only the contents\n\
\032 when determining whether an update has occurred. This means that\n\
\032 touching a file without changing its contents will not be recognized as\n\
\032 an update. A file can even be changed several times and then changed\n\
\032 back to its original contents; as long as Unison is only run at the end\n\
\032 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 replica,\n\
\032 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 state\n\
\032 of each path in the replica when it was last synchronized) with the\n\
\032 current contents of the replica, to determine which paths have been\n\
\032 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 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 shortcoming\n\
\032 of the Posix filesystem API, cannot be); in particular, when it is\n\
\032 copying a file onto a directory or vice versa, it must first move the\n\
\032 original contents out of the way. If Unison gets interrupted during one\n\
\032 of these periods, some manual cleanup may be required. In this case, a\n\
\032 file called DANGER.README will be left in your home directory,\n\
\032 containing information about the operation that was interrupted. The\n\
\032 next time you try to run Unison, it will notice this file and warn you\n\
\032 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 not\n\
\032 changed; then, for each file that might have changed, it computes a\n\
\032 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 discovers\n\
\032 that it has propagated an out-of-date change, or that the file it is\n\
\032 updating has changed on the target replica, it will signal a failure\n\
\032 for that file. Run Unison again to propagate the latest change.\n\
\n\
\032 Changes to the ignore patterns from the user interface (e.g., using the\n\
\032 `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\" but will never\n\
\032 miss 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 over\n\
\032 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 write\"\n\
\032 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 if\n\
\032 Unison is performing some long-running operation, the display will\n\
\032 not be repainted until it finishes. We recommend not trying to do\n\
\032 anything with the user interface while Unison is in the middle of\n\
\032 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 ignored 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 the\n\
\032 local machine contains a file or subdirectory P that matches an\n\
\032 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 P\n\
\032 will be deleted. This is because Unison sees the rename as a delete\n\
\032 and a separate create: it deletes the old directory (including the\n\
\032 ignored files) and creates a new one (not including the ignored\n\
\032 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 a\n\
\032 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, if\n\
\032 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 (which\n\
\032 is used, for example, in calculating the name of the archive file used\n\
\032 to remember which files have been synchronized) normally uses the\n\
\032 gethostname operating system call. However, if the environment variable\n\
\032 UNISONLOCALHOSTNAME is set, its value will be used instead. This makes\n\
\032 it easier to use Unison in situations where a machine's name changes\n\
\032 frequently (e.g., because it is a laptop and 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 check\n\
\032 that things look reasonable--in particular, that update detection is\n\
\032 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-fat use appropriate options for FAT filesystems\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-nocreation xxx prevent file creations on one replica\n\
\032-nodeletion xxx prevent file deletions on one replica\n\
\032-noupdate xxx prevent file updates and deletions on one replica\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-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-clientHostName xxx set host name of client\n\
\032-confirmbigdel ask about whole-replica (or path) deletes (default true)\n\
\032-confirmmerge ask for confirmation before committing results of a merge\n\
\032-contactquietly suppress the 'contacting server' message during startup\n\
\032-copymax n maximum number of simultaneous copyprog transfers\n\
\032-copyonconflict keep copies of conflicting files\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/defa\n\
ult)\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 set 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-fastercheckUNSAFE skip computing fingerprints for new files (experts only!)\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-forcepartial xxx add a pattern to the forcepartial list\n\
\032-halfduplex force half-duplex communication with the server\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-ignorearchives ignore existing archive files\n\
\032-ignorecase xxx identify upper/lowercase filenames (true/false/default)\n\
\032-ignoreinodenumbers ignore inode number changes when detecting updates\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-links xxx allow the synchronization of symbolic links (true/false/defa\n\
ult)\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-maxerrors n maximum number of errors before a directory transfer is abor\n\
ted\n\
\032-maxsizethreshold n prevent transfer of files bigger than this (if >=0, in Kb)\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-nocreationpartial xxx add a pattern to the nocreationpartial list\n\
\032-nodeletionpartial xxx add a pattern to the nodeletionpartial list\n\
\032-noupdatepartial xxx add a pattern to the noupdatepartial list\n\
\032-numericids don't map uid/gid values by user/group names\n\
\032-prefer xxx choose this replica's version for conflicting changes\n\
\032-preferpartial xxx add a pattern to the preferpartial list\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-stream use a streaming protocol for transferring file contents (def\n\
ault true)\n\
\032-ui xxx select UI ('text' or 'graphic'); command-line only\n\
\032-unicode xxx assume Unicode encoding in case insensitive mode\n\
\032-watch when set, use a file watcher process to detect changes (defa\n\
ult true)\n\
\032-xferbycopying optimize transfers using local copies (default true)\n\
\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 was\n\
\032 told to load at the beginning of the run. Setting the preference\n\
\032 addprefsto filename makes Unison add new preferences to the file\n\
\032 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 remote\n\
\032 server command. This allows multiple binaries for different\n\
\032 versions of unison to coexist conveniently on the same server:\n\
\032 whichever version is run on the client, the same version will be\n\
\032 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 the\n\
\032 directory used to store backup files specified by the backup\n\
\032 preference, when backuplocation is set to central. It is checked\n\
\032 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 if\n\
\032 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 the\n\
\032 backup preference selects them--i.e., it selectively overrides\n\
\032 backup. The same caveats apply here as with ignore and\n\
\032 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 clientHostName xxx\n\
\032 When specified, the host name of the client will not be\n\
\032 guessedand the provided host name will be used to find the\n\
\032 archive.\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 text\n\
\032 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 may\n\
\032 be committed 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 is\n\
\032 not satisfactory. In batch-mode, this preference has no effect.\n\
\032 Default is false.\n\
\032 contactquietly\n\
\032 If this flag is set, Unison will skip displaying the `Contacting\n\
\032 server' message (which some users find annoying) during startup.\n\
\032 copymax n\n\
\032 A number indicating how many instances of the external copying\n\
\032 utility Unison is allowed to run simultaneously (default to 1).\n\
\032 copyonconflict\n\
\032 When this flag is set, Unison will make a copy of files that\n\
\032 would otherwise be overwritten or deleted in case of conflicting\n\
\032 changes, and more generally whenever the default behavior is\n\
\032 overriden. This makes it possible to automatically resolve\n\
\032 conflicts in a fairly safe way when synchronizing continuously,\n\
\032 in combination with the -repeat watch and -prefer newer\n\
\032 preferences.\n\
\032 copyprog xxx\n\
\032 A string giving the name of an external program that can be used\n\
\032 to copy large files efficiently (plus command-line switches\n\
\032 telling it to copy files in-place). The default setting invokes\n\
\032 rsync with appropriate options--most users should not need to\n\
\032 change it.\n\
\032 copyprogrest xxx\n\
\032 A variant of copyprog that names an external program that should\n\
\032 be used to continue the transfer of a large file that has\n\
\032 already been partially transferred. Typically, copyprogrest will\n\
\032 just be copyprog with one extra option (e.g., -partial, for\n\
\032 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, extra\n\
\032 quotes are added if the value of copyprog contains the string\n\
\032 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 name\n\
\032 of a module for which debugging information should be printed.\n\
\032 Possible arguments for debug can be found by looking for calls\n\
\032 to Util.debug in the sources (using, e.g., grep). Setting -debug\n\
\032 all causes information from all modules to be printed (this mode\n\
\032 of usage is the first one to try, if you are trying to\n\
\032 understand something that Unison seems to be doing wrong);\n\
\032 -debug verbose turns on some additional debugging output from\n\
\032 some modules (e.g., it will show exactly what bytes are being\n\
\032 sent across the network).\n\
\032 diff xxx\n\
\032 This preference can be used to control the name and command-line\n\
\032 arguments of the system utility used to generate displays of\n\
\032 file differences. The default is `diff -u CURRENT2 CURRENT1'. If\n\
\032 the value of this preference contains the substrings CURRENT1\n\
\032 and CURRENT2, these will be replaced by the names of the files\n\
\032 to be diffed. If not, the two filenames will be appended to the\n\
\032 command. In both cases, the filenames are 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 names\n\
\032 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 call\n\
\032 always fails. Setting this preference completely prevents Unison\n\
\032 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 things\n\
\032 like overwriting the current line.) This is useful, for example,\n\
\032 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. (This does not apply to the\n\
\032 very first run, when Unison will always scan all files regarless\n\
\032 of this switch). Under Windows, this may cause Unison to miss\n\
\032 propagating an update if the modification time and length of the\n\
\032 file are both unchanged by the update. However, Unison will\n\
\032 never overwrite such an update with a change from the other\n\
\032 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 under Windows most of the time and occasionally run\n\
\032 Unison once with fastcheck set to false, if you are worried that\n\
\032 Unison may have overlooked an update. 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 fastercheckUNSAFE\n\
\032 THIS FEATURE IS STILL EXPERIMENTAL AND SHOULD BE USED WITH\n\
\032 EXTREME CAUTION.\n\
\032 When this flag is set to true, Unison will compute a\n\
\032 'pseudo-fingerprint' the first time it sees a file (either\n\
\032 because the file is new or because Unison is running for the\n\
\032 first time). This enormously speeds update detection, but it\n\
\032 must be used with care, as it can cause Unison to miss\n\
\032 conflicts: If a given path in the filesystem contains files on\n\
\032 both sides that Unison has not yet seen, and if those files have\n\
\032 the same length but different contents, then Unison will not\n\
\032 notice the presence of a conflict. If, later, one of the files\n\
\032 is changed, the changed file will be propagated, overwriting the\n\
\032 other.\n\
\032 Moreover, even when the files are initially identical, setting\n\
\032 this flag can lead to potentially confusing behavior: if a newly\n\
\032 created file is later touched without being modified, Unison\n\
\032 will treat this conservatively as a potential change (since it\n\
\032 has no record of the earlier contents) and show it as needing to\n\
\032 be propagated to the other replica.\n\
\032 Most users should leave this flag off - the small time savings\n\
\032 of not fingerprinting new files is not worth the cost in terms\n\
\032 of safety. However, it can be very useful for power users with\n\
\032 huge replicas that are known to be already synchronized (e.g.,\n\
\032 because one replica is a newly created duplicate of the other,\n\
\032 or because they have previously been synchronized with Unison\n\
\032 but Unison's archives need to be rebuilt). In such situations,\n\
\032 it is recommended that this flag be set only for the initial run\n\
\032 of Unison, so that new archives can be created quickly, and then\n\
\032 turned off for normal use.\n\
\032 fat\n\
\032 When this is set to true, Unison will use appropriate options to\n\
\032 synchronize efficiently and without error a replica located on a\n\
\032 FAT filesystem on a non-Windows machine: do not synchronize\n\
\032 permissions (perms = 0); never use chmod ( t dontchmod = true);\n\
\032 treat filenames as case insensitive (ignorecase = true); do not\n\
\032 attempt to synchronize symbolic links (links = false); ignore\n\
\032 inode number changes when detecting updates (ignoreinodenumbers\n\
\032 = true). Any of these change can be overridden by explicitly\n\
\032 setting the corresponding preference in the profile.\n\
\032 follow xxx\n\
\032 Including the preference -follow pathspec causes Unison to treat\n\
\032 symbolic links matching pathspec as `invisible' and behave as if\n\
\032 the object pointed to by the link had appeared literally at this\n\
\032 position in the replica. See the section \"Symbolic Links\" for\n\
\032 more details. The syntax of pathspec is described in the section\n\
\032 \"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 root.\n\
\032 This effectively changes Unison from a synchronizer into a\n\
\032 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 changes)\n\
\032 in favor of root for the files in PATHSPEC (see the section\n\
\032 \"Path Specification\" for more information). This effectively\n\
\032 changes Unison from a synchronizer into a mirroring 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 files\n\
\032 are synchronized. Whether the group names or the group\n\
\032 identifiers are synchronized depends on the preference numerids.\n\
\032 halfduplex\n\
\032 When this flag is set to true, Unison network communication is\n\
\032 forced to be half duplex (the client and the server never\n\
\032 simultaneously emit data). If you experience unstabilities with\n\
\032 your network link, this may help. The communication is always\n\
\032 half-duplex when synchronizing with a Windows machine due to a\n\
\032 limitation of Unison current implementation that could result in\n\
\032 a deadlock.\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 in\n\
\032 the section \"Path Specification\" , and further details on\n\
\032 ignoring paths is found in the section \"Ignoring Paths\" .\n\
\032 ignorearchives\n\
\032 When this preference is set, Unison will ignore any existing\n\
\032 archive files and behave as though it were being run for the\n\
\032 first time on these replicas. It is not a good idea to set this\n\
\032 option in a profile: it is intended for command-line use.\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 to\n\
\032 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 may be useful to set the flag manually.\n\
\032 ignoreinodenumbers\n\
\032 When set to true, this preference makes Unison not take\n\
\032 advantage of inode numbers during fast update detection. This\n\
\032 switch should be used with care, as it is less safe than the\n\
\032 standard update detection method, but it can be useful with\n\
\032 filesystems which do not support inode numbers.\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 list\n\
\032 of patterns (in the same format as ignore) for paths that should\n\
\032 definitely not be ignored, whether or not they happen to match\n\
\032 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 paths\n\
\032 in depth-first order, starting from the roots of the replicas\n\
\032 and working downwards. Before examining each path, it checks\n\
\032 whether it matches ignore and does not match ignorenot; in this\n\
\032 case it skips this path and all its descendants. This means\n\
\032 that, if some parent of a given path matches an ignore pattern,\n\
\032 then it will be skipped even if the path itself matches an\n\
\032 ignorenot pattern. In particular, putting ignore = Path * in\n\
\032 your profile and then using ignorenot to select particular paths\n\
\032 to be synchronized will not work. Instead, you should use the\n\
\032 path preference to choose particular paths to 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 used\n\
\032 in the graphical user interface to switch immediately to this\n\
\032 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 of\n\
\032 Unison, rather than waiting to accept future connections. (Some\n\
\032 users prefer to start a remote socket server for each run of\n\
\032 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 links xxx\n\
\032 When set to true, this flag causes Unison to synchronize\n\
\032 symbolic links. When the flag is set to false, symbolic links\n\
\032 will result in an error during update detection. Ordinarily,\n\
\032 when the flag is set to default, symbolic links are synchronized\n\
\032 except when one of the hosts is running Windows. In rare\n\
\032 circumstances it may be useful to set the flag manually.\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 predicate\n\
\032 backup. The default is 2.\n\
\032 maxerrors n\n\
\032 This preference controls after how many errors Unison aborts a\n\
\032 directory transfer. Setting it to a large number allows Unison\n\
\032 to transfer most of a directory even when some files fail to be\n\
\032 copied. The default is 1. If the preference is set too high,\n\
\032 Unison may take a long time to abort in case of repeated\n\
\032 failures (for instance, when the disk is full).\n\
\032 maxsizethreshold n\n\
\032 A number indicating above what filesize (in kilobytes) Unison\n\
\032 should flag a conflict instead of transferring the file. This\n\
\032 conflict remains even in the presence of force or prefer\n\
\032 options. A negative number will allow every transfer\n\
\032 independently of the size. The default is -1.\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 to maximize performance, but when Unison is used over a\n\
\032 low-bandwidth link it may be helpful to set it lower (e.g. to 1)\n\
\032 so that Unison doesn't soak up all the available bandwidth. The\n\
\032 default is the special value 0, which mean 20 threads when file\n\
\032 content streaming is desactivated and 1000 threads when it is\n\
\032 activated.\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 up,\n\
\032 just like t backup. The syntax of pathspec>cmd is described in\n\
\032 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 nocreation xxx\n\
\032 Including the preference -nocreation root prevents Unison from\n\
\032 performing any file creation on root root.\n\
\032 This preference can be included twice, once for each root, if\n\
\032 you want to prevent any creation.\n\
\032 nocreationpartial xxx\n\
\032 Including the preference nocreationpartial = PATHSPEC -> root\n\
\032 prevents Unison from performing any file creation in PATHSPEC on\n\
\032 root root (see the section \"Path Specification\" for more\n\
\032 information). It is recommended to use BelowPath patterns when\n\
\032 selecting a directory and all its contents.\n\
\032 nodeletion xxx\n\
\032 Including the preference -nodeletion root prevents Unison from\n\
\032 performing any file deletion on root root.\n\
\032 This preference can be included twice, once for each root, if\n\
\032 you want to prevent any deletion.\n\
\032 nodeletionpartial xxx\n\
\032 Including the preference nodeletionpartial = PATHSPEC -> root\n\
\032 prevents Unison from performing any file deletion in PATHSPEC on\n\
\032 root root (see the section \"Path Specification\" for more\n\
\032 information). It is recommended to use BelowPath patterns when\n\
\032 selecting a directory and all its contents.\n\
\032 noupdate xxx\n\
\032 Including the preference -noupdate root prevents Unison from\n\
\032 performing any file update or deletion on root root.\n\
\032 This preference can be included twice, once for each root, if\n\
\032 you want to prevent any update.\n\
\032 noupdatepartial xxx\n\
\032 Including the preference noupdatepartial = PATHSPEC -> root\n\
\032 prevents Unison from performing any file update or deletion in\n\
\032 PATHSPEC on root root (see the section \"Path Specification\" for\n\
\032 more information). It is recommended to use BelowPath patterns\n\
\032 when selecting a directory and all its contents.\n\
\032 numericids\n\
\032 When this flag is set to true, groups and users are synchronized\n\
\032 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 files\n\
\032 are synchronized. Whether the owner names or the owner\n\
\032 identifiers are synchronizeddepends on the preference numerids.\n\
\032 path xxx\n\
\032 When no path preference is given, Unison will simply synchronize\n\
\032 the two entire replicas, beginning from the given pair of roots.\n\
\032 If one or more path preferences are given, then Unison will\n\
\032 synchronize only these paths and their children. (This is useful\n\
\032 for doing a fast sync of just one directory, for example.) Note\n\
\032 that path preferences are intepreted literally--they are not\n\
\032 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 security\n\
\032 hazard). If you want to synchronize all bits, you can set the\n\
\032 value of this preference to -1. If one of the replica is on a\n\
\032 FAT [Windows] filesystem, you should consider using the t fat\n\
\032 preference instead of this preference. If you need Unison not to\n\
\032 set permissions at all, set the value of this preference to 0\n\
\032 and set the preference t dontchmod to t true.\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 than\n\
\032 asking for guidance from the user, for the files in PATHSPEC\n\
\032 (see the section \"Path Specification\" for more information).\n\
\032 (The syntax of root is the same as for the root preference, plus\n\
\032 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 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. When the argument is\n\
\032 watch, Unison relies on an external file monitoring process to\n\
\032 synchronize whenever a change happens.\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 and\n\
\032 provide two on the command line. Details of the syntax of roots\n\
\032 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 additional\n\
\032 arguments (besides the host name and the name of the Unison\n\
\032 executable on the remote system) to the rsh command used to\n\
\032 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 should\n\
\032 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 command\n\
\032 line. When it is provided, no preference file is read: all\n\
\032 preferences must be specified on thecommand line. Also, since\n\
\032 the self-test procedure involves overwriting the roots and\n\
\032 backup directory, the names of the roots and of the backupdir\n\
\032 preference must include the string \"test\" or else the tests will\n\
\032 be aborted. (If these are not given on the command line, dummy\n\
\032 subdirectories in the current directory will be created\n\
\032 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 path\n\
\032 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. Setting\n\
\032 silent to true automatically sets the batch preference 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 it\n\
\032 puts very large files at the end of the list where they will not\n\
\032 prevent smaller files from being transferred quickly.\n\
\032 This preference (as well as the other sorting flags, but not the\n\
\032 sorting preferences that require patterns as arguments) can be\n\
\032 set interactively and temporarily using the 'Sort' menu in the\n\
\032 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., ones\n\
\032 that should be ignored or deleted rather than synchronized.\n\
\032 sshargs xxx\n\
\032 The string value of this preference will be passed as additional\n\
\032 arguments (besides the host name and the name of the Unison\n\
\032 executable on the remote system) to the ssh command used to\n\
\032 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 stream\n\
\032 When this preference is set, Unison will use an experimental\n\
\032 streaming protocol for transferring file contents more\n\
\032 efficiently. The default value is true.\n\
\032 terse\n\
\032 When this preference is set to true, the user interface will not\n\
\032 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 user\n\
\032 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 binaries\n\
\032 are all compiled with both interfaces available.)\n\
\032 unicode xxx\n\
\032 When set to true, this flag causes Unison to perform case\n\
\032 insensitive file comparisons assuming Unicode encoding. This is\n\
\032 the default. When the flag is set to false, a Latin 1 encoding\n\
\032 is assumed. When Unison runs in case sensitive mode, this flag\n\
\032 only makes a difference if one host is running Windows or Mac OS\n\
\032 X. Under Windows, the flag selects between using the Unicode or\n\
\032 8bit Windows API for accessing the filesystem. Under Mac OS X,\n\
\032 it selects whether comparing the filenames up to decomposition,\n\
\032 or byte-for-byte.\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 watch\n\
\032 Unison uses a file watcher process, when available, to detect\n\
\032 filesystem changes; this is used to speed up update detection,\n\
\032 and for continuous synchronization (-repeat watch preference.\n\
\032 Setting this flag to false disable the use of this process.\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 need\n\
\032 to be typed at the command line every time Unison is run. Profiles\n\
\032 should reside in the .unison directory on the client machine. If Unison\n\
\032 is started with just one argument name on the command line, it looks\n\
\032 for a profile called name.prf in the .unison directory. If it is\n\
\032 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 default\n\
\032 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 .unison\n\
\032 directory) to be read at the point, and included as if its contents,\n\
\032 instead of the include line, was part of the profile. Include lines\n\
\032 allows settings common to several profiles to be stored 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 is\n\
\032 listed along with the profile name in the profile selection dialog, and\n\
\032 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 will\n\
\032 cause Unison to immediately switch to this profile and begin\n\
\032 synchronization again from scratch. In this case, all actions that have\n\
\032 been selected for a set of changes currently being displayed will be\n\
\032 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 common\n\
\032 part containing most of the preference settings, plus one \"top-level\"\n\
\032 file for each set of paths that need to be synchronized. (The include\n\
\032 mechanism can also be used to allow the same set of preference settings\n\
\032 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 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 'unison\n\
\032 default' or just 'unison' on the command line), the whole replicas will\n\
\032 be synchronized. (If we never want to synchronize the whole replicas,\n\
\032 then default.prf would instead include settings for all the paths that\n\
\032 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 version\n\
\032 from the other replica, it can keep the old version around as a backup.\n\
\032 There are several preferences that control precisely where these\n\
\032 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 specifies\n\
\032 which files and directories should not be backed up, even if they match\n\
\032 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 foo\n\
\032 containing some text files, these files will not be backed up because\n\
\032 Unison will just check that foo does not match *.txt. Similarly, if the\n\
\032 directory itself happened to be called foo.txt, then the whole\n\
\032 directory and all the files in it will be backed up, regardless of\n\
\032 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 as\n\
\032 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. If\n\
\032 desired, backupprefix may include a directory prefix; this can be used\n\
\032 with backuplocation = local to put all backup files for each directory\n\
\032 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 preference\n\
\032 file (it can also be given on the command line, of course, but this\n\
\032 tends to be awkward because of the spaces and special characters\n\
\032 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 be\n\
\032 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 files\n\
\032 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 preference.\n\
\032 This preference is used in exactly the same way as backup and its\n\
\032 meaning is similar, except that it causes backups to be kept of the\n\
\032 current contents of each file after it has been synchronized by Unison,\n\
\032 rather than the previous contents that Unison overwrote. These backups\n\
\032 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 sub-shell\n\
\032 to execute the command.\n\
\032 * CURRENT1 is replaced by the name of (a temporary copy of) the local\n\
\032 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 the\n\
\032 current filename matches the path specifications for the\n\
\032 backupcurrent preference, as explained above), if one exists. If no\n\
\032 archive exists and CURRENTARCH appears in the merge command, then\n\
\032 an error is signalled.\n\
\032 * CURRENTARCHOPT is replaced by the name of the backed up copy of the\n\
\032 original version of the file (i.e., its state at the end of the\n\
\032 last successful run of Unison), if one exists, or the empty string\n\
\032 if no archive exists.\n\
\032 * NEW is replaced by the name of a temporary file that Unison expects\n\
\032 to be written by the merge program when it finishes, giving the\n\
\032 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 the\n\
\032 replicas. (These three options are provided for later compatibility\n\
\032 with the Harmony data synchronizer.)\n\
\n\
\032 To accommodate the wide variety of programs that users might want to\n\
\032 use for merging, Unison checks for several possible situations when the\n\
\032 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 the\n\
\032 temporary files CURRENT1 and CURRENT2 that were given as inputs to\n\
\032 the merge program. If either has been changed (or both have been\n\
\032 changed in identical ways), then its new contents are written back\n\
\032 to both replicas. If either CURRENT1 or CURRENT2 has been deleted,\n\
\032 then the contents of the other are written back to 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 created,\n\
\032 but NEWARCH has not, then these files are written back to the local\n\
\032 replica and remote replica, respectively. Also, if NEW1 and NEW2\n\
\032 have identical contents, then the same contents are stored as a\n\
\032 backup (if the backupcurrent preference is set for this path) to\n\
\032 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 (resp.\n\
\032 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 entries,\n\
\032 for instance). We assume that, if the merge command exits normally,\n\
\032 then the two resulting files are \"as good as equal.\" (The reason we\n\
\032 copy one on top of the other is to avoid Unison detecting that the\n\
\032 files are unequal the next time it is run and trying again to merge\n\
\032 them when, in fact, the merge program has already made them as\n\
\032 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 example,\n\
\032 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 -merg\n\
e NEW\n\
\n\
\032 Here is a slightly more involved hack. The opendiff program can operate\n\
\032 either with or without an archive file. A merge command of 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 NE\n\
W;\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 to\n\
\032 opendiff.\n\
\n\
\032 Linux users may enjoy this variant:\n\
\032 merge = Name * -> kdiff3 -o NEW CURRENTARCHOPT CURRENT1 CURRENT2\n\
\n\
\032 Ordinarily, external merge programs are only invoked when Unison is not\n\
\032 running in batch mode. To specify an external merge program that should\n\
\032 be used no matter the setting of the batch flag, use the mergebatch\n\
\032 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 from\n\
\032 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 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\
\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 Posix\n\
\032 regexps are not currently supported).\n\
\032 Regex regexp\n\
\n\
\032 For convenience, three other styles of pattern are also recognized:\n\
\032 Name name\n\
\n\
\032 matches any path in which the last component matches name,\n\
\032 Path path\n\
\n\
\032 matches exactly the path path, and\n\
\032 BelowPath path\n\
\n\
\032 matches the path path and any path below. The name and path\n\
\032 arguments of the latter forms of patterns are not regular\n\
\032 expressions. Instead, standard \"globbing\" conventions can be used\n\
\032 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. (Be careful not\n\
\032 to put extra spaces after the commas: these will be\n\
\032 interpreted literally as part of the strings to be matched!)\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\
\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, very\n\
\032 large files, old stuff, architecture-specific binaries, etc. They can\n\
\032 instruct Unison to ignore these paths using patterns introduced in the\n\
\032 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 patterns\n\
\032 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 new\n\
\032 patterns to be ignored. To ignore a particular file, select it and\n\
\032 press \"i\". To ignore all files with the same extension, select it\n\
\032 and press \"E\" (with the shift key). To ignore all files with the\n\
\032 same name, no matter what directory they appear in, select it and\n\
\032 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 matches\n\
\032 an ignore pattern and does not match an ignorenot pattern,\n\
\032 then the whole replica will be ignored. (For this reason, it\n\
\032 is not a good idea to include Name * as an ignore pattern. If\n\
\032 you want to ignore everything except a certain set of files,\n\
\032 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,\" acting\n\
\032 as though whatever it points to were physically in the replica at the\n\
\032 point where the symbolic link appears. To tell Unison to treat a link\n\
\032 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 operating\n\
\032 systems will be propagated to the other replica. The other bits\n\
\032 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 cannot\n\
\032 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 Unix\n\
\032 file foo:bar can't be synchronized to a Windows system. As with case\n\
\032 conflicts, Unison detects this situation for you, and you have the same\n\
\032 options: you can either rename the Unix file and re-synchronize, or you\n\
\032 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 protocol\n\
\032 can be found at the rsync web site (http://samba.anu.edu.au/rsync/).\n\
\n\
\032 If you are using Unison with ssh, you may get some speed improvement by\n\
\032 enabling ssh's compression feature. Do this by adding the option\n\
\032 \"-sshargs -C\" to the command line or \"sshargs = -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 telling\n\
\032 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 copy\n\
\032 small files by itself, but can be useful for testing.) If you set it to\n\
\032 a larger value, Unison will use the external utility for all files\n\
\032 larger than this size (which is given in kilobytes, so setting it to\n\
\032 1000 will cause the external tool to be used for all transfers larger\n\
\032 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 here:\n\
\032 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 tries).\n\
\032 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 to\n\
\032 true, this causes Unison to add an extra layer of quotes to the remote\n\
\032 path passed to the external copy program. This is is needed by rsync,\n\
\032 for example, which internally uses an ssh connection, requiring an\n\
\032 extra level of quoting for paths containing spaces. When this flag is\n\
\032 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 changes\n\
\032 (which involves scanning the full contents of every file on every\n\
\032 sync--the only completely safe way to do it under Windows) is too slow.\n\
\032 Unison provides a preference fastcheck that, when set to true, causes\n\
\032 it to use file creation times as 'pseudo inode numbers' when scanning\n\
\032 replicas for updates, instead of reading the full contents of every\n\
\032 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 Unix\n\
\032 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 use\n\
\032 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 overlooked\n\
\032 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 unless\n\
\032 you are careful. If you synchronize a directory that is stored on\n\
\032 removable media when the media is not present, it will look to Unison\n\
\032 as though the whole directory has been deleted, and it will proceed to\n\
\032 delete the directory from the other replica--probably not what you\n\
\032 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. If\n\
\032 you start Unison from a DOS window, Unison's regular window will appear\n\
\032 and you will type your password in the DOS window you were 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.UnisonF\n\
\032 AQOSSpecific).\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 dialog\n\
\032 asks you to select the way that you want to connect to the\n\
\032 network to download the installation files; we have used \"Use\n\
\032 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 you\n\
\032 don't want to install a package, click on it until \"skip\" is\n\
\032 shown. For a minimum installation, select only the packages\n\
\032 \"cygwin\" and \"openssh,\" which come to about 1900KB; the full\n\
\032 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 as\n\
\032 \"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 other ones instead:\n\
\032 http://linuxmafia.com/ssh/win32.html\n\
\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 can\n\
\032 find the ssh executable.\n\
\032 + On Windows 95/98, add the lines\n\
\032 set PATH=%PATH%;\n\
\032 set HOME=\n\
\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 the\n\
\032 default location, this is C:\\cygwin\\bin.\n\
\032 3. Test ssh from a DOS shell by typing\n\
\032 ssh -l \n\
\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 such\n\
\032 file or directory\") on some systems. This is OK: you can use ssh\n\
\032 with your regular password for the remote system.\n\
\032 5. You should now be able to use Unison with an ssh connection. If you\n\
\032 are logged in with a different user name on the local and remote\n\
\032 hosts, provide your remote user name when providing the remote root\n\
\032 (i.e., //username@host/path...).\n\
\n\
"))
::
("news", ("Changes in Version 2.48.3",
"Changes in Version 2.48.3\n\
\n\
\032 Changes since 2.45:\n\
\032 * Incorporated a patch from Christopher Zimmermann to replace the\n\
\032 Uprintf module (which doesn't work with OCaml 4.02, causing Unison\n\
\032 to crash) with equivalent functionality from the standard library.\n\
\032 * Incorporated a refresh of the OSX GUI, contributed by Alan Shutko.\n\
\032 * Added a maxsizethreshold option, which prevents the transfer of\n\
\032 files larger than the size specified (in Kb).\n\
\032 * Added a \"copyonconflict\" preference, to make a copy of files that\n\
\032 would otherwise be overwritten or deleted in case of conflicting\n\
\032 changes. (This makes it possible to automatically resolve conflicts\n\
\032 in a fairly safe way when synchronizing continuously, in\n\
\032 combination with the \"repeat = watch\" and \"prefer = newer\"\n\
\032 preferences.\n\
\032 * File system monitoring:\n\
\032 + The file watcher now fails when unable to watch a directory,\n\
\032 rather than silently ignoring the issue.\n\
\032 + File system monitoring: more robust communication with the\n\
\032 helper program (in socket mode, the unison server will still\n\
\032 work properly despite unexpected unison client\n\
\032 disconnections).\n\
\032 + A bytecode version of unison-fsmonitor is now produced by\n\
\032 \"make NATIVE=false\"\n\
\032 + Improved search for unison-fsmonitor\n\
\032 + Detect when the helper process exits.\n\
\032 + More robust file watching helper programs for Windows and\n\
\032 Linux. They communicate with Unison through pipes (Unison\n\
\032 redirects stdin and stdout), using a race-free protocol.\n\
\032 + Retries paths with failures using an exponential backoff\n\
\032 algorithm.\n\
\032 + The information returned by the file watchers are used\n\
\032 independently for each replica; thus, when only one replica\n\
\032 has changes, Unison will only rescan this replica.\n\
\032 + When available, used by the graphical UIs to speed up\n\
\032 rescanning (can be disabled by setting the new watch\n\
\032 preference to\n\
\032 + Small fix to the way fsmonitor.py gets invoked when using the\n\
\032 file watching functionality, suggested by Josh Berdine. Unison\n\
\032 will now look for fsmonitor.py in the same directory where the\n\
\032 Unison executable itself lives.\n\
\032 * Minor:\n\
\032 + Fixed a bug in export procedure that was messing up\n\
\032 documentation strings.\n\
\032 + Incorporated a patch from Ir\225nyossy Knoblauch Art\250r to make\n\
\032 temp file names fit within 143 characters (to make eCryptFS\n\
\032 happy).\n\
\032 + Added a string to the Conflict direction to document the\n\
\032 reason of the conflict.\n\
\032 + Log conflicts and problems in the text UI even if nothing is\n\
\032 propagated.\n\
\032 + Use hash function from OCaml 3.x for comparing archives, even\n\
\032 when compiled with OCaml 4.x.\n\
\032 + Do not restart Unison in case of uncaught exception when the\n\
\032 repeat preference is set. This seems safer. And it does not\n\
\032 work, for instance, in case of lost connection.\n\
\032 + Fix Unix.readlink invalid argument error under Windows\n\
\032 + Fix a crash when the output of the diff program is too large.\n\
\032 + Fixed Makefile for cross-compiling towards Windows (updated to\n\
\032 MinGW-w64)\n\
\n\
\032 Changes since 2.40.63:\n\
\032 * New preference fastercheckUNSAFE, which can be used (with care!) to\n\
\032 achieve much faster update detection when all the common files in\n\
\032 the two replicas are known to be identical. See the manual for more\n\
\032 information.\n\
\032 This feature should still be considered experimental, but it's\n\
\032 ready for other people to try out.\n\
\032 * Added option clientHostName. If specified, it will be used to as\n\
\032 the client host name, overriding UNISONLOCALHOSTNAME and the actual\n\
\032 host name.\n\
\032 * OS X GUI:\n\
\032 + fix crash under Lion, because of problems with the toolbar,\n\
\032 using the fix suggested in\n\
\032 http://blitzbasic.com/Community/posts.php?topic=95778.\n\
\032 + uimacnew09 is now the standard graphical interface on OSX\n\
\032 + A small improvement to the uimacnew09 interface from Alan\n\
\032 Schmitt and Steve Kalkwarf: when Unison is run with the -batch\n\
\032 flag, the interface will now automatically propagate changes\n\
\032 and terminate, without waiting for user interaction.\n\
\032 + Show a modal warning window if there is no archive for the\n\
\032 hosts. The user can then choose to exit or proceed (proceed is\n\
\032 the default). The window is not shown if the batch preference\n\
\032 is true.\n\
\032 + file details panel selectable\n\
\032 * GTK GUI:\n\
\032 + New version of uigtk2.ml from Matt Zagrabelny that reorganizes\n\
\032 the icons in a slightly more intuitive way.\n\
\032 * Minor fixes:\n\
\032 + Setting the prefer preference to older or newer now propagates\n\
\032 deletions when there is no conflict.\n\
\032 + Correctly quote the path when running merge commands.\n\
\032 + Add quotes to paths when calling external file watcher\n\
\032 utility.\n\
\032 + Incorporate a patch to fsmonitor.py (the external filewatcher\n\
\032 utility) from Tomasz Zernicki to make it work better under\n\
\032 Windows.\n\
\032 + Incorporated new version of fsmonitor.py from Christophe Gohle\n\
\032 + Fixed incompatibility with OpenSSH 5.6.\n\
\032 + Fixed fingerprint cache: do not cache file properties\n\
\032 + Some spelling corrections in documentation and comments from\n\
\032 Stephane Glondu\n\
\032 + Fixed O_APPEND mode for open under Windows\n\
\032 + Fixed String.sub invalid argument error when an AppleDouble\n\
\032 file does not contain a finder information field\n\
\032 + Trim duplicate paths when using \"-repeat watch\"\n\
\032 + Unison now passes path arguments and -follow directives to\n\
\032 fsmonitor.py. This seems to work except for one small issue\n\
\032 with how fsmonitor.py treats -follow directives for\n\
\032 directories that don't exist (or maybe this is an issue with\n\
\032 how it treats any kind of monitoring when the thing being\n\
\032 monitored doesn't exist?). If we create a symlink to a\n\
\032 nonexistant directory, give Unison (hence fsmonitor.py) a\n\
\032 'follow' directive for the symlink, start unison, and then\n\
\032 create the directory, fsmonitor.py misses the change.\n\
\032 + Lines added in profile files by unison always start at a new\n\
\032 line\n\
\n\
\032 Changes since 2.40.1:\n\
\032 * Added \"BelowPath\" patterns, that match a path as well as all paths\n\
\032 below (convenient to use with nodeletion,update,creationpartial\n\
\032 preferences)\n\
\032 * Added a \"fat\" preference that makes Unison use the right options\n\
\032 when one of the replica is on a FAT filesystem.\n\
\032 * Allow \"prefer/force=newer\" even when not synchronizing modification\n\
\032 times. (The reconciler will not be aware of the modification time\n\
\032 of unchanged files, so the synchronization choices of Unison can be\n\
\032 different from when \"times=true\", but the behavior remains sane:\n\
\032 changed files with the most recent modification time will be\n\
\032 propagated.)\n\
\032 * Minor fixes and improvements:\n\
\032 + Compare filenames up to decomposition in case sensitive mode\n\
\032 when one host is running MacOSX and the unicode preference is\n\
\032 set to true.\n\
\032 + Rsync: somewhat faster compressor\n\
\032 + Make Unicode the default on all architectures (it was only the\n\
\032 default when a Mac OS X or Windows machine was involved).\n\
\n\
\032 Changes since 2.32:\n\
\032 * Major enhancement: Unicode support.\n\
\032 + Unison should now handle unicode filenames correctly on all\n\
\032 platforms.\n\
\032 + This functionality is controlled by a new preference unicode.\n\
\032 + Unicode mode is now the default when one of the hosts is under\n\
\032 Windows or MacOS. This may make upgrades a bit more painful\n\
\032 (the archives cannot be reused), but this is a much saner\n\
\032 default.\n\
\032 * Partial transfer of directories. If an error occurs while\n\
\032 transferring a directory, the part transferred so far is copied\n\
\032 into place (and the archives are updated accordingly). The\n\
\032 \"maxerrors\" preference controls how many transfer error Unison will\n\
\032 accept before stopping the transfer of a directory (by default,\n\
\032 only one). This makes it possible to transfer most of a directory\n\
\032 even if there are some errors. Currently, only the first error is\n\
\032 reported by the GUIs.\n\
\032 Also, allow partial transfer of a directory when there was an error\n\
\032 deep inside this directory during update detection. At the moment,\n\
\032 this is only activated with the text and GTK UIs, which have been\n\
\032 modified so that they show that the transfer is going to be partial\n\
\032 and so that they can display all errors.\n\
\032 * Improvement to the code for resuming directory transfers:\n\
\032 + if a file was not correctly transferred (or the source has\n\
\032 been modified since, with unchanged size), Unison performs a\n\
\032 new transfer rather than failing\n\
\032 + spurious files are deleted (this can happen if a file is\n\
\032 deleted on the source replica before resuming the transfer;\n\
\032 not deleting the file would result in it reappearing on the\n\
\032 target replica)\n\
\032 * Experimental streaming protocol for transferring file contents (can\n\
\032 be disabled by setting the directive \"stream\" to false): file\n\
\032 contents is transfered asynchronously (without waiting for a\n\
\032 response from the destination after each chunk sent) rather than\n\
\032 using the synchronous RPC mechanism. As a consequence:\n\
\032 + Unison now transfers the contents of a single file at a time\n\
\032 (Unison used to transfer several contents simultaneously in\n\
\032 order to hide the connection latency.)\n\
\032 + the transfer of large files uses the full available bandwidth\n\
\032 and is not slowed done due to the connection latency anymore\n\
\032 + we get performance improvement for small files as well by\n\
\032 scheduling many files simultaneously (as scheduling a file for\n\
\032 transfer consume little ressource: it does not mean allocating\n\
\032 a large buffer anymore)\n\
\032 * Changes to the internal implementation of the rsync algorithm:\n\
\032 + use longer blocks for large files (the size of a block is the\n\
\032 square root of the size of the file for large files);\n\
\032 + transmit less checksum information per block (we still have\n\
\032 less than one chance in a hundred million of transferring a\n\
\032 file incorrectly, and Unison will catch any transfer error\n\
\032 when fingerprinting the whole file)\n\
\032 + avoid transfer overhead (which was 4 bytes per block)\n\
\032 For a 1G file, the first optimization saves a factor 50 on the\n\
\032 amount of data transferred from the target to the source (blocks\n\
\032 are 32768 bytes rather than just 700 bytes). The two other\n\
\032 optimizations save another factor of 2 (from 24 bytes per block\n\
\032 down to 10).\n\
\032 * Implemented an on-disk file fingerprint cache to speed-up update\n\
\032 detection after a crash: this way, Unison does not have do\n\
\032 recompute all the file fingerprints from scratch.\n\
\032 + When Unison detects that the archive case-sensitivity mode\n\
\032 does not match the current settings, it populates the\n\
\032 fingerprint cache using the archive contents. This way,\n\
\032 changing the case-sensitivity mode should be reasonably fast.\n\
\032 * New preferences \"noupdate=root\", \"nodeletion=root\",\n\
\032 \"nocreation=root\" that prevent Unison from performing files\n\
\032 updates, deletions or creations on the given root. Also 'partial'\n\
\032 versions of 'noupdate', 'nodeletion' and 'nocreation'\n\
\032 * Limit the number of simultaneous external copy program (\"copymax\"\n\
\032 preference)\n\
\032 * New \"links\" preference. When set to false, Unison will report an\n\
\032 error on symlinks during update detection. (This is the default\n\
\032 when one host is running Windows but not Cygwin.) This is better\n\
\032 than failing during propagation.\n\
\032 * Added a preference \"halfduplex\" to force half-duplex communication\n\
\032 with the server. This may be useful on unreliable links (as a more\n\
\032 efficient alternative to \"maxthreads = 1\").\n\
\032 * Renamed preference \"pretendwin\" to \"ignoreinodenumbers\" (an alias\n\
\032 is kept for backwards compatibility).\n\
\032 * Ignore one-second differences when synchronizing modification time.\n\
\032 (Technically, this is an incompatible archive format change, but it\n\
\032 is backward compatible. To trigger a problem, a user would have to\n\
\032 synchronize modification times on a filesystem with a two-second\n\
\032 granularity and then downgrade to a previous version of Unison,\n\
\032 which does not work well in such a case. Thus, it does not seem\n\
\032 worthwhile to increment the archive format number, which would\n\
\032 impact all users.)\n\
\032 * Do not keep many files simultaneously opened anymore when the rsync\n\
\032 algorithm is in use.\n\
\032 * Add \"ignorearchives\" preference to ignore existing archives (to\n\
\032 avoid forcing users to delete them manually, in situations where\n\
\032 one archive has gotten deleted or corrupted).\n\
\032 * Mac OS\n\
\032 + fixed rsync bug which could result in an \"index out of bounds\"\n\
\032 error when transferring resource forks.\n\
\032 + Fixed bug which made Unison ignore finder information and\n\
\032 resource fork when compiled to 64bit on Mac OSX.\n\
\032 + should now be 64 bit clean (the Growl framework is not up to\n\
\032 date, though)\n\
\032 + Made the bridge between Objective C and Ocaml code GC friendly\n\
\032 (it was allocating ML values and putting them in an array\n\
\032 which was not registered with the GC)\n\
\032 + use darker grey arrows (patch contributed by Eric Y. Kow)\n\
\032 * GTK user interface\n\
\032 + assistant for creating profiles\n\
\032 + profile editor\n\
\032 + pop up a summary window when the replicas are not fully\n\
\032 synchronized after transport\n\
\032 + display estimated remaining time and transfer rate on the\n\
\032 progress bar\n\
\032 + allow simultaneous selection of several items\n\
\032 + Do not reload the preference file before a new update\n\
\032 detection if it is unchanged\n\
\032 + disabled scrolling to the first unfinished item during\n\
\032 transport. It goes way too fast when lot of small files are\n\
\032 synchronized, and it makes it impossible to browse the file\n\
\032 list during transport.\n\
\032 + take into account the \"height\" preference again\n\
\032 + the internal list of selected reconciler item was not always\n\
\032 in sync with what was displayed (GTK bug?); workaround\n\
\032 implemented\n\
\032 + Do not display \"Looking for change\" messages during\n\
\032 propagation (when checking the targe is unchanged) but only\n\
\032 during update detection\n\
\032 + Apply patch to fix some crashes in the OSX GUI, thanks to Onne\n\
\032 Gorter.\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. Should be less confusing.\n\
\032 * Windows\n\
\032 + Fastcheck is now the default under Windows. People mostly use\n\
\032 NTFS nowadays and the Unicode API provides an equivalent to\n\
\032 inode numbers for this filesystem.\n\
\032 + Only use long UNC path for accessing replicas (as '..' is not\n\
\032 handled with this format of paths, but can be useful)\n\
\032 + Windows text UI: now put the console into UTF-8 output mode.\n\
\032 This is the right thing to do when in Unicode mode, and is no\n\
\032 worse than what we had previously otherwise (the console use\n\
\032 some esoteric encoding by default). This only works when using\n\
\032 a Unicode font instead of the default raster font.\n\
\032 + Don't get the home directory from environment variable HOME\n\
\032 under Windows (except for Cygwin binaries): we don't want the\n\
\032 behavior of Unison to depends on whether it is run from a\n\
\032 Cygwin shell (where HOME is set) or in any other way (where\n\
\032 HOME is usually not set).\n\
\032 * Miscellaneous fixes and improvements\n\
\032 + Made a server waiting on a socket more resilient to unexpected\n\
\032 lost connections from the client.\n\
\032 + Small patch to property setting code suggested by Ulrich\n\
\032 Gernkow.\n\
\032 + Several fixes to the change transfer functions (both the\n\
\032 internal ones and external transfers using rsync). In\n\
\032 particular, limit the number of simultaneous transfer using an\n\
\032 rsync (as the rsync algorithm can use a large amount of memory\n\
\032 when processing huge files)\n\
\032 + Keep track of which file contents are being transferred, and\n\
\032 delay the transfer of a file when another file with the same\n\
\032 contents is currently being transferred. This way, the second\n\
\032 transfer can be skipped and replaced by a local copy.\n\
\032 + Experimental update detection optimization: do not read the\n\
\032 contents of unchanged directories\n\
\032 + When a file transfer fails, turn off fastcheck for this file\n\
\032 on the next sync.\n\
\032 + Fixed bug with case insensitive mode on a case sensitive\n\
\032 filesystem:\n\
\032 o if file \"a/a\" is created on one replica and directory \"A\"\n\
\032 is created on the other, the file failed to be\n\
\032 synchronized the first time Unison is run afterwards, as\n\
\032 Unison uses the wrong path \"a/a\" (if Unison is run again,\n\
\032 the directories are in the archive, so the right path is\n\
\032 used);\n\
\032 o if file \"a\" appears on one replica and file \"A\" appears\n\
\032 on the other with different contents, Unison was unable\n\
\032 to synchronize them.\n\
\032 + Improved error reporting when the destination is updated\n\
\032 during synchronization: Unison now tells which file has been\n\
\032 updated, and how.\n\
\032 + Limit the length of temporary file names\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 + Got rid of the 16mb marshalling limit by marshalling to a\n\
\032 bigarray.\n\
\032 + Resume copy of partially transferred files.\n\
\n\
\032 Changes since 2.31:\n\
\032 * Small user interface changes\n\
\032 + Small change to text UI \"scanning...\" messages, to print just\n\
\032 directories (hopefully making it clearer that individual files\n\
\032 are not necessarily being fingerprinted).\n\
\032 * Minor fixes and improvements:\n\
\032 + Ignore one hour differences when deciding whether a file may\n\
\032 have been updated. This avoids slow update detection after\n\
\032 daylight saving time changes under Windows. This makes Unison\n\
\032 slightly more likely to miss an update, but it should be safe\n\
\032 enough.\n\
\032 + Fix a small bug that was affecting mainly windows users. We\n\
\032 need to commit the archives at the end of the sync even if\n\
\032 there are no updates to propagate because some files (in fact,\n\
\032 if we've just switched to DST on windows, a LOT of files)\n\
\032 might have new modtimes in the archive. (Changed the text UI\n\
\032 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 why!)\n\
\032 We've also added more debugging code togive more informative\n\
\032 error messages when we encounter the dreaded and longstanding\n\
\032 \"assert failed during file transfer\" bug\n\
\032 + Incorrect paths (\"path\" directive) now result in an error\n\
\032 update item rather than a fatal error.\n\
\032 + Create parent directories (with correct permissions) during\n\
\032 transport for paths which point to non-existent locations in\n\
\032 the destination replica.\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 invoked,\n\
\032 but other tools such as scp can be used instead by changing\n\
\032 the value of this preference. (Although this is not its\n\
\032 primary purpose, rsync is actually a pretty fast way of\n\
\032 copying files that don't already exist on the receiving host.)\n\
\032 For files that do already exist on (but that have been changed\n\
\032 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 utility\n\
\032 depending on whether a partially transferred file already\n\
\032 exists or not. (Rsync doesn't seem to care about this, but\n\
\032 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 cause\n\
\032 ALL copies to use the external program; a negative number will\n\
\032 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 the\n\
\032 chmod system call to set the permission bits of files after it\n\
\032 has copied them. But in some circumstances (and under some\n\
\032 operating systems), the chmod call always fails. Setting this\n\
\032 preference completely prevents Unison from ever 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 do\n\
\032 not appear in the documentation.\n\
\032 + Lots of little documentation tidying. (In particular,\n\
\032 preferences are separated into Basic and Advanced! This should\n\
\032 hopefully make Unison a little more approachable for new\n\
\032 users.\n\
\032 + Unison can sometimes fail to transfer a file, giving the\n\
\032 unhelpful message \"Destination updated during synchronization\"\n\
\032 even though the file has not been changed. This can be caused\n\
\032 by programs that change either the file's contents or the\n\
\032 file's extended attributes without changing its modification\n\
\032 time. It's not clear what is the best fix for this - it is not\n\
\032 Unison's fault, but it makes Unison's behavior puzzling - but\n\
\032 at least Unison can be more helpful about suggesting a\n\
\032 workaround (running once with fastcheck set to false). The\n\
\032 failure message has been changed to give 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 this\n\
\032 file (on both hosts), which should be a newline-separated list\n\
\032 of paths (relative to the root of the synchronization) and\n\
\032 synchronize just these paths, as if it had been started with\n\
\032 the \"-path=xxx\" option for each one of 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 to\n\
\032 the filesystem and append the appropriate paths to the watchfile.\n\
\032 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 Ben\n\
\032 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 windows\n\
\032 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 (whereupon\n\
\032 Unison would cheerfully delete the corresponding files in the\n\
\032 other replica!).\n\
\032 * Smaller changes:\n\
\032 + Added forcepartial and preferpartial preferences, which behave\n\
\032 like force and prefer but can be specified on a per-path\n\
\032 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, but\n\
\032 the facility has already been very useful in debugging the new\n\
\032 backup functionality (especially in exposing some subtle\n\
\032 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 easier\n\
\032 to interpret the results when Unison is run several times in\n\
\032 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 (so\n\
\032 that the + and - annotations in diff's output are 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 synchronize\n\
\032 modification times. (Modification times cannot be updated in\n\
\032 the archive in this case, so we have to ignore one hour\n\
\032 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 correctly\n\
\032 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 fastcheck\n\
\032 a little less safe. But it turns out that file creation times\n\
\032 are not reliable under Windows: if a file is removed and a new\n\
\032 file is created in its place, the new one will sometimes be\n\
\032 given the same creation date as the old 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 to\n\
\032 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 xferbycopying\n\
\032 shortcuts are applied and whether they succeed) just to the\n\
\032 standard output of the Unison process, not to the log file.\n\
\n\
\032 Changes since 2.13.0:\n\
\032 * The features for performing backups and for invoking external merge\n\
\032 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 at\n\
\032 hh:mm:ss on dd MMM, yyyy to modified on yyyy-mm-dd hh:mm:ss\n\
\032 + Changed time display to include seconds (so that people on FAT\n\
\032 filesystems will not be confused when Unison tries to update a\n\
\032 file time to an odd number of seconds and the filesystem\n\
\032 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 resort\n\
\032 (it was wrongly moved before $HOME and $USERPROFILE in Unison\n\
\032 2.12.0)\n\
\032 + Reopen the logfile if its name changes (profile change)\n\
\032 + Double-check that permissions and modification times have been\n\
\032 properly set: there are some combination of OS and filesystem\n\
\032 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 substitued\n\
\032 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\
\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 files\n\
\032 in binary mode under Cygwin).\n\
\032 + On non-Cygwin Windows systems, the UNISON environment variable\n\
\032 is now checked first to determine where to look for Unison's\n\
\032 archive and preference files, followed by HOME and USERPROFILE\n\
\032 in that order. On Unix and Cygwin systems, HOME 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 else\n\
\032 a whole command line, containing the strings CURRENT1 and\n\
\032 CURRENT2, which will be replaced by the names of the files to\n\
\032 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 it\n\
\032 may write two new files. In the latter cases, its\n\
\032 modifications will be copied back into place on both the local\n\
\032 and the remote host, and (if the two files are now equal) the\n\
\032 archive will be updated appropriately. More information can be\n\
\032 found in the user manual. Thanks to Malo Denielou and Alan\n\
\032 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 Support/Unison,\n\
\032 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.) Also\n\
\032 a preference assumeContentsAreImmutableNot, which overrides\n\
\032 the first, similarly to ignorenot. (Later amendment: these\n\
\032 preferences are now called immutable and 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 Windows.\n\
\032 Setting ignorecase to true or false overrides this behavior.\n\
\032 If you have been setting ignorecase on the command line using\n\
\032 -ignorecase=true or -ignorecase=false, you will need to change\n\
\032 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 seconds\n\
\032 and then start over, continuing this way until it is killed\n\
\032 from outside. Setting repeat to true will automatically set\n\
\032 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 it\n\
\032 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 fact,\n\
\032 'rshargs' is no longer mentioned in the documentation at all,\n\
\032 since pretty much everybody uses ssh now anyway.\n\
\032 * Documentation\n\
\032 + The web pages have been completely redesigned and reorganized.\n\
\032 (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 \"Recheck\n\
\032 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 are\n\
\032 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 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 a\n\
\032 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 (called\n\
\032 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 leaving\n\
\032 the terminal in a bad state where it would not echo inputs after\n\
\032 Unison exited).\n\
\n\
\032 Changes since 2.7.39:\n\
\032 * Improvements to the main web page (stable and beta version docs are\n\
\032 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 errors\n\
\032 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 text\n\
\032 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. It\n\
\032 transfers several files at the same time, thereby making much more\n\
\032 effective use of available network bandwidth. Unlike the earlier\n\
\032 attempt, this time we do not rely on the native thread library of\n\
\032 OCaml. Instead, we implement a light-weight, non-preemptive\n\
\032 multi-thread library in OCaml directly. This version appears\n\
\032 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 nicely\n\
\032 under multi-threading. The temp file names are made less\n\
\032 likely to coincide with the name of a file created by the\n\
\032 user. They take the form\n\
\032 .#..unison.tmp. [N.b. This was later changed\n\
\032 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 if\n\
\032 neither host is running Windows. (This may be useful, e.g., when\n\
\032 using Unison running on a Unix system with a FAT volume 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 warnings\n\
\032 from appearing in the text UI, so some users who have been\n\
\032 running (unsuspectingly) with garbage in their prefs files may\n\
\032 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 building\n\
\032 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 tell\n\
\032 when you were trying to use Unison incorrectly with an old version\n\
\032 of the server, since it would hang instead of giving an error\n\
\032 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 mentioned\n\
\032 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 programs\n\
\032 that depend on the suffix to guess the type of the file 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 unexpectedly\n\
\032 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 a\n\
\032 file's creation time and last-modified time to check whether it has\n\
\032 changed. This should result in a huge speedup when checking for\n\
\032 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 a\n\
\032 full backup of (selected files in) each replica, and a merging\n\
\032 feature that allows Unison to invoke an external file-merging\n\
\032 tool to resolve conflicting changes to 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 each\n\
\032 replica; these function both as backups in the usual\n\
\032 sense and as the \"common version\" when invoking external\n\
\032 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 directory\n\
\032 can be changed by setting the environment variable\n\
\032 UNISONBACKUPDIR.)\n\
\032 o The predicate backup controls which files are actually\n\
\032 backed up: giving the preference 'backup = Path *' causes\n\
\032 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 archive\n\
\032 files have been manually deleted), all files will be\n\
\032 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). Before\n\
\032 unison uses any of these files for anything important, it\n\
\032 checks that its fingerprint matches the one that it\n\
\032 expects.\n\
\032 + Merging:\n\
\032 o Both user interfaces offer a new 'merge' command, invoked\n\
\032 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 program\n\
\032 is invoked. If a backup exists for this file (see the\n\
\032 backup preference), then the merge preference is used for\n\
\032 this purpose; otherwise merge2 is used. In both cases,\n\
\032 the value of the preference should be a string\n\
\032 representing the command that should be passed to a shell\n\
\032 to invoke the merge program. Within this string, the\n\
\032 special substrings CURRENT1, CURRENT2, NEW, and OLD may\n\
\032 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 that\n\
\032 Unison expects to be written by the merge program\n\
\032 when it finishes, giving the desired new contents of\n\
\032 the file; and\n\
\032 # OLD is replaced by the name of the backed up copy of\n\
\032 the original version of the file (i.e., its state at\n\
\032 the end of the last successful run of Unison), if\n\
\032 one exists (applies only to merge, not merge2).\n\
\032 For example, on Unix systems setting the merge preference\n\
\032 to\n\
\032 merge = diff3 -m CURRENT1 OLD CURRENT2 > NEW\n\
\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\
\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 at\n\
\032 the path NEW, Unison considers the merge to have failed.\n\
\032 If the merge program writes a file called NEW but exits\n\
\032 with a non-zero status code, then Unison considers the\n\
\032 merge to have succeeded but to have generated conflicts.\n\
\032 In this case, it attempts to invoke an external editor so\n\
\032 that the user can resolve the conflicts. The value of the\n\
\032 editor preference controls what editor is invoked by\n\
\032 Unison. The default is emacs.\n\
\032 o Please send us suggestions for other useful values of the\n\
\032 merge2 and merge preferences - we'd like to give several\n\
\032 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, as\n\
\032 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 a\n\
\032 dynamically linked executable. The static one is larger, but\n\
\032 will probably run on more systems, since it doesn't depend on\n\
\032 the same versions of dynamically linked library modules being\n\
\032 available.\n\
\032 + Fixed the force and prefer preferences, which were getting the\n\
\032 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 created,\n\
\032 Unison would confusingly display the roots in reverse order in\n\
\032 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 be\n\
\032 approximated by using multiple profiles, with include directives to\n\
\032 incorporate common settings. All uses of defaultpath in existing\n\
\032 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\
\n\
\032 Now do\n\
\032 unison common root1 root2\n\
\n\
\032 when you want to specify roots explicitly.\n\
\032 * The -prefer and -force options have been extended to allow users to\n\
\032 specify that files with more recent modtimes should be propagated,\n\
\032 writing either -prefer newer or -force newer. (For symmetry, Unison\n\
\032 will also accept -prefer older or -force older.) The -force\n\
\032 older/newer options can only be used when -times is also set.\n\
\032 The graphical user interface provides access to these facilities on\n\
\032 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 have\n\
\032 been selected for a set of changes currently being displayed\n\
\032 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 in\n\
\032 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 interface.\n\
\032 (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 fall\n\
\032 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 specified\n\
\032 in a path preference and ignored, it will be 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 preferences,\n\
\032 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 granularity\n\
\032 on both replicas, Unison may not always be able to make\n\
\032 the modtimes precisely equal, but it will get them as\n\
\032 close as the operating systems involved 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 preference\n\
\032 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 HOME\n\
\032 environment variable). If you want it someplace else, set the\n\
\032 logfile preference to the full pathname you want Unison to\n\
\032 use.\n\
\032 + Added an ignorenot preference that maintains a set of patterns\n\
\032 for paths that should definitely not be ignored, whether or\n\
\032 not they match an ignore pattern. (That is, a path will now be\n\
\032 ignored iff it matches an ignore pattern and does not match\n\
\032 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 interface\n\
\032 no longer waits for user confirmation when it displays a\n\
\032 warning message: it simply pops up an advisory window with a\n\
\032 Dismiss button at the bottom and keeps on 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 paths).\n\
\032 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 UNISONLOCALHOSTNAME\n\
\032 is set, its value will now be used instead. This makes it\n\
\032 easier to use Unison in situations where a machine's name\n\
\032 changes frequently (e.g., because it is a laptop and gets\n\
\032 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 later.\n\
\032 (Somebody sent a bug report of a server crash that turned out\n\
\032 to come from using inconsistent versions: better to check this\n\
\032 earlier and in a way that can't crash either client or\n\
\032 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 the\n\
\032 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 rest\n\
\032 of the entries are sorted in alphabetical order. This behavior can\n\
\032 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 activate\n\
\032 rsync compression for file transfers, but rsync compression is\n\
\032 now enabled by default).\n\
\032 + In the text user interface, the arrows indicating which\n\
\032 direction changes are being propagated are printed differently\n\
\032 when the user has overridded Unison's default recommendation\n\
\032 (====> instead of ---->). This matches the behavior of the\n\
\032 graphical interface, which displays such arrows in a different\n\
\032 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, the\n\
\032 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 effect\n\
\032 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 does\n\
\032 not exist), and temporarily override its roots. The manual\n\
\032 claimed that this case would work by reading no profile at\n\
\032 all, but AFAIK this was never true.\n\
\032 + In all user interfaces, files with conflicts are always listed\n\
\032 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 is\n\
\032 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 Windows.\n\
\032 The most difficult thing to fix is an ocaml bug: Unix.opendir\n\
\032 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 default\n\
\032 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 displayed\n\
\032 along with 'Synchronization complete' at the end of the\n\
\032 transfer phase (in case they may have scrolled off the 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 wait\n\
\032 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 numbers.\n\
\032 + The OCaml sources for the up-to-the-minute developers' version\n\
\032 (not guaranteed to be stable, or even to compile, at any given\n\
\032 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. (It\n\
\032 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 the\n\
\032 contents of that directory.\n\
\032 Note that if you use wildcard paths from the command line, you will\n\
\032 probably need to use quotes or a backslash to prevent the * from\n\
\032 being interpreted by your shell.\n\
\032 If both roots are local, the contents of the first one will be used\n\
\032 for expanding wildcard paths. (Nb: this is the first one after the\n\
\032 canonization step - i.e., the one that is listed first in the user\n\
\032 interface - not the one listed first on the command line or in the\n\
\032 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 we\n\
\032 have left it off by default. Start unison with the -rsync option\n\
\032 (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 incremented\n\
\032 on every significant public release and the third component is the\n\
\032 \"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 to\n\
\032 recompile Unison from sources (as described in the documentation),\n\
\032 setting the THREADS flag in Makefile.OCaml to true. Make sure that\n\
\032 your OCaml compiler has been installed with the -with-pthreads\n\
\032 configuration option. (You can verify this by checking whether the\n\
\032 file threads/threads.cma in the OCaml standard library directory\n\
\032 contains the string -lpthread near the 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 the\n\
\032 installation section of the manual for detailed instructions.\n\
\032 * The transport subsystem now includes an implementation of the rsync\n\
\032 protocol, built by Sylvain Gommier and Norman Ramsey. This protocol\n\
\032 achieves much faster transfers when only a small part of a large\n\
\032 file has been changed by sending just diffs. The rsync feature is\n\
\032 off by default in the current version. Use the -rsync switch to\n\
\032 turn it on. (Nb. We still have a lot of tuning to do: you may not\n\
\032 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 option\n\
\032 -threads N to select the maximal number of concurrent threads\n\
\032 (default is 5). Multi-threaded and single-threaded clients/servers\n\
\032 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 must\n\
\032 have ocaml-3.00 and tk8.3. When installing tk8.3, put it in c:\\Tcl\n\
\032 rather than the suggested c:\\Program Files\\Tcl, and be sure to\n\
\032 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 directory\n\
\032 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 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 appropriate\n\
\032 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\
\n\
\032 in your profile (.unison/default.prf), you should put:\n\
\032 ignore = Regex \n\
\n\
\032 Moreover, two other styles of pattern are also recognized:\n\
\032 ignore = Name \n\
\n\
\032 matches any path in which one component matches , while\n\
\032 ignore = Path \n\
\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\
\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 is\n\
\032 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:///Users/bcpierce/current/unison/trunk/doc/temp.html#ssh-win\n\
\032 2. http://pauillac.inria.fr/~maranget/hevea/index.html\n\
"))
::
[];;
unison-2.48.3/strings.mli 000644 000766 000000 00000000246 12450317305 016234 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/strings.mli *)
(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
val docs : (string * (string * string)) list
unison-2.48.3/system/ 000755 000766 000000 00000000000 12467142517 015373 5 ustar 00bcpierce wheel 000000 000000 unison-2.48.3/system.ml 000644 000766 000000 00000001406 12450317305 015715 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/system.ml *)
(* Copyright 1999-2015, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
include System_impl.System
unison-2.48.3/system.mli 000644 000766 000000 00000000266 12450317305 016071 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/system.mli *)
(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
(* Operations on filesystem path *)
include System_intf.Full
unison-2.48.3/terminal.ml 000644 000766 000000 00000025723 12450317305 016214 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/terminal.ml *)
(* Copyright 1999-2015, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
(* Parsing messages from OpenSSH *)
(* Examples.
"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 Unix.Unix_error _ -> 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 Unix.Unix_error _ -> 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,
System.create_process cmd args new_stdin new_stdout new_stderr)
| Some (masterFd, slaveFd) ->
(*
Printf.printf "openpty returns %d--%d\n" (dumpFd fdM) (dumpFd fdS); flush stdout;
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 Unix.Unix_error _ ->
Printf.eprintf "Some error in create_session child\n";
flush stderr;
exit 127
end
| childPid ->
(*JV: FIX: we are leaking a file descriptor here. On the other hand,
we do not deal gracefully with lost connections anyway. *)
(* Keep a file descriptor so that we do not get EIO errors
when the OpenSSH 5.6 child process closes the file
descriptor before opening /dev/tty. *)
(* Unix.close slaveFd; *)
(Some (Lwt_unix.of_unix_file_descr masterFd), childPid)
end
let (>>=) = Lwt.bind
(* Wait until there is input. If there is terminal input s,
return Some s. Otherwise, return None. *)
let rec termInput fdTerm fdInput =
let buf = String.create 10000 in
let rec readPrompt () =
Lwt_unix.read fdTerm buf 0 10000 >>= fun len ->
if len = 0 then
(* The remote end is dead *)
Lwt.return None
else
let query = String.sub buf 0 len in
if query = "\r\n" then
readPrompt ()
else
Lwt.return (Some query)
in
let connectionEstablished () =
Lwt_unix.wait_read fdInput >>= fun () -> Lwt.return None
in
Lwt_unix.run
(Lwt.choose
[readPrompt (); connectionEstablished ()])
(* Read messages from the terminal and use the callback to get an answer *)
let handlePasswordRequests fdTerm callback =
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.48.3/terminal.mli 000644 000766 000000 00000001471 11324023546 016357 0 ustar 00bcpierce wheel 000000 000000 (* 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 ->
Lwt_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 :
Lwt_unix.file_descr -> Lwt_unix.file_descr -> string option
val handlePasswordRequests :
Lwt_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.48.3/test.ml 000644 000766 000000 00000044466 12450317305 015365 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/test.ml *)
(* Copyright 1999-2015, 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(Fs.lstat d) with Unix.Unix_error((Unix.ENOENT | Unix.ENOTDIR),_,_) -> None with
| Some(s) ->
if s.Unix.LargeFile.st_kind = Unix.S_DIR then begin
let handle = Fs.opendir d in
let rec loop () =
let r = try Some(handle.Fs.readdir ()) with End_of_file -> None in
match r with
| Some f ->
if f="." || f=".." then loop ()
else begin
remove_file_or_dir (Fspath.concat d (Path.fromString f));
loop ()
end
| None ->
handle.Fs.closedir ();
Fs.rmdir d
in loop ()
end else
Fs.unlink 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 = Fs.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 =
Fs.open_out_gen
[Open_wronly; Open_creat; Open_trunc; Open_binary] 0o600 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 = Fs.opendir d in
let rec do_read acc =
try
(match (d.Fs.readdir ()) 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
d.Fs.closedir ();
files
let extend p file = Fspath.concat p (Path.fromString 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 = Fs.lstat p in
match s.Unix.LargeFile.st_kind with
| Unix.S_REG -> File (read p)
| Unix.S_LNK -> Link (Fs.readlink p)
| Unix.S_DIR -> Dir (Safelist.map (fun x -> (x, loop (extend p x))) (read_dir p))
| _ -> assert false
in try Some(loop p) with
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"
(Fspath.toDebugString p) s (Fingerprint.toString (Fingerprint.string s)));
write p s
| Link s -> Fs.symlink s p
| Dir files ->
Fs.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.toPrintString fspath)));
Lwt.return ())
let makeRootEmpty : Common.root -> unit -> unit Lwt.t =
Remote.registerRootCmd
"makeRootEmpty"
(fun (fspath, ()) ->
remove_file_or_dir fspath;
Lwt.return ())
let getfs : Common.root -> unit -> (fs option) Lwt.t =
Remote.registerRootCmd
"getfs"
(fun (fspath, ()) ->
Lwt.return (readfs fspath))
let getbackup : Common.root -> unit -> (fs option) Lwt.t =
Remote.registerRootCmd
"getbackup"
(fun (fspath, ()) ->
Lwt.return (readfs (Stasher.backupDirectory ())))
let makeBackupEmpty : Common.root -> unit -> unit Lwt.t =
Remote.registerRootCmd
"makeBackupEmpty"
(fun (fspath, ()) ->
let b = Stasher.backupDirectory () in
debug (fun () -> Util.msg "Removing %s\n" (Fspath.toDebugString b));
Lwt.return (remove_file_or_dir b))
let putfs : Common.root -> fs -> unit Lwt.t =
Remote.registerRootCmd
"putfs"
(fun (fspath, fs) ->
writefs fspath 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 None) 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.toPrintString (Stasher.backupDirectory())) = None then
raise (Util.Fatal
("Self-tests can only be run if the 'backupdir' preference (or wherever the backup "
^ "directory name is coming from, e.g. the UNISONBACKUPDIR environment variable) "
^ "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 "fastercheckUNSAFE 1" ["fastercheckUNSAFE = true"] (fun() ->
put R1 (Dir []); put R2 (Dir []); sync();
(* Create a file on both sides with different contents *)
put R1 (Dir ["x", File "foo"]);
put R2 (Dir ["x", File "bar"]); sync();
check "1a" R1 (Dir ["x", File "foo"]);
check "1b" R2 (Dir ["x", File "bar"]);
(* Change contents on one side and see that we do NOT get a conflict (!) *)
put R1 (Dir ["x", File "newcontents"]); sync();
check "2a" R1 (Dir ["x", File "newcontents"]);
check "2b" R2 (Dir ["x", File "newcontents"]);
(* Start again *)
put R1 (Dir []); put R2 (Dir []); sync();
(* Create a file on both sides with different contents *)
put R1 (Dir ["x", File "foo"]);
put R2 (Dir ["x", File "bar"]); sync();
(* Change contents without changing size and check that change is propagated *)
put R1 (Dir ["x", File "f00"]); sync();
check "3a" R1 (Dir ["x", File "f00"]);
check "3b" R2 (Dir ["x", File "f00"]);
(* Start again *)
put R1 (Dir []); put R2 (Dir []); sync();
(* Create a new file on one side only *)
put R1 (Dir ["x", File "foo"]); sync();
(* Check that change is propagated *)
check "4" R2 (Dir ["x", File "foo"]);
);
(raise (Util.Fatal "Skipping some tests -- remove me!\n") : unit);
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.48.3/test.mli 000644 000766 000000 00000000250 12450317305 015515 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/test.mli *)
(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
(* Internal self-tests *)
val test: unit -> unit
unison-2.48.3/TODO.txt 000644 000766 000000 00000144747 12010744576 015373 0 ustar 00bcpierce wheel 000000 000000 Here we list planned and imagined improvements to Unison. Ones that we
regard as most important are marked with more *s. (Note that, 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
* =======
* Update the copyright dates in the OSX GUI
* Make some preferences per-host
- file-system type
- canonical name of the host
- fastcheck
- backup
- fs watcher command
* 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
* Rsync debugging
- 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)
* The directory scanning optimization is currently disabled under Windows,
as FAT partitions do not have directory modification times.
we could check whether we are on an NTFS partition by calling
GetVolumeInformation to get the filesystem name.
* We could defer most fingerprint computations to the propagation phase;
this would improve the user experience and save some fingerprints:
- do not compute fingerprint of new files during update detection
- during reconciliation, try to decide what to do based on what is
known so far
- for undecided paths (two files), request checksums (in batch)
- hashes are finally computed during propagation
###########################################################################
* 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).
**** 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
*** 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]
*** 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!?)
*** Overlapping paths
If one -path argument is a prefix of another, the same files will get
scanned twice, found to need transferring twice, and transferred twice, but
the first transfer messes up the second. The fix would be to throw
away -path arguments that are suffixes of other ones.
*** 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
* There is no way of selecting files with wildchar. I had to use
ignorenot = Name opt/root/.unison/*.prf
ignore = Name opt/root/.unison/*
But this is inconvinent, but the worse is that it gets complicated very
fast and I cannot make it for more complicated scenarios. I would expect
something like (suggestion):
Files = opt/root/.unison/*.prf
* If a directory does not exist in one of the host, unison (for
security reasons, which I like) pops up a window and Quit is the only
option. I would expect a message stating mere clearly on which host and
direcory and an option to create that directory. I had recently to make
a lot of reinstalls and new pendrives and it took a long time to create
all those dirs. Someone in the list even made a script to do the job!!!
* When synchronizing FAT32, there could be an explicit command for
ignoring attributes. The problem happens when one side is FAT32 but the
other is not, or when mounting parameters are different.
* 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)
should strip symbols from binary files in 'make exportnative'
* [Joerg von den Hoff, 2009] OS X: make the destination directory for the CL
version selectable (instead of dumping it in the middle of a systems
directory :-)) something like /usr/local/bin or whatever might frequently be
more suitable
* 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".
* SMALL FUNCTIONALITY IMPROVEMENTS
* ================================
**** Please let me say
root = ~/bla
instead of requiring me to give an absolute path to my home dir.
*** [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
*** 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)
*** 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.
*** 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.
** 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)
* [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
==> Also, "make" can get confused when the 'time' option is set
* 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.
* [Joerg von den Hoff, 2009] I use unison (up to now) only from the command
line and it's used from within scripts or Makefiles. it is therefore
unfortunate that by default the GUI pops up and one has to use `unison -ui
text' to avoid this. it would seem better to have it the other way round,
i.e., to make the CLI the default and to require `unison -ui graphic' to
start up the GUI from the command line (I would argue that people using the
GUI regularly will start it anyway by double clicking the app)
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?
==> Is that real memory or virtual memory?
[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).
[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.
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
Maybe we should never emit a conflict for modtimes; instead, we just
propagate the largest one.
[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.
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.
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.
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.48.3/transfer.ml 000644 000766 000000 00000073651 12450317305 016230 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/transfer.ml *)
(* Copyright 1999-2015, 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 minBlockSize = 700
(* This should at most 65535+3 bytes, as we are using this size to
ensure that string token lengths will fit in 2 bytes. *)
let queueSize = 65500
let queueSizeFS = Uutil.Filesize.ofInt queueSize
type tokenQueue =
{ mutable data : Bytearray.t; (* the queued tokens *)
mutable previous : [`Str of int | `Block of int | `None];
(* some information about the
previous token *)
mutable pos : int; (* head of the queue *)
mutable prog : int; (* the size of the data they represent *)
mutable bSize : int } (* block size *)
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 =
if Trace.enabled "rsynctoken" then
debugToken (fun() ->
Util.msg "pushing EOF (pos:%d/%d)\n" q.pos queueSize);
flushQueue q showProgress transmit
(q.pos + 1 > queueSize) >>= (fun () ->
assert (q.pos < queueSize);
q.data.{q.pos} <- 'E';
q.pos <- q.pos + 1;
q.previous <- `None;
return ())
let rec pushString q id transmit s pos len =
flushQueue q id transmit (q.pos + len + 3 > queueSize) >>= fun () ->
if Trace.enabled "rsynctoken" then
debugToken (fun() ->
Util.msg "pushing string (pos:%d/%d len:%d)\n" q.pos queueSize len);
let l = min len (queueSize - q.pos - 3) in
assert (l > 0);
q.data.{q.pos} <- 'S';
encodeInt2 q.data (q.pos + 1) l;
Bytearray.blit_from_string s pos q.data (q.pos + 3) l;
q.pos <- q.pos + l + 3;
q.prog <- q.prog + l;
q.previous <- `Str l;
if l < len then
pushString q id transmit s (pos + l) (len - l)
else
return ()
let growString q id transmit len' s pos len =
if Trace.enabled "rsynctoken" then
debugToken (fun() ->
Util.msg "growing string (pos:%d/%d len:%d+%d)\n"
q.pos queueSize len' len);
let l = min (queueSize - q.pos) len in
Bytearray.blit_from_string s pos q.data q.pos l;
assert (q.pos - len' - 3 >= 0);
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 > queueSize) >>= (fun () ->
if Trace.enabled "rsynctoken" then
debugToken (fun() ->
Util.msg "pushing block (pos:%d/%d)\n" q.pos queueSize);
assert (q.pos + 5 <= queueSize);
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 + q.bSize;
q.previous <- `Block (pos + 1);
return ())
let growBlock q id transmit pos =
if Trace.enabled "rsynctoken" then
debugToken (fun() ->
Util.msg "growing blocks (pos:%d/%d)\n" q.pos queueSize);
assert (q.pos >= 5);
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 + q.bSize;
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 blockSize =
{ 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 queueSize;
pos = 0; previous = `None; prog = 0;
bSize = blockSize }
(*************************************************************************)
(* 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 0 in
let rec sendSlice length =
if length > Uutil.Filesize.zero then begin
let count =
reallyRead infd buf 0
(if length > bufSzFS then bufSz else Uutil.Filesize.toInt length) in
if count = 0 then
Lwt.return ()
else begin
queueToken q showProgress transmit (STRING (buf, 0, count))
>>= fun () ->
let length = Uutil.Filesize.sub length (Uutil.Filesize.ofInt count) in
sendSlice length
end
end else
Lwt.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 minBlockSizeFs = Uutil.Filesize.ofInt minBlockSize
let aboveRsyncThreshold sz = sz > minBlockSizeFs
(* The type of the info that will be sent to the source host *)
type rsync_block_info =
{ blockSize : int;
blockCount : int;
checksumSize : int;
weakChecksum :
(int32, Bigarray.int32_elt, Bigarray.c_layout) Bigarray.Array1.t;
strongChecksum : Bytearray.t }
(*** PREPROCESS ***)
(* Worst case probability of a failure *)
let logProba = -27. (* One time in 100 millions *)
(* Strength of the weak checksum
(how many bit of the weak checksum we can rely on) *)
let weakLen = 27.
(* This is what rsync uses:
let logProba = -10.
let weakLen = 31.
This would save almost 3 bytes per block, but one need to be able
to recover from an rsync error.
(We would have to take into account that our weak checksum is
only 31 bits.)
*)
(* Block size *)
let computeBlockSize l = truncate (max 700. (min (sqrt l) 131072.))
(* Size of each strong checksum *)
let checksumSize bs sl dl =
let bits =
-. logProba -. weakLen +. log (sl *. dl /. float bs) /. log 2. in
max 2 (min 16 (truncate ((bits +. 7.99) /. 8.)))
let sizes srcLength dstLength =
let blockSize = computeBlockSize (Uutil.Filesize.toFloat dstLength) in
let blockCount =
let count =
Int64.div (Uutil.Filesize.toInt64 dstLength) (Int64.of_int blockSize)
in
Int64.to_int (min 16777216L count)
in
let csSize =
checksumSize blockSize
(Uutil.Filesize.toFloat srcLength)(Uutil.Filesize.toFloat dstLength)
in
(blockSize, blockCount, csSize)
(* 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 blockSize maxCount =
let bufferSize = 8192 + blockSize in
let buffer = String.create bufferSize in
let rec iter count offset length =
if count = maxCount then
count
else begin
let newOffset = offset + blockSize in
if newOffset <= length then begin
f count buffer offset;
iter (count + 1) newOffset length
end else if offset > 0 then begin
let chunkSize = length - offset in
String.blit buffer offset buffer 0 chunkSize;
iter count 0 chunkSize
end else begin
let l = input infd buffer length (bufferSize - length) in
if l = 0 then
count
else
iter count 0 (length + l)
end
end
in
iter 0 0 0
(* Given a block size, get blocks from the old file and compute a
checksum and a fingerprint for each one. *)
let rsyncPreprocess infd srcLength dstLength =
debug (fun() -> Util.msg "preprocessing\n");
let (blockSize, blockCount, csSize) = sizes srcLength dstLength in
debugLog (fun() ->
Util.msg "block size = %d bytes; block count = %d; \
strong checksum size = %d\n" blockSize blockCount csSize);
let timer = Trace.startTimer "Preprocessing old file" in
let weakCs =
Bigarray.Array1.create Bigarray.int32 Bigarray.c_layout blockCount in
let strongCs = Bytearray.create (blockCount * csSize) in
let addBlock i buf offset =
weakCs.{i} <- Int32.of_int (Checksum.substring buf offset blockSize);
Bytearray.blit_from_string
(Digest.substring buf offset blockSize) 0 strongCs (i * csSize) csSize
in
(* Make sure we are at the beginning of the file
(important for AppleDouble files *)
LargeFile.seek_in infd 0L;
let count =
(* Limit the number of blocks so that there is no overflow in
encodeInt3 *)
blockIter infd addBlock blockSize (min blockCount (256*256*256)) in
debugLog (fun() -> Util.msg "%d blocks\n" count);
Trace.showTimer timer;
let sigs =
{ blockSize = blockSize; blockCount = count; checksumSize = csSize;
weakChecksum = weakCs; strongChecksum = strongCs } in
if
sigs.blockCount > Bigarray.Array1.dim sigs.weakChecksum ||
sigs.blockCount * sigs.checksumSize >
Bigarray.Array1.dim sigs.strongChecksum
then
raise
(Util.Transient
(Format.sprintf
"Internal error during rsync transfer (preprocess), \
please report: %d %d - %d %d"
sigs.blockCount (Bigarray.Array1.dim sigs.weakChecksum)
(sigs.blockCount * sigs.checksumSize)
(Bigarray.Array1.dim sigs.strongChecksum)));
(sigs, blockSize)
(* Expected size of the [rsync_block_info] datastructure (in KiB). *)
let memoryFootprint srcLength dstLength =
let (blockSize, blockCount, csSize) = sizes srcLength dstLength in
blockCount * (csSize + 4)
(*** 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 blockSize 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 (Int64.of_int blockSize));
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 ***)
(* Half the 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 = 1024 * 1024
let rec upperPowerOfTwo n n2 =
if (n2 >= n) || (n2 = hashTableMaxLength) then
n2
else
upperPowerOfTwo n (2 * n2)
let hash checksum = checksum
(* Compute the hash table length as a function of the number of blocks *)
let computeHashTableLength signatures =
2 * (upperPowerOfTwo signatures.blockCount 32)
(* Hash the block signatures into the hash table *)
let hashSig hashTableLength signatures =
let hashTable = Array.make hashTableLength [] in
for k = 0 to signatures.blockCount - 1 do
let cs = Int32.to_int signatures.weakChecksum.{k} land 0x7fffffff in
let h = (hash cs) land (hashTableLength - 1) in
hashTable.(h) <- (k, cs) :: hashTable.(h)
done;
hashTable
(* Given a key, retrieve the corresponding entry in the table *)
let findEntry hashTable hashTableLength checksum :
(int * Checksum.t) list =
let i = (hash checksum) land (hashTableLength - 1) in
hashTable.(i)
let sigFilter hashTableLength signatures =
let len = hashTableLength lsl 2 in
let filter = String.make len '\000' in
for k = 0 to signatures.blockCount - 1 do
let cs = Int32.to_int signatures.weakChecksum.{k} land 0x7fffffff in
let h1 = cs lsr 28 in
assert (h1 >= 0 && h1 < 8);
let h2 = (cs lsr 5) land (len - 1) in
let mask = 1 lsl h1 in
filter.[h2] <- Char.chr (Char.code filter.[h2] lor mask)
done;
filter
let filterMem filter hashTableLength checksum =
let len = hashTableLength lsl 2 in
let h2 = (checksum lsr 5) land (len - 1) in
let h1 = checksum lsr 28 in
let mask = 1 lsl h1 in
Char.code (String.unsafe_get filter h2) land mask <> 0
(* 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 missMiss : int;
mutable nbBlock : int;
mutable nbString : int;
mutable stringSize : int
}
let logMeasures pb =
debugLog (fun() -> Util.msg
"hit-hit = %d, hit-miss = %d, miss-miss = %d, hit rate = %d%%\n"
pb.hitHit pb.hitMiss pb.missMiss
(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 minComprBufSize = 8192
type compressorState =
{ (* Rolling checksum data *)
mutable checksum : int;
mutable cksumOutgoing : char;
(* Buffering *)
mutable offset : int;
mutable toBeSent : int;
mutable length : int;
(* Position in file *)
mutable absolutePos : Uutil.Filesize.t }
(* Compress the file using the algorithm described in the header *)
let rsyncCompress sigs infd srcLength showProgress transmit =
debug (fun() -> Util.msg "compressing\n");
if
sigs.blockCount > Bigarray.Array1.dim sigs.weakChecksum ||
sigs.blockCount * sigs.checksumSize >
Bigarray.Array1.dim sigs.strongChecksum
then
raise
(Util.Transient
(Format.sprintf
"Internal error during rsync transfer (compression), \
please report: %d %d - %d %d"
sigs.blockCount (Bigarray.Array1.dim sigs.weakChecksum)
(sigs.blockCount * sigs.checksumSize)
(Bigarray.Array1.dim sigs.strongChecksum)));
let blockSize = sigs.blockSize in
let comprBufSize = (2 * blockSize + 8191) land (-8192) in
let comprBufSizeFS = Uutil.Filesize.ofInt comprBufSize in
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; missMiss = 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 blockSize 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 = computeHashTableLength sigs in
let blockTable = hashSig hashTableLength sigs in
logHash blockTable hashTableLength;
let filter = sigFilter hashTableLength sigs in
let rec fingerprintMatchRec checksums pos fp i =
let i = i - 1 in
i < 0 ||
(fp.[i] = checksums.{pos + i} &&
fingerprintMatchRec checksums pos fp i)
in
let fingerprintMatch k fp =
let pos = k * sigs.checksumSize in
(*FIX: temporary debugging code... *)
if
pos + sigs.checksumSize > Bigarray.Array1.dim sigs.strongChecksum
then
raise
(Util.Transient
(Format.sprintf "Internal error during rsync transfer, \
please report: \
k:%d/%d pos:%d csSize:%d dim:%d"
k sigs.blockCount pos sigs.checksumSize
(Bigarray.Array1.dim sigs.strongChecksum)));
fingerprintMatchRec sigs.strongChecksum pos fp sigs.checksumSize
in
(* 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 cksumTable = Checksum.init blockSize in
let initialState =
{ checksum = 0; cksumOutgoing = ' ';
offset = comprBufSize; toBeSent = comprBufSize; length = comprBufSize;
absolutePos = Uutil.Filesize.zero }
in
(* Check the new window position and update the compression buffer
if its end has been reached *)
let rec slideWindow st miss : unit Lwt.t =
if st.offset + blockSize <= st.length then
computeChecksum st miss
else if st.length = comprBufSize then begin
transmitString st.toBeSent st.offset >>= (fun () ->
let chunkSize = st.length - st.offset in
if chunkSize > 0 then begin
assert(comprBufSize >= blockSize);
String.blit comprBuf st.offset comprBuf 0 chunkSize
end;
let rem = Uutil.Filesize.sub srcLength st.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
st.absolutePos <-
Uutil.Filesize.add st.absolutePos (Uutil.Filesize.ofInt l);
st.offset <- 0;
st.toBeSent <- 0;
st.length <- chunkSize + l;
debugToken (fun() -> Util.msg "updating the compression buffer\n");
debugToken (fun() -> Util.msg "new length = %d bytes\n" st.length);
slideWindow st miss)
end else
transmitString st.toBeSent st.length >>= (fun () ->
transmit EOF)
(* Compute the window contents checksum, in a rolling fashion if there
was a miss *)
and computeChecksum st miss =
if miss then
rollChecksum st
else begin
let cksum = Checksum.substring comprBuf st.offset blockSize in
st.checksum <- cksum;
st.cksumOutgoing <- String.unsafe_get comprBuf st.offset;
processBlock st
end
and rollChecksum st =
let ingoingChar =
String.unsafe_get comprBuf (st.offset + blockSize - 1) in
let cksum =
Checksum.roll cksumTable st.checksum st.cksumOutgoing ingoingChar in
st.checksum <- cksum;
st.cksumOutgoing <- String.unsafe_get comprBuf st.offset;
if filterMem filter hashTableLength cksum then
processBlock st
else
miss st
(* Try to match the current block with one existing in the old file *)
and processBlock st =
let checksum = st.checksum in
match findEntry blockTable hashTableLength checksum with
| [] ->
pb.missMiss <- pb.missMiss + 1;
miss st
| entry ->
let blockNum = findBlock st checksum entry None in
if blockNum = -1 then begin
pb.hitMiss <- pb.hitMiss + 1;
miss st
end else begin
pb.hitHit <- pb.hitHit + 1;
hit st blockNum
end
(* In the hash table entry, find nodes with the right checksum and
match fingerprints *)
and findBlock st checksum entry fingerprint =
match entry, fingerprint with
| [], _ ->
-1
| (k, cs) :: tl, None
when cs = checksum ->
let fingerprint = Digest.substring comprBuf st.offset blockSize in
findBlock st checksum entry (Some fingerprint)
| (k, cs) :: tl, Some fingerprint
when cs = checksum && fingerprintMatch k fingerprint ->
k
| _ :: tl, _ ->
findBlock st checksum tl fingerprint
(* Miss : slide the window one character ahead *)
and miss st =
st.offset <- st.offset + 1;
if st.offset + blockSize <= st.length then
rollChecksum st
else
slideWindow st true
(* Hit : send the data waiting and a BLOCK token, then slide the window
one block ahead *)
and hit st blockNum =
transmitString st.toBeSent st.offset >>= (fun () ->
let sent = st.offset in
st.toBeSent <- sent + blockSize;
transmit (BLOCK blockNum) >>= (fun () ->
st.offset <- st.offset + blockSize;
slideWindow st false))
in
(* Initialization and termination *)
slideWindow initialState false >>= (fun () ->
flushTokenQueue () >>= (fun () ->
logMeasures pb;
Trace.showTimer timer;
return ()))
end
unison-2.48.3/transfer.mli 000644 000766 000000 00000011220 12450317305 016361 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/transfer.mli *)
(* Copyright 1999-2015, 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
(* Expected size of the [rsync_block_info] datastructure (in KiB). *)
val memoryFootprint : Uutil.Filesize.t -> Uutil.Filesize.t -> int
(* Compute block information from the old file *)
val rsyncPreprocess :
in_channel (* old file descriptor *)
-> Uutil.Filesize.t (* source file length *)
-> Uutil.Filesize.t (* destination file length *)
-> rsync_block_info * int
(* Interpret a transfer instruction *)
val rsyncDecompress :
int (* block size *)
-> in_channel (* old file descriptor *)
-> out_channel (* output file descriptor *)
-> (int -> unit) (* progress report *)
-> transfer_instruction (* transfer instruction received *)
-> bool
(*** SOURCE HOST ***)
(* Using block information, parse the new file and send transfer
instructions accordingly *)
val rsyncCompress :
rsync_block_info
(* 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.48.3/transport.ml 000644 000766 000000 00000020227 12450317305 016427 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/transport.ml *)
(* Copyright 1999-2015, 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" 0
"!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 \
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. \
The default is the special value 0, which mean 20 threads \
when file content streaming is desactivated and 1000 threads \
when it is activated.")
let actionReg = Lwt_util.make_region 50
(* 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 doAction
fromRoot fromPath fromContents toRoot toPath toContents notDefault id =
(* When streaming, we can transfer many file simultaneously:
as the contents of only one file is transferred in one direction
at any time, little resource is consumed this way. *)
let limit =
let n = Prefs.read maxthreads in
if n > 0 then n else
if Prefs.read Remote.streamingActivated then 1000 else 20
in
Lwt_util.resize_region actionReg limit;
Lwt_util.resize_region Files.copyReg limit;
Lwt_util.run_in_region actionReg 1 (fun () ->
if not !Trace.sendLogMsgsToStderr then
Trace.statusDetail (Path.toString toPath);
Remote.Thread.unwindProtect (fun () ->
match fromContents, toContents with
{typ = `ABSENT}, {ui = uiTo} ->
logLwtNumbered
("Deleting " ^ Path.toString toPath ^
"\n from "^ root2string toRoot)
("Deleting " ^ Path.toString toPath)
(fun () ->
Files.delete fromRoot fromPath toRoot toPath uiTo notDefault)
(* 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.) *)
| {status= `Unchanged | `PropsChanged; desc= fromProps; ui= uiFrom},
{status= `Unchanged | `PropsChanged; desc= toProps; ui = uiTo} ->
logLwtNumbered
("Copying properties for " ^ Path.toString toPath
^ "\n from " ^ root2string fromRoot ^ "\n to " ^
root2string toRoot)
("Copying properties for " ^ Path.toString toPath)
(fun () ->
Files.setProp
fromRoot fromPath toRoot toPath fromProps toProps uiFrom uiTo)
| {typ = `FILE; ui = uiFrom}, {typ = `FILE; ui = uiTo} ->
logLwtNumbered
("Updating file " ^ Path.toString toPath ^ "\n from " ^
root2string fromRoot ^ "\n to " ^
root2string toRoot)
("Updating file " ^ Path.toString toPath)
(fun () ->
Files.copy (`Update (fileSize uiFrom uiTo))
fromRoot fromPath uiFrom [] toRoot toPath uiTo []
notDefault id)
| {ui = uiFrom; props = propsFrom}, {ui = uiTo; props = propsTo} ->
logLwtNumbered
("Copying " ^ Path.toString toPath ^ "\n from " ^
root2string fromRoot ^ "\n to " ^
root2string toRoot)
("Copying " ^ Path.toString toPath)
(fun () ->
Files.copy `Copy
fromRoot fromPath uiFrom propsFrom
toRoot toPath uiTo propsTo
notDefault id))
(fun e -> Trace.log
(Printf.sprintf
"Failed: %s\n" (Util.printException e));
return ()))
let propagate root1 root2 reconItem id showMergeFn =
let path = reconItem.path1 in
match reconItem.replicas with
Problem p ->
Trace.log (Printf.sprintf "[ERROR] Skipping %s\n %s\n"
(Path.toString path) p);
return ()
| Different
{rc1 = rc1; rc2 = rc2; direction = dir; default_direction = def} ->
let notDefault = dir <> def in
match dir with
Conflict c ->
Trace.log (Printf.sprintf "[CONFLICT] Skipping %s\n %s\n"
(Path.toString path) c);
return ()
| Replica1ToReplica2 ->
doAction
root1 reconItem.path1 rc1 root2 reconItem.path2 rc2 notDefault id
| Replica2ToReplica1 ->
doAction
root2 reconItem.path2 rc2 root1 reconItem.path1 rc1 notDefault id
| Merge ->
if rc1.typ <> `FILE || rc2.typ <> `FILE then
raise (Util.Transient "Can only merge two existing files");
Files.merge
root1 reconItem.path1 rc1.ui root2 reconItem.path2 rc2.ui id
showMergeFn;
return ()
let transportItem reconItem id showMergeFn =
let (root1,root2) = Globals.roots() in
propagate root1 root2 reconItem id showMergeFn
(* ---------------------------------------------------------------------- *)
let logStart () =
Abort.reset ();
let t = Unix.gettimeofday () in
let tm = Util.localtime t in
let m =
Printf.sprintf
"%s%s started propagating changes at %02d:%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
(min 99 (truncate (mod_float t 1. *. 100.)))
tm.Unix.tm_mday (Util.monthname tm.Unix.tm_mon)
(tm.Unix.tm_year+1900) in
Trace.logverbose m
let logFinish () =
let t = Unix.gettimeofday () in
let tm = Util.localtime t in
let m =
Printf.sprintf
"%s finished propagating changes at %02d:%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
(min 99 (truncate (mod_float t 1. *. 100.)))
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.48.3/transport.mli 000644 000766 000000 00000001144 12450317305 016575 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/transport.mli *)
(* Copyright 1999-2015, 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.48.3/tree.ml 000644 000766 000000 00000006057 12450317305 015337 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/tree.ml *)
(* Copyright 1999-2015, 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.48.3/tree.mli 000644 000766 000000 00000005663 12450317305 015512 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/tree.mli *)
(* Copyright 1999-2015, 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.48.3/ubase/ 000755 000766 000000 00000000000 12467142516 015145 5 ustar 00bcpierce wheel 000000 000000 unison-2.48.3/ui.mli 000644 000766 000000 00000000440 12450317305 015154 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/ui.mli *)
(* Copyright 1999-2015, 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.48.3/uicommon.ml 000644 000766 000000 00000067441 12450317305 016232 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/uicommon.ml *)
(* Copyright 1999-2015, 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" 15
"!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 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. When the argument is \\verb|watch|, Unison relies on "
^ "an external file monitoring process to synchronize whenever a change "
^ "happens.")
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 committing 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 committed "
^ " 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 replicaContentDesc rc =
Props.toString (Props.setLength rc.desc (snd rc.size))
let replicaContent2string rc sep =
let d s = s ^ sep ^ replicaContentDesc rc ^ prevProps rc.desc rc.ui in
match rc.typ, rc.status with
`ABSENT, `Unchanged ->
"absent"
| _, `Unchanged ->
"unchanged "
^(Util.truncateString (Fileinfo.type2string rc.typ) 7)
^ sep
^ replicaContentDesc rc
| `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 =
match rc.typ, rc.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 = rc1; rc2 = 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)
type action = AError | ASkip of bool | ALtoR of bool | ARtoL of bool | AMerge
let direction2action partial dir =
match dir with
Conflict _ -> ASkip partial
| Replica1ToReplica2 -> ALtoR partial
| Replica2ToReplica1 -> ARtoL partial
| Merge -> AMerge
let action2niceString action =
match action with
AError -> "error"
| ASkip _ -> "<-?->"
| ALtoR false -> "---->"
| ALtoR true -> "--?->"
| ARtoL false -> "<----"
| ARtoL true -> "<-?--"
| AMerge -> "<-M->"
let reconItem2stringList oldPath theRI =
match theRI.replicas with
Problem s ->
(" ", AError, " ", displayPath oldPath theRI.path1)
| Different diff ->
let partial = diff.errors1 <> [] || diff.errors2 <> [] in
(replicaContent2shortString diff.rc1,
direction2action partial diff.direction,
replicaContent2shortString diff.rc2,
displayPath oldPath theRI.path1)
let reconItem2string oldPath theRI status =
let (r1, action, r2, path) = reconItem2stringList oldPath theRI in
Format.sprintf "%s %s %s %s %s" r1 (action2niceString action) r2 status path
let exn2string e =
match e with
Sys.Break -> "Terminated!"
| Util.Fatal(s) -> Printf.sprintf "Fatal error: %s" s
| Util.Transient(s) -> Printf.sprintf "Error: %s" s
| Unix.Unix_error (err, fun_name, arg) ->
Printf.sprintf "Uncaught unix error: %s failed%s: %s%s\n%s"
fun_name
(if String.length arg > 0 then Format.sprintf " on \"%s\"" arg else "")
(Unix.error_message err)
(match err with
Unix.EUNKNOWNERR n -> Format.sprintf " (code %d)" n
| _ -> "")
(Printexc.get_backtrace ())
| Invalid_argument s ->
Printf.sprintf "Invalid argument: %s\n%s" s (Printexc.get_backtrace ())
| other -> Printf.sprintf "Uncaught exception %s\n%s"
(Printexc.to_string other) (Printexc.get_backtrace ())
(* precondition: uc = File (Updates(_, ..) on both sides *)
let showDiffs ri printer errprinter id =
match ri.replicas with
Problem _ ->
errprinter
"Can't diff files: there was a problem during update detection"
| Different {rc1 = {typ = `FILE; ui = ui1}; rc2 = {typ = `FILE; ui = ui2}} ->
let (root1,root2) = Globals.roots() in
begin
try Files.diff root1 ri.path1 ui1 root2 ri.path2 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.)\n"
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.)\n"
(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"
(* ---- *)
(*FIX: remove when Unison version > 2.40 *)
let _ =
Remote.registerRootCmd "_unicodeCaseSensitive_" (fun _ -> Lwt.return ())
let supportUnicodeCaseSensitive () =
if Uutil.myMajorVersion > "2.40" (* The test is correct until 2.99... *) then
Lwt.return true
else begin
Globals.allRootsMap
(fun r -> Remote.commandAvailable r "_unicodeCaseSensitive_")
>>= fun l ->
Lwt.return (List.for_all (fun x -> x) l)
end
(* Determine the case sensitivity of a root (does filename FOO==foo?) *)
let architecture =
Remote.registerRootCmd
"architecture"
(fun (_,()) -> return (Util.osType = `Win32, Osx.isMacOSX, Util.isCygwin))
(* 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. Also, detects HFS (needed for resource forks) and
Windows (needed for permissions) and does some sanity checking. *)
let validateAndFixupPrefs () =
Props.validatePrefs();
let supportUnicodeCaseSensitive = supportUnicodeCaseSensitive () in
Globals.allRootsMap (fun r -> architecture r ()) >>= (fun archs ->
supportUnicodeCaseSensitive >>= fun unicodeCS ->
let someHostIsRunningWindows =
Safelist.exists (fun (isWin, _, _) -> isWin) archs in
let allHostsAreRunningWindows =
Safelist.for_all (fun (isWin, _, _) -> isWin) archs in
let someHostIsRunningBareWindows =
Safelist.exists (fun (isWin, _, isCyg) -> isWin && not isCyg) archs in
let someHostRunningOsX =
Safelist.exists (fun (_, isOSX, _) -> isOSX) archs in
let someHostIsCaseInsensitive =
someHostIsRunningWindows || someHostRunningOsX in
if Prefs.read Globals.fatFilesystem then begin
Prefs.overrideDefault Props.permMask 0;
Prefs.overrideDefault Props.dontChmod true;
Prefs.overrideDefault Case.caseInsensitiveMode `True;
Prefs.overrideDefault Fileinfo.allowSymlinks `False;
Prefs.overrideDefault Fileinfo.ignoreInodeNumbers true
end;
Case.init someHostIsCaseInsensitive (someHostRunningOsX && unicodeCS);
Props.init someHostIsRunningWindows;
Osx.init someHostRunningOsX;
Fileinfo.init someHostIsRunningBareWindows;
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 [r1; r2];
(* 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)
(* Roots given on the command line *)
let cmdLineRawRoots = ref []
(* 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();
Globals.setRawRoots !cmdLineRawRoots;
(* 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(System.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. *)
(* JV (6/09): always reparse the command line *)
if true (*!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;
Recon.checkThatPreferredRootIsValid();
(* The following step contacts the server, so warn the user it could take
some time *)
if 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
numRemote > 0 && 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");
Lwt_unix.run
(validateAndFixupPrefs () >>=
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
| [root2;root1] -> cmdLineRawRoots := [root1;root2]
| [root2;root1;profile] ->
cmdLineRawRoots := [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 !cmdLineRawRoots 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 clroots_given = !cmdLineRawRoots <> [] in
let n =
if not(clroots_given) then begin
(* 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
(* Roots given on command line.
The profile should be the default. *)
clprofile := Some "default";
"default"
end in
n
| Some n ->
let f = Prefs.profilePathname n in
if not(System.file_exists f)
then (reportError (Printf.sprintf "Profile %s does not exist"
(System.fspathToPrintString 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.48.3/uicommon.mli 000644 000766 000000 00000007163 12450317305 016376 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/uicommon.mli *)
(* Copyright 1999-2015, 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: 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 committing 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
type action = AError | ASkip of bool | ALtoR of bool | ARtoL of bool | AMerge
(* Same as previous function, but returns a tuple of strings *)
val reconItem2stringList :
Path.t -> Common.reconItem -> string * action * 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 validateAndFixupPrefs : 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.48.3/uigtk2.ml 000644 000766 000000 00000464431 12450317305 015611 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/uigtk2.ml *)
(* Copyright 1999-2015, 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 fontMonospace = lazy (Pango.Font.from_string "monospace")
let fontBold = lazy (Pango.Font.from_string "bold")
let fontItalic = lazy (Pango.Font.from_string "italic")
(**********************************************************************
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
let leftPtrWatch =
lazy
(let bitmap =
Gdk.Bitmap.create_from_data
~width:32 ~height:32 Pixmaps.left_ptr_watch
in
let color =
Gdk.Color.alloc ~colormap:(Gdk.Color.get_system_colormap ()) `BLACK in
Gdk.Cursor.create_from_pixmap
(bitmap :> Gdk.pixmap) ~mask:bitmap ~fg:color ~bg:color ~x:2 ~y:2)
let make_busy w =
if Util.osType <> `Win32 then
Gdk.Window.set_cursor w#misc#window (Lazy.force leftPtrWatch)
let make_interactive w =
if Util.osType <> `Win32 then
(* HACK: setting the cursor to NULL restore the default cursor *)
Gdk.Window.set_cursor w#misc#window (Obj.magic Gpointer.boxed_null)
(*********************************************************************
UI state variables
*********************************************************************)
type stateItem = { mutable ri : reconItem;
mutable bytesTransferred : Uutil.Filesize.t;
mutable bytesToTransfer : Uutil.Filesize.t;
mutable whatHappened : (Util.confirmation * string option) option}
let theState = ref [||]
let unsynchronizedPaths = ref None
module IntSet = Set.Make (struct type t = int let compare = compare end)
let current = ref IntSet.empty
let currentRow () =
if IntSet.cardinal !current = 1 then Some (IntSet.choose !current) else None
(* ---- *)
let theToplevelWindow = ref None
let setToplevelWindow w = theToplevelWindow := Some w
let toplevelWindow () =
match !theToplevelWindow with
Some w -> w
| None -> assert false
(*********************************************************************
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 last = ref (0.)
let gtk_sync forced =
let t = Unix.gettimeofday () in
if !last = 0. || forced || t -. !last > 0.05 then begin
last := t;
begin match !sync_action with
Some f -> f ()
| None -> ()
end;
while Glib.Main.iteration false do () done
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 =
[| 0x0020; 0x0001; 0x0002; 0x0003; 0x0004; 0x0005; 0x0006; 0x0007;
0x0008; 0x0009; 0x000A; 0x000B; 0x000C; 0x000D; 0x000E; 0x000F;
0x0010; 0x0011; 0x0012; 0x0013; 0x0014; 0x0015; 0x0016; 0x0017;
0x0018; 0x0019; 0x001A; 0x001B; 0x001C; 0x001D; 0x001E; 0x001F;
0x0020; 0x0021; 0x0022; 0x0023; 0x0024; 0x0025; 0x0026; 0x0027;
0x0028; 0x0029; 0x002A; 0x002B; 0x002C; 0x002D; 0x002E; 0x002F;
0x0030; 0x0031; 0x0032; 0x0033; 0x0034; 0x0035; 0x0036; 0x0037;
0x0038; 0x0039; 0x003A; 0x003B; 0x003C; 0x003D; 0x003E; 0x003F;
0x0040; 0x0041; 0x0042; 0x0043; 0x0044; 0x0045; 0x0046; 0x0047;
0x0048; 0x0049; 0x004A; 0x004B; 0x004C; 0x004D; 0x004E; 0x004F;
0x0050; 0x0051; 0x0052; 0x0053; 0x0054; 0x0055; 0x0056; 0x0057;
0x0058; 0x0059; 0x005A; 0x005B; 0x005C; 0x005D; 0x005E; 0x005F;
0x0060; 0x0061; 0x0062; 0x0063; 0x0064; 0x0065; 0x0066; 0x0067;
0x0068; 0x0069; 0x006A; 0x006B; 0x006C; 0x006D; 0x006E; 0x006F;
0x0070; 0x0071; 0x0072; 0x0073; 0x0074; 0x0075; 0x0076; 0x0077;
0x0078; 0x0079; 0x007A; 0x007B; 0x007C; 0x007D; 0x007E; 0x007F;
0x20AC; 0x1234; 0x201A; 0x0192; 0x201E; 0x2026; 0x2020; 0x2021;
0x02C6; 0x2030; 0x0160; 0x2039; 0x0152; 0x1234; 0x017D; 0x1234;
0x1234; 0x2018; 0x2019; 0x201C; 0x201D; 0x2022; 0x2013; 0x2015;
0x02DC; 0x2122; 0x0161; 0x203A; 0x0153; 0x1234; 0x017E; 0x0178;
0x00A0; 0x00A1; 0x00A2; 0x00A3; 0x00A4; 0x00A5; 0x00A6; 0x00A7;
0x00A8; 0x00A9; 0x00AA; 0x00AB; 0x00AC; 0x00AD; 0x00AE; 0x00AF;
0x00B0; 0x00B1; 0x00B2; 0x00B3; 0x00B4; 0x00B5; 0x00B6; 0x00B7;
0x00B8; 0x00B9; 0x00BA; 0x00BB; 0x00BC; 0x00BD; 0x00BE; 0x00BF;
0x00C0; 0x00C1; 0x00C2; 0x00C3; 0x00C4; 0x00C5; 0x00C6; 0x00C7;
0x00C8; 0x00C9; 0x00CA; 0x00CB; 0x00CC; 0x00CD; 0x00CE; 0x00CF;
0x00D0; 0x00D1; 0x00D2; 0x00D3; 0x00D4; 0x00D5; 0x00D6; 0x00D7;
0x00D8; 0x00D9; 0x00DA; 0x00DB; 0x00DC; 0x00DD; 0x00DE; 0x00DF;
0x00E0; 0x00E1; 0x00E2; 0x00E3; 0x00E4; 0x00E5; 0x00E6; 0x00E7;
0x00E8; 0x00E9; 0x00EA; 0x00EB; 0x00EC; 0x00ED; 0x00EE; 0x00EF;
0x00F0; 0x00F1; 0x00F2; 0x00F3; 0x00F4; 0x00F5; 0x00F6; 0x00F7;
0x00F8; 0x00F9; 0x00FA; 0x00FB; 0x00FC; 0x00FD; 0x00FE; 0x00FF |]
let rec transcodeRec buf s i l =
if i < l then begin
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 escapeMarkup s = Glib.Markup.escape_text s
let transcodeFilename s =
if Prefs.read Case.unicodeEncoding then
Unicode.protect s
else if Util.osType = `Win32 then transcodeDoc s else
try
Glib.Convert.filename_to_utf8 s
with Glib.Convert.Error _ ->
Unicode.protect s
let transcode s =
if Prefs.read Case.unicodeEncoding then
Unicode.protect s
else
try
Glib.Convert.locale_to_utf8 s
with Glib.Convert.Error _ ->
Unicode.protect s
(**********************************************************************
USEFUL LOW-LEVEL WIDGETS
**********************************************************************)
class scrolled_text ?editable ?shadow_type ?word_wrap
~width ~height ?packing ?show
() =
let sw =
GBin.scrolled_window ?packing ~show:false
?shadow_type ~hpolicy:`NEVER ~vpolicy:`AUTOMATIC ()
in
let text = GText.view ?editable ~wrap_mode:`WORD ~packing:sw#add () in
object
inherit GObj.widget_full sw#as_widget
method text = text
method insert s = text#buffer#set_text s;
method show () = sw#misc#show ()
initializer
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 ~parent ~title ~typ ~message =
let t =
GWindow.message_dialog
~parent ~title ~message_type:typ ~message ~modal:true
~buttons:GWindow.Buttons.ok () in
ignore (t#run ()); t#destroy ()
(* ------ *)
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 ?(kind=`DIALOG_WARNING) ~parent ~title ~astock ~bstock message =
let t =
GWindow.dialog ~parent ~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:kind ~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;
t#show();
let res = t#run () in
t#destroy ();
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 ~parent:(toplevelWindow ()) ~title:"Premature exit"
~astock:`YES ~bstock:`NO
"Unison is working, exit anyway ?"
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 ~parent 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 ~parent
~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 ~parent:(toplevelWindow ()) ~title ~astock:`OK ~bstock:`QUIT
message in
if not(ok) then doExit ();
inExit := false
end
(****)
let accel_paths = Hashtbl.create 17
let underscore_re = Str.regexp_string "_"
class ['a] gMenuFactory
?(accel_group=GtkData.AccelGroup.create ())
?(accel_path="/")
?(accel_modi=[`CONTROL])
?(accel_flags=[`VISIBLE]) (menu_shell : 'a) =
object (self)
val menu_shell : #GMenu.menu_shell = menu_shell
val group = accel_group
val m = accel_modi
val flags = (accel_flags:Gtk.Tags.accel_flag list)
val accel_path = accel_path
method menu = menu_shell
method accel_group = group
method accel_path = accel_path
method private bind
?(modi=m) ?key ?callback label ?(name=label) (item : GMenu.menu_item) =
menu_shell#append item;
let accel_path = accel_path ^ name in
let accel_path = Str.global_replace underscore_re "" accel_path in
(* Default accel path value *)
if not (Hashtbl.mem accel_paths accel_path) then begin
Hashtbl.add accel_paths accel_path ();
GtkData.AccelMap.add_entry accel_path ?key ~modi
end;
(* Register this accel path *)
GtkBase.Widget.set_accel_path item#as_widget accel_path accel_group;
Gaux.may callback ~f:(fun callback -> item#connect#activate ~callback)
method add_item ?key ?modi ?callback ?submenu label =
let item = GMenu.menu_item ~use_mnemonic:true ~label () in
self#bind ?modi ?key ?callback label item;
Gaux.may (submenu : GMenu.menu option) ~f:item#set_submenu;
item
method add_image_item ?(image : GObj.widget option)
?modi ?key ?callback ?stock ?name label =
let item =
GMenu.image_menu_item ~use_mnemonic:true ?image ~label ?stock () in
match stock with
| None ->
self#bind ?modi ?key ?callback label ?name
(item : GMenu.image_menu_item :> GMenu.menu_item);
item
| Some s ->
try
let st = GtkStock.Item.lookup s in
self#bind
?modi ?key:(if st.GtkStock.keyval=0 then key else None)
?callback label ?name
(item : GMenu.image_menu_item :> GMenu.menu_item);
item
with Not_found -> item
method add_check_item ?active ?modi ?key ?callback label =
let item = GMenu.check_menu_item ~label ~use_mnemonic:true ?active () in
self#bind label ?modi ?key
?callback:(Gaux.may_map callback ~f:(fun f () -> f item#active))
(item : GMenu.check_menu_item :> GMenu.menu_item);
item
method add_separator () = GMenu.separator_item ~packing:menu_shell#append ()
method add_submenu label =
let item = GMenu.menu_item ~use_mnemonic:true ~label () in
self#bind label item;
(GMenu.menu ~packing:item#set_submenu (), item)
method replace_submenu (item : GMenu.menu_item) =
GMenu.menu ~packing:item#set_submenu ()
end
(**********************************************************************
HIGHER-LEVEL WIDGETS
***********************************************************************)
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 redraw () =
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
method activate a = active <- a; if a then self#redraw ()
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
self#redraw ()
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 emitRate2 = ref 0.
let receiveRate2 = ref 0.
let rate2str v =
if v > 9.9e3 then begin
if v > 9.9e6 then
Format.sprintf "%1.0f MiB/s" (v /. 1e6)
else if v > 999e3 then
Format.sprintf "%1.1f MiB/s" (v /. 1e6)
else
Format.sprintf "%1.0f KiB/s" (v /. 1e3)
end else begin
if v > 990. then
Format.sprintf "%1.1f KiB/s" (v /. 1e3)
else if v > 99. then
Format.sprintf "%1.2f KiB/s" (v /. 1e3)
else
" "
end
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"]);
for r = 0 to 2 do
lst#set_row ~selectable:false r
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 receivedBytes = ref 0. in
let receiveRate = ref 0. in
let stopCounter = ref 0 in
let updateTable () =
let kib2str v = Format.sprintf "%.0f B" v 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
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;
if !stopCounter > 0 then decr stopCounter;
if !stopCounter = 0 then begin
emitRate2 := 0.; receiveRate2 := 0.;
end;
updateTable ();
!stopCounter <> 0
in
let startStats () =
if !stopCounter = 0 then begin
emittedBytes := !Remote.emittedBytes;
receivedBytes := !Remote.receivedBytes;
stopCounter := -1;
ignore (GMain.Timeout.add ~ms:(truncate (delay *. 1000.))
~callback:timeout)
end else
stopCounter := -1
in
let stopStats () = stopCounter := 10 in
(t, startStats, stopStats)
(****)
(* Standard file dialog *)
let file_dialog ~parent ~title ~callback ?filename () =
let sel = GWindow.file_selection ~parent ~title ~modal:true ?filename () in
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 ()
(* ------ *)
let fatalError message =
Trace.log (message ^ "\n");
let title = "Fatal error" in
let t =
GWindow.dialog ~parent:(toplevelWindow ())
~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))
~line_wrap:true ~selectable:true ~yalign:0. ~packing:v1#add ());
t#add_button_stock `QUIT `QUIT;
t#set_default_response `QUIT;
t#show(); ignore (t#run ()); t#destroy ();
exit 1
(* ------ *)
let tryAgainOrQuit = fatalError
(* ------ *)
let getFirstRoot () =
let t = GWindow.dialog ~parent:(toplevelWindow ()) ~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 ~parent:t ~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 quitButton = GButton.button ~stock:`QUIT ~packing:f3#add () in
ignore (quitButton#connect#clicked
~callback:(fun () -> result := None; t#destroy()));
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 ();
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 ~parent:(toplevelWindow ()) ~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 ~parent:t ~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 ~parent:t ~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 ~parent:t ~title:"Error" ~typ:`ERROR ~message:"Please enter a port"
else okBox ~parent:t ~title:"Error" ~typ:`ERROR
~message:"The port you specify must be an integer"
| _ ->
okBox ~parent:t ~title:"Error" ~typ:`ERROR
~message:"Something's wrong with the values you entered, try again" in
let f3 = t#action_area in
let quitButton =
GButton.button ~stock:`QUIT ~packing:f3#add () in
ignore (quitButton#connect#clicked ~callback:safeExit);
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);
t#show ();
ignore (t#connect#destroy ~callback:GMain.Main.quit);
GMain.Main.main ();
!result
(* ------ *)
let getPassword rootName msg =
let t =
GWindow.dialog ~parent:(toplevelWindow ())
~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'..." (Unicode.protect rootName)) in
let h1 = GPack.hbox ~border_width:6 ~spacing:12 ~packing:t#vbox#pack () in
ignore (GMisc.image ~stock:`DIALOG_AUTHENTICATION ~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 (Unicode.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));
t#show();
let res = t#run () in
let pwd = passwordE#text in
t#destroy ();
gtk_sync true;
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 "^
System.fspathToPrintString filename ^":\n"
^ "shortcut key "^k^" is already bound to profile "
^ otherProfile))
else
raise (Util.Fatal
("Error scanning profile "^ System.fspathToPrintString filename ^":\n"
^ "Value of 'key' preference must be a single digit (0-9), "
^ "not " ^ k))
with Failure "int_of_string" -> raise (Util.Fatal
("Error scanning profile "^ System.fspathToPrintString filename ^":\n"
^ "Value of 'key' preference must be a single digit (0-9), "
^ "not " ^ k))
(* ------ *)
module React = struct
type 'a t = { mutable state : 'a; mutable observers : ('a -> unit) list }
let make v =
let res = { state = v; observers = [] } in
let update v =
if res.state <> v then begin
res.state <- v; List.iter (fun f -> f v) res.observers
end
in
(res, update)
let const v = fst (make v)
let add_observer x f = x.observers <- f :: x.observers
let state x = x.state
let lift f x =
let (res, update) = make (f (state x)) in
add_observer x (fun v -> update (f v));
res
let lift2 f x y =
let (res, update) = make (f (state x) (state y)) in
add_observer x (fun v -> update (f v (state y)));
add_observer y (fun v -> update (f (state x) v));
res
let lift3 f x y z =
let (res, update) = make (f (state x) (state y) (state z)) in
add_observer x (fun v -> update (f v (state y) (state z)));
add_observer y (fun v -> update (f (state x) v (state z)));
add_observer z (fun v -> update (f (state x) (state y) v));
res
let iter f x = f (state x); add_observer x f
type 'a event = { mutable ev_observers : ('a -> unit) list }
let make_event () =
let res = { ev_observers = [] } in
let trigger v = List.iter (fun f -> f v) res.ev_observers in
(res, trigger)
let add_ev_observer x f = x.ev_observers <- f :: x.ev_observers
let hold v e =
let (res, update) = make v in
add_ev_observer e update;
res
let iter_ev f e = add_ev_observer e f
let lift_ev f e =
let (res, trigger) = make_event () in
add_ev_observer e (fun x -> trigger (f x));
res
module Ops = struct
let (>>) x f = lift f x
let (>|) x f = iter f x
let (>>>) x f = lift_ev f x
let (>>|) x f = iter_ev f x
end
end
module GtkReact = struct
let entry (e : #GEdit.entry) =
let (res, update) = React.make e#text in
ignore (e#connect#changed ~callback:(fun () -> update (e#text)));
res
let text_combo ((c, _) : _ GEdit.text_combo) =
let (res, update) = React.make c#active in
ignore (c#connect#changed ~callback:(fun () -> update (c#active)));
res
let toggle_button (b : #GButton.toggle_button) =
let (res, update) = React.make b#active in
ignore (b#connect#toggled ~callback:(fun () -> update (b#active)));
res
let file_chooser (c : #GFile.chooser) =
let (res, update) = React.make c#filename in
ignore (c#connect#selection_changed
~callback:(fun () -> update (c#filename)));
res
let current_tree_view_selection (t : #GTree.view) =
let m =t#model in
List.map (fun p -> m#get_row_reference p) t#selection#get_selected_rows
let tree_view_selection_changed t =
let (res, trigger) = React.make_event () in
ignore (t#selection#connect#changed
~callback:(fun () -> trigger (current_tree_view_selection t)));
res
let tree_view_selection t =
React.hold (current_tree_view_selection t) (tree_view_selection_changed t)
let label (l : #GMisc.label) x = React.iter (fun v -> l#set_text v) x
let label_underlined (l : #GMisc.label) x =
React.iter (fun v -> l#set_text v; l#set_use_underline true) x
let label_markup (l : #GMisc.label) x =
React.iter (fun v -> l#set_text v; l#set_use_markup true) x
let show w x =
React.iter (fun b -> if b then w#misc#show () else w#misc#hide ()) x
let set_sensitive w x = React.iter (fun b -> w#misc#set_sensitive b) x
end
open React.Ops
(* ------ *)
(* Resize an object (typically, a label with line wrapping) so that it
use all its available space *)
let adjustSize (w : #GObj.widget) =
let notYet = ref true in
ignore
(w#misc#connect#size_allocate ~callback:(fun r ->
if !notYet then begin
notYet := false;
(* JV: I have no idea where the 12 comes from. Without it,
a window resize may happen. *)
w#misc#set_size_request ~width:(max 10 (r.Gtk.width - 12)) ()
end))
let createProfile parent =
let assistant = GAssistant.assistant ~modal:true () in
assistant#set_transient_for parent#as_window;
assistant#set_modal true;
assistant#set_title "Profile Creation";
let nonEmpty s = s <> "" in
(*
let integerRe =
Str.regexp "\\([+-]?[0-9]+\\|0o[0-7]+\\|0x[0-9a-zA-Z]+\\)" in
*)
let integerRe = Str.regexp "[0-9]+" in
let isInteger s =
Str.string_match integerRe s 0 && Str.matched_string s = s in
(* Introduction *)
let intro =
GMisc.label
~xpad:12 ~ypad:12
~text:"Welcome to the Unison Profile Creation Assistant.\n\n\
Click \"Forward\" to begin."
() in
ignore
(assistant#append_page
~title:"Profile Creation"
~page_type:`INTRO
~complete:true
intro#as_widget);
(* Profile name and description *)
let description = GPack.vbox ~border_width:12 ~spacing:6 () in
adjustSize
(GMisc.label ~xalign:0. ~line_wrap:true ~justify:`LEFT
~text:"Please enter the name of the profile and \
possibly a short description."
~packing:(description#pack ~expand:false) ());
let tbl =
let al = GBin.alignment ~packing:(description#pack ~expand:false) () in
al#set_left_padding 12;
GPack.table ~rows:2 ~columns:2 ~col_spacings:12 ~row_spacings:6
~packing:(al#add) () in
let nameEntry =
GEdit.entry ~activates_default:true
~packing:(tbl#attach ~left:1 ~top:0 ~expand:`X) () in
let name = GtkReact.entry nameEntry in
ignore (GMisc.label ~text:"Profile _name:" ~xalign:0.
~use_underline:true ~mnemonic_widget:nameEntry
~packing:(tbl#attach ~left:0 ~top:0 ~expand:`NONE) ());
let labelEntry =
GEdit.entry ~activates_default:true
~packing:(tbl#attach ~left:1 ~top:1 ~expand:`X) () in
let label = GtkReact.entry labelEntry in
ignore (GMisc.label ~text:"_Description:" ~xalign:0.
~use_underline:true ~mnemonic_widget:labelEntry
~packing:(tbl#attach ~left:0 ~top:1 ~expand:`NONE) ());
let existingProfileLabel =
GMisc.label ~xalign:1. ~packing:(description#pack ~expand:false) ()
in
adjustSize existingProfileLabel;
GtkReact.label_markup existingProfileLabel
(name >> fun s -> Format.sprintf " Profile %s already exists."
(escapeMarkup s));
let profileExists =
name >> fun s -> s <> "" && System.file_exists (Prefs.profilePathname s)
in
GtkReact.show existingProfileLabel profileExists;
ignore
(assistant#append_page
~title:"Profile Description"
~page_type:`CONTENT
description#as_widget);
let setPageComplete page b = assistant#set_page_complete page#as_widget b in
React.lift2 (&&) (name >> nonEmpty) (profileExists >> not)
>| setPageComplete description;
let connection = GPack.vbox ~border_width:12 ~spacing:18 () in
let al = GBin.alignment ~packing:(connection#pack ~expand:false) () in
al#set_left_padding 12;
let vb =
GPack.vbox ~spacing:6 ~packing:(al#add) () in
adjustSize
(GMisc.label ~xalign:0. ~line_wrap:true ~justify:`LEFT
~text:"You can use Unison to synchronize a local directory \
with another local directory, or with a remote directory."
~packing:(vb#pack ~expand:false) ());
adjustSize
(GMisc.label ~xalign:0. ~line_wrap:true ~justify:`LEFT
~text:"Please select the kind of synchronization \
you want to perform."
~packing:(vb#pack ~expand:false) ());
let tbl =
let al = GBin.alignment ~packing:(vb#pack ~expand:false) () in
al#set_left_padding 12;
GPack.table ~rows:2 ~columns:2 ~col_spacings:12 ~row_spacings:6
~packing:(al#add) () in
ignore (GMisc.label ~text:"Description:" ~xalign:0. ~yalign:0.
~packing:(tbl#attach ~left:0 ~top:1 ~expand:`NONE) ());
let kindCombo =
let al =
GBin.alignment ~xscale:0. ~xalign:0.
~packing:(tbl#attach ~left:1 ~top:0) () in
GEdit.combo_box_text
~strings:["Local"; "Using SSH"; "Using RSH";
"Through a plain TCP connection"]
~active:0 ~packing:(al#add) ()
in
ignore (GMisc.label ~text:"Synchronization _kind:" ~xalign:0.
~use_underline:true ~mnemonic_widget:(fst kindCombo)
~packing:(tbl#attach ~left:0 ~top:0 ~expand:`NONE) ());
let kind =
GtkReact.text_combo kindCombo
>> fun i -> List.nth [`Local; `SSH; `RSH; `SOCKET] i
in
let isLocal = kind >> fun k -> k = `Local in
let isSSH = kind >> fun k -> k = `SSH in
let isSocket = kind >> fun k -> k = `SOCKET in
let descrLabel =
GMisc.label ~xalign:0. ~line_wrap:true
~packing:(tbl#attach ~left:1 ~top:1 ~expand:`X) ()
in
adjustSize descrLabel;
GtkReact.label descrLabel
(kind >> fun k ->
match k with
`Local ->
"Local synchronization."
| `SSH ->
"This is the recommended way to synchronize \
with a remote machine. A\xc2\xa0remote instance of Unison is \
automatically started via SSH."
| `RSH ->
"Synchronization with a remote machine by starting \
automatically a remote instance of Unison via RSH."
| `SOCKET ->
"Synchronization with a remote machine by connecting \
to an instance of Unison already listening \
on a specific TCP port.");
let vb = GPack.vbox ~spacing:6 ~packing:(connection#add) () in
GtkReact.show vb (isLocal >> not);
ignore (GMisc.label ~markup:"Configuration" ~xalign:0.
~packing:(vb#pack ~expand:false) ());
let al = GBin.alignment ~packing:(vb#add) () in
al#set_left_padding 12;
let vb = GPack.vbox ~spacing:6 ~packing:(al#add) () in
let requirementLabel =
GMisc.label ~xalign:0. ~line_wrap:true
~packing:(vb#pack ~expand:false) ()
in
adjustSize requirementLabel;
GtkReact.label requirementLabel
(kind >> fun k ->
match k with
`Local ->
""
| `SSH ->
"There must be an SSH client installed on this machine, \
and Unison and an SSH server installed on the remote machine."
| `RSH ->
"There must be an RSH client installed on this machine, \
and Unison and an RSH server installed on the remote machine."
| `SOCKET ->
"There must be a Unison server running on the remote machine, \
listening on the port that you specify here. \
(Use \"Unison -socket xxx\" on the remote machine to start \
the Unison server.)");
let connDescLabel =
GMisc.label ~xalign:0. ~line_wrap:true
~packing:(vb#pack ~expand:false) ()
in
adjustSize connDescLabel;
GtkReact.label connDescLabel
(kind >> fun k ->
match k with
`Local -> ""
| `SSH -> "Please enter the host to connect to and a user name, \
if different from your user name on this machine."
| `RSH -> "Please enter the host to connect to and a user name, \
if different from your user name on this machine."
| `SOCKET -> "Please enter the host and port to connect to.");
let tbl =
let al = GBin.alignment ~packing:(vb#pack ~expand:false) () in
al#set_left_padding 12;
GPack.table ~rows:2 ~columns:2 ~col_spacings:12 ~row_spacings:6
~packing:(al#add) () in
let hostEntry =
GEdit.entry ~packing:(tbl#attach ~left:1 ~top:0 ~expand:`X) () in
let host = GtkReact.entry hostEntry in
ignore (GMisc.label ~text:"_Host:" ~xalign:0.
~use_underline:true ~mnemonic_widget:hostEntry
~packing:(tbl#attach ~left:0 ~top:0 ~expand:`NONE) ());
let userEntry =
GEdit.entry ~packing:(tbl#attach ~left:1 ~top:1 ~expand:`X) ()
in
GtkReact.show userEntry (isSocket >> not);
let user = GtkReact.entry userEntry in
GtkReact.show
(GMisc.label ~text:"_User:" ~xalign:0. ~yalign:0.
~use_underline:true ~mnemonic_widget:userEntry
~packing:(tbl#attach ~left:0 ~top:1 ~expand:`NONE) ())
(isSocket >> not);
let portEntry =
GEdit.entry ~packing:(tbl#attach ~left:1 ~top:1 ~expand:`X) ()
in
GtkReact.show portEntry isSocket;
let port = GtkReact.entry portEntry in
GtkReact.show
(GMisc.label ~text:"_Port:" ~xalign:0. ~yalign:0.
~use_underline:true ~mnemonic_widget:portEntry
~packing:(tbl#attach ~left:0 ~top:1 ~expand:`NONE) ())
isSocket;
let compressLabel =
GMisc.label ~xalign:0. ~line_wrap:true
~text:"Data compression can greatly improve performance \
on slow connections. However, it may slow down \
things on (fast) local networks."
~packing:(vb#pack ~expand:false) ()
in
adjustSize compressLabel;
GtkReact.show compressLabel isSSH;
let compressButton =
let al = GBin.alignment ~packing:(vb#pack ~expand:false) () in
al#set_left_padding 12;
(GButton.check_button ~label:"Enable _compression" ~use_mnemonic:true
~active:true ~packing:(al#add) ())
in
GtkReact.show compressButton isSSH;
let compress = GtkReact.toggle_button compressButton in
(*XXX Disabled for now... *)
(*
adjustSize
(GMisc.label ~xalign:0. ~line_wrap:true
~text:"If this is possible, it is recommended that Unison \
attempts to connect immediately to the remote machine, \
so that it can perform some auto-detections."
~packing:(vb#pack ~expand:false) ());
let connectImmediately =
let al = GBin.alignment ~packing:(vb#pack ~expand:false) () in
al#set_left_padding 12;
GtkReact.toggle_button
(GButton.check_button ~label:"Connect _immediately" ~use_mnemonic:true
~active:true ~packing:(al#add) ())
in
let connectImmediately =
React.lift2 (&&) connectImmediately (isLocal >> not) in
*)
let pageComplete =
React.lift2 (||) isLocal
(React.lift2 (&&) (host >> nonEmpty)
(React.lift2 (||) (isSocket >> not) (port >> isInteger)))
in
ignore
(assistant#append_page
~title:"Connection Setup"
~page_type:`CONTENT
connection#as_widget);
pageComplete >| setPageComplete connection;
(* Connection to server *)
(*XXX Disabled for now... Fill in this page
let connectionInProgress = GMisc.label ~text:"..." () in
let p =
assistant#append_page
~title:"Connecting to Server..."
~page_type:`PROGRESS
connectionInProgress#as_widget
in
ignore
(assistant#connect#prepare (fun () ->
if assistant#current_page = p then begin
if React.state connectImmediately then begin
(* XXXX start connection... *)
assistant#set_page_complete connectionInProgress#as_widget true
end else
assistant#set_current_page (p + 1)
end));
*)
(* Directory selection *)
let directorySelection = GPack.vbox ~border_width:12 ~spacing:6 () in
adjustSize
(GMisc.label ~xalign:0. ~line_wrap:true ~justify:`LEFT
~text:"Please select the two directories that you want to synchronize."
~packing:(directorySelection#pack ~expand:false) ());
let secondDirLabel1 =
GMisc.label ~xalign:0. ~line_wrap:true ~justify:`LEFT
~text:"The second directory is relative to your home \
directory on the remote machine."
~packing:(directorySelection#pack ~expand:false) ()
in
adjustSize secondDirLabel1;
GtkReact.show secondDirLabel1 ((React.lift2 (||) isLocal isSocket) >> not);
let secondDirLabel2 =
GMisc.label ~xalign:0. ~line_wrap:true ~justify:`LEFT
~text:"The second directory is relative to \
the working directory of the Unison server \
running on the remote machine."
~packing:(directorySelection#pack ~expand:false) ()
in
adjustSize secondDirLabel2;
GtkReact.show secondDirLabel2 isSocket;
let tbl =
let al =
GBin.alignment ~packing:(directorySelection#pack ~expand:false) () in
al#set_left_padding 12;
GPack.table ~rows:2 ~columns:2 ~col_spacings:12 ~row_spacings:6
~packing:(al#add) () in
(*XXX Should focus on this button when becomes visible... *)
let firstDirButton =
GFile.chooser_button ~action:`SELECT_FOLDER ~title:"First Directory"
~packing:(tbl#attach ~left:1 ~top:0 ~expand:`X) ()
in
isLocal >| (fun b -> firstDirButton#set_title
(if b then "First Directory" else "Local Directory"));
GtkReact.label_underlined
(GMisc.label ~xalign:0.
~mnemonic_widget:firstDirButton
~packing:(tbl#attach ~left:0 ~top:0 ~expand:`NONE) ())
(isLocal >> fun b ->
if b then "_First directory:" else "_Local directory:");
let noneToEmpty o = match o with None -> "" | Some s -> s in
let firstDir = GtkReact.file_chooser firstDirButton >> noneToEmpty in
let secondDirButton =
GFile.chooser_button ~action:`SELECT_FOLDER ~title:"Second Directory"
~packing:(tbl#attach ~left:1 ~top:1 ~expand:`X) () in
let secondDirLabel =
GMisc.label ~xalign:0.
~text:"Se_cond directory:"
~use_underline:true ~mnemonic_widget:secondDirButton
~packing:(tbl#attach ~left:0 ~top:1 ~expand:`NONE) () in
GtkReact.show secondDirButton isLocal;
GtkReact.show secondDirLabel isLocal;
let remoteDirEdit =
GEdit.entry ~packing:(tbl#attach ~left:1 ~top:1 ~expand:`X) ()
in
let remoteDirLabel =
GMisc.label ~xalign:0.
~text:"_Remote directory:"
~use_underline:true ~mnemonic_widget:remoteDirEdit
~packing:(tbl#attach ~left:0 ~top:1 ~expand:`NONE) ()
in
GtkReact.show remoteDirEdit (isLocal >> not);
GtkReact.show remoteDirLabel (isLocal >> not);
let secondDir =
React.lift3 (fun b l r -> if b then l else r) isLocal
(GtkReact.file_chooser secondDirButton >> noneToEmpty)
(GtkReact.entry remoteDirEdit)
in
ignore
(assistant#append_page
~title:"Directory Selection"
~page_type:`CONTENT
directorySelection#as_widget);
React.lift2 (||) (isLocal >> not) (React.lift2 (<>) firstDir secondDir)
>| setPageComplete directorySelection;
(* Specific options *)
let options = GPack.vbox ~border_width:18 ~spacing:12 () in
(* Do we need to set specific options for FAT partitions?
If under Windows, then all the options are set properly, except for
ignoreinodenumbers in case one replica is on a FAT partition on a
remote non-Windows machine. As this is unlikely, we do not
handle this case. *)
let fat =
if Util.osType = `Win32 then
React.const false
else begin
let vb =
GPack.vbox ~spacing:6 ~packing:(options#pack ~expand:false) () in
let fatLabel =
GMisc.label ~xalign:0. ~line_wrap:true ~justify:`LEFT
~text:"Select the following option if one of your \
directory is on a FAT partition. This is typically \
the case for a USB stick."
~packing:(vb#pack ~expand:false) ()
in
adjustSize fatLabel;
let fatButton =
let al = GBin.alignment ~packing:(vb#pack ~expand:false) () in
al#set_left_padding 12;
(GButton.check_button
~label:"Synchronization involving a _FAT partition"
~use_mnemonic:true ~active:false ~packing:(al#add) ())
in
GtkReact.toggle_button fatButton
end
in
(* Fastcheck is safe except on FAT partitions and on Windows when
not in Unicode mode where there is a very slight chance of
missing an update when a file is moved onto another with the same
modification time. Nowadays, FAT is rarely used on working
partitions. In most cases, we should be in Unicode mode.
Thus, it seems sensible to always enable fastcheck. *)
(*
let fastcheck = isLocal >> not >> (fun b -> b || Util.osType = `Win32) in
*)
(* Unicode mode can be problematic when the source machine is under
Windows and the remote machine is not, as Unison may have already
been used using the legacy Latin 1 encoding. Cygwin also did not
handle Unicode before version 1.7. *)
let vb = GPack.vbox ~spacing:6 ~packing:(options#pack ~expand:false) () in
let askUnicode = React.const false in
(* isLocal >> not >> fun b -> (b || Util.isCygwin) && Util.osType = `Win32 in*)
GtkReact.show vb askUnicode;
adjustSize
(GMisc.label ~xalign:0. ~line_wrap:true ~justify:`LEFT
~text:"When synchronizing in case insensitive mode, \
Unison has to make some assumptions regarding \
filename encoding. If ensure, use Unicode."
~packing:(vb#pack ~expand:false) ());
let vb =
let al = GBin.alignment
~xscale:0. ~xalign:0. ~packing:(vb#pack ~expand:false) () in
al#set_left_padding 12;
GPack.vbox ~spacing:0 ~packing:(al#add) ()
in
ignore
(GMisc.label ~xalign:0. ~text:"Filename encoding:"
~packing:(vb#pack ~expand:false) ());
let hb =
let al = GBin.alignment
~xscale:0. ~xalign:0. ~packing:(vb#pack ~expand:false) () in
al#set_left_padding 12;
GPack.button_box `VERTICAL ~layout:`START
~spacing:0 ~packing:(al#add) ()
in
let unicodeButton =
GButton.radio_button ~label:"_Unicode" ~use_mnemonic:true ~active:true
~packing:(hb#add) ()
in
ignore
(GButton.radio_button ~label:"_Latin 1" ~use_mnemonic:true
~group:unicodeButton#group ~packing:(hb#add) ());
(*
let unicode =
React.lift2 (||) (askUnicode >> not) (GtkReact.toggle_button unicodeButton)
in
*)
let p =
assistant#append_page
~title:"Specific Options" ~complete:true
~page_type:`CONTENT
options#as_widget
in
ignore
(assistant#connect#prepare (fun () ->
if assistant#current_page = p &&
not (Util.osType <> `Win32 || React.state askUnicode)
then
assistant#set_current_page (p + 1)));
let conclusion =
GMisc.label
~xpad:12 ~ypad:12
~text:"You have now finished filling in the profile.\n\n\
Click \"Apply\" to create it."
() in
ignore
(assistant#append_page
~title:"Done" ~complete:true
~page_type:`CONFIRM
conclusion#as_widget);
let profileName = ref None in
let saveProfile () =
let filename = Prefs.profilePathname (React.state name) in
begin try
let ch =
System.open_out_gen [Open_wronly; Open_creat; Open_excl] 0o600 filename
in
Printf.fprintf ch "# Unison preferences\n";
let label = React.state label in
if label <> "" then Printf.fprintf ch "label = %s\n" label;
Printf.fprintf ch "root = %s\n" (React.state firstDir);
let secondDir = React.state secondDir in
let host = React.state host in
let user = match React.state user with "" -> None | u -> Some u in
let secondRoot =
match React.state kind with
`Local -> Clroot.ConnectLocal (Some secondDir)
| `SSH -> Clroot.ConnectByShell
("ssh", host, user, None, Some secondDir)
| `RSH -> Clroot.ConnectByShell
("rsh", host, user, None, Some secondDir)
| `SOCKET -> Clroot.ConnectBySocket
(host, React.state port, Some secondDir)
in
Printf.fprintf ch "root = %s\n" (Clroot.clroot2string secondRoot);
if React.state compress && React.state kind = `SSH then
Printf.fprintf ch "sshargs = -C\n";
(*
if React.state fastcheck then
Printf.fprintf ch "fastcheck = true\n";
if React.state unicode then
Printf.fprintf ch "unicode = true\n";
*)
if React.state fat then Printf.fprintf ch "fat = true\n";
close_out ch;
profileName := Some (React.state name)
with Sys_error _ as e ->
okBox ~parent:assistant ~typ:`ERROR ~title:"Could not save profile"
~message:(Uicommon.exn2string e)
end;
assistant#destroy ();
in
ignore (assistant#connect#close ~callback:saveProfile);
ignore (assistant#connect#destroy ~callback:GMain.Main.quit);
ignore (assistant#connect#cancel ~callback:assistant#destroy);
assistant#show ();
GMain.Main.main ();
!profileName
(* ------ *)
let nameOfType t =
match t with
`BOOL -> "boolean"
| `BOOLDEF -> "boolean"
| `INT -> "integer"
| `STRING -> "text"
| `STRING_LIST -> "text list"
| `CUSTOM -> "custom"
| `UNKNOWN -> "unknown"
let defaultValue t =
match t with
`BOOL -> ["true"]
| `BOOLDEF -> ["true"]
| `INT -> ["0"]
| `STRING -> [""]
| `STRING_LIST -> []
| `CUSTOM -> []
| `UNKNOWN -> []
let editPreference parent nm ty vl =
let t =
GWindow.dialog ~parent ~border_width:12
~no_separator:true ~title:"Edit the Preference"
~modal:true () in
let vb = t#vbox in
vb#set_spacing 6;
let isList =
match ty with
`STRING_LIST | `CUSTOM | `UNKNOWN -> true
| _ -> false
in
let columns = if isList then 5 else 4 in
let rows = if isList then 3 else 2 in
let tbl =
GPack.table ~rows ~columns ~col_spacings:12 ~row_spacings:6
~packing:(vb#pack ~expand:false) () in
ignore (GMisc.label ~text:"Preference:" ~xalign:0.
~packing:(tbl#attach ~left:0 ~top:0 ~expand:`NONE) ());
ignore (GMisc.label ~text:"Description:" ~xalign:0.
~packing:(tbl#attach ~left:0 ~top:1 ~expand:`NONE) ());
ignore (GMisc.label ~text:"Type:" ~xalign:0.
~packing:(tbl#attach ~left:0 ~top:2 ~expand:`NONE) ());
ignore (GMisc.label ~text:(Unicode.protect nm) ~xalign:0. ~selectable:true ()
~packing:(tbl#attach ~left:1 ~top:0 ~expand:`X));
let (doc, _, _) = Prefs.documentation nm in
ignore (GMisc.label ~text:doc ~xalign:0. ~selectable:true ()
~packing:(tbl#attach ~left:1 ~top:1 ~expand:`X));
ignore (GMisc.label ~text:(nameOfType ty) ~xalign:0. ~selectable:true ()
~packing:(tbl#attach ~left:1 ~top:2 ~expand:`X));
let newValue =
if isList then begin
let valueLabel =
GMisc.label ~text:"V_alue:" ~use_underline:true ~xalign:0. ~yalign:0.
~packing:(tbl#attach ~left:0 ~top:3 ~expand:`NONE) ()
in
let cols = new GTree.column_list in
let c_value = cols#add Gobject.Data.string in
let c_ml = cols#add Gobject.Data.caml in
let lst_store = GTree.list_store cols in
let lst =
let sw =
GBin.scrolled_window ~packing:(tbl#attach ~left:1 ~top:3 ~expand:`X)
~shadow_type:`IN ~height:200 ~width:400
~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in
GTree.view ~model:lst_store ~headers_visible:false
~reorderable:true ~packing:sw#add () in
valueLabel#set_mnemonic_widget (Some (lst :> GObj.widget));
let column =
GTree.view_column
~renderer:(GTree.cell_renderer_text [], ["text", c_value]) ()
in
ignore (lst#append_column column);
let vb =
GPack.button_box
`VERTICAL ~layout:`START ~spacing:6
~packing:(tbl#attach ~left:2 ~top:3 ~expand:`NONE) ()
in
let selection = GtkReact.tree_view_selection lst in
let hasSel = selection >> fun l -> l <> [] in
let addB =
GButton.button ~stock:`ADD ~packing:(vb#pack ~expand:false) () in
let removeB =
GButton.button ~stock:`REMOVE ~packing:(vb#pack ~expand:false) () in
let editB =
GButton.button ~stock:`EDIT ~packing:(vb#pack ~expand:false) () in
let upB =
GButton.button ~stock:`GO_UP ~packing:(vb#pack ~expand:false) () in
let downB =
GButton.button ~stock:`GO_DOWN ~packing:(vb#pack ~expand:false) () in
List.iter (fun b -> b#set_xalign 0.) [addB; removeB; editB; upB; downB];
GtkReact.set_sensitive removeB hasSel;
let editLabel =
GMisc.label ~text:"Edited _item:"
~use_underline:true ~xalign:0.
~packing:(tbl#attach ~left:0 ~top:4 ~expand:`NONE) ()
in
let editEntry =
GEdit.entry ~packing:(tbl#attach ~left:1 ~top:4 ~expand:`X) () in
editLabel#set_mnemonic_widget (Some (editEntry :> GObj.widget));
let edit = GtkReact.entry editEntry in
let edited =
React.lift2
(fun l txt ->
match l with
[rf] -> lst_store#get ~row:rf#iter ~column:c_ml <> txt
| _ -> false)
selection edit
in
GtkReact.set_sensitive editB edited;
let selectionChange = GtkReact.tree_view_selection_changed lst in
selectionChange >>| (fun s ->
match s with
[rf] -> editEntry#set_text
(lst_store#get ~row:rf#iter ~column:c_value)
| _ -> ());
let add () =
let txt = editEntry#text in
let row = lst_store#append () in
lst_store#set ~row ~column:c_value txt;
lst_store#set ~row ~column:c_ml txt;
lst#selection#select_iter row;
lst#scroll_to_cell (lst_store#get_path row) column
in
ignore (addB#connect#clicked ~callback:add);
ignore (editEntry#connect#activate ~callback:add);
let remove () =
match React.state selection with
[rf] -> let i = rf#iter in
if lst_store#iter_next i then
lst#selection#select_iter i
else begin
let p = rf#path in
if GTree.Path.prev p then
lst#selection#select_path p
end;
ignore (lst_store#remove rf#iter)
| _ -> ()
in
ignore (removeB#connect#clicked ~callback:remove);
let edit () =
match React.state selection with
[rf] -> let row = rf#iter in
let txt = editEntry#text in
lst_store#set ~row ~column:c_value txt;
lst_store#set ~row ~column:c_ml txt
| _ -> ()
in
ignore (editB#connect#clicked ~callback:edit);
let updateUpDown l =
let (upS, downS) =
match l with
[rf] -> (GTree.Path.prev rf#path, lst_store#iter_next rf#iter)
| _ -> (false, false)
in
upB#misc#set_sensitive upS;
downB#misc#set_sensitive downS
in
selectionChange >>| updateUpDown;
ignore (lst_store#connect#after#row_deleted
~callback:(fun _ -> updateUpDown (React.state selection)));
let go_up () =
match React.state selection with
[rf] -> let p = rf#path in
if GTree.Path.prev p then begin
let i = rf#iter in
let i' = lst_store#get_iter p in
ignore (lst_store#swap i i');
lst#scroll_to_cell (lst_store#get_path i) column
end;
updateUpDown (React.state selection)
| _ -> ()
in
ignore (upB#connect#clicked ~callback:go_up);
let go_down () =
match React.state selection with
[rf] -> let i = rf#iter in
if lst_store#iter_next i then begin
let i' = rf#iter in
ignore (lst_store#swap i i');
lst#scroll_to_cell (lst_store#get_path i') column
end;
updateUpDown (React.state selection)
| _ -> ()
in
ignore (downB#connect#clicked ~callback:go_down);
List.iter
(fun v ->
let row = lst_store#append () in
lst_store#set ~row ~column:c_value (Unicode.protect v);
lst_store#set ~row ~column:c_ml v)
vl;
(fun () ->
let l = ref [] in
lst_store#foreach
(fun _ row -> l := lst_store#get ~row ~column:c_ml :: !l; false);
List.rev !l)
end else begin
let v = List.hd vl in
begin match ty with
`BOOL | `BOOLDEF ->
let hb =
GPack.button_box `HORIZONTAL ~layout:`START
~packing:(tbl#attach ~left:1 ~top:3 ~expand:`X) ()
in
let isTrue = v = "true" || v = "yes" in
let trueB =
GButton.radio_button ~label:"_True" ~use_mnemonic:true
~active:isTrue ~packing:(hb#add) ()
in
ignore
(GButton.radio_button ~label:"_False" ~use_mnemonic:true
~group:trueB#group ~active:(not isTrue) ~packing:(hb#add) ());
ignore
(GMisc.label ~text:"Value:" ~xalign:0.
~packing:(tbl#attach ~left:0 ~top:3 ~expand:`NONE) ());
(fun () -> [if trueB#active then "true" else "false"])
| `INT | `STRING ->
let valueEntry =
GEdit.entry ~text:(List.hd vl) ~width_chars: 40
~activates_default:true
~packing:(tbl#attach ~left:1 ~top:3 ~expand:`X) ()
in
ignore
(GMisc.label ~text:"V_alue:" ~use_underline:true ~xalign:0.
~mnemonic_widget:valueEntry
~packing:(tbl#attach ~left:0 ~top:3 ~expand:`NONE) ());
(fun () -> [valueEntry#text])
| `STRING_LIST | `CUSTOM | `UNKNOWN ->
assert false
end
end
in
let ok = ref false in
let cancelCommand () = t#destroy () in
let cancelButton =
GButton.button ~stock:`CANCEL ~packing:t#action_area#add () in
ignore (cancelButton#connect#clicked ~callback:cancelCommand);
let okCommand _ = ok := true; t#destroy () in
let okButton =
GButton.button ~stock:`OK ~packing:t#action_area#add () in
ignore (okButton#connect#clicked ~callback:okCommand);
okButton#grab_default ();
ignore (t#connect#destroy ~callback:GMain.Main.quit);
t#show ();
GMain.Main.main ();
if !ok then Some (newValue ()) else None
let markupRe = Str.regexp "<\\([a-z]+\\)>\\|\\([a-z]+\\)>\\|&\\([a-z]+\\);"
let entities =
[("amp", "&"); ("lt", "<"); ("gt", ">"); ("quot", "\""); ("apos", "'")]
let rec insertMarkupRec tags (t : #GText.view) s i tl =
try
let j = Str.search_forward markupRe s i in
if j > i then
t#buffer#insert ~tags:(List.flatten tl) (String.sub s i (j - i));
let tag = try Some (Str.matched_group 1 s) with Not_found -> None in
match tag with
Some tag ->
insertMarkupRec tags t s (Str.group_end 0)
((try [List.assoc tag tags] with Not_found -> []) :: tl)
| None ->
let entity = try Some (Str.matched_group 3 s) with Not_found -> None in
match entity with
None ->
insertMarkupRec tags t s (Str.group_end 0) (List.tl tl)
| Some ent ->
begin try
t#buffer#insert ~tags:(List.flatten tl) (List.assoc ent entities)
with Not_found -> () end;
insertMarkupRec tags t s (Str.group_end 0) tl
with Not_found ->
let j = String.length s in
if j > i then
t#buffer#insert ~tags:(List.flatten tl) (String.sub s i (j - i))
let insertMarkup tags t s =
t#buffer#set_text ""; insertMarkupRec tags t s 0 []
let documentPreference ~compact ~packing =
let vb = GPack.vbox ~spacing:6 ~packing () in
ignore (GMisc.label ~markup:"Documentation" ~xalign:0.
~packing:(vb#pack ~expand:false) ());
let al = GBin.alignment ~packing:(vb#pack ~expand:true ~fill:true) () in
al#set_left_padding 12;
let columns = if compact then 3 else 2 in
let tbl =
GPack.table ~rows:2 ~columns ~col_spacings:12 ~row_spacings:6
~packing:(al#add) () in
tbl#misc#set_sensitive false;
ignore (GMisc.label ~text:"Short description:" ~xalign:0.
~packing:(tbl#attach ~left:0 ~top:0 ~expand:`NONE) ());
ignore (GMisc.label ~text:"Long description:" ~xalign:0. ~yalign:0.
~packing:(tbl#attach ~left:0 ~top:1 ~expand:`NONE) ());
let shortDescr =
GMisc.label ~packing:(tbl#attach ~left:1 ~top:0 ~expand:`X)
~xalign:0. ~selectable:true () in
let longDescr =
let sw =
if compact then
GBin.scrolled_window ~height:128 ~width:640
~packing:(tbl#attach ~left:0 ~top:2 ~right:2 ~expand:`BOTH)
~shadow_type:`IN ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC ()
else
GBin.scrolled_window ~height:128 ~width:640
~packing:(tbl#attach ~left:1 ~top:1 ~expand:`BOTH)
~shadow_type:`IN ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC ()
in
GText.view ~editable:false ~packing:sw#add ~wrap_mode:`WORD ()
in
let (>>>) x f = f x in
let newlineRe = Str.regexp "\n *" in
let styleRe = Str.regexp "{\\\\\\([a-z]+\\) \\([^{}]*\\)}" in
let verbRe = Str.regexp "\\\\verb|\\([^|]*\\)|" in
let argRe = Str.regexp "\\\\ARG{\\([^{}]*\\)}" in
let textttRe = Str.regexp "\\\\texttt{\\([^{}]*\\)}" in
let emphRe = Str.regexp "\\\\emph{\\([^{}]*\\)}" in
let sectionRe = Str.regexp "\\\\sectionref{\\([^{}]*\\)}{\\([^{}]*\\)}" in
let emdash = Str.regexp_string "---" in
let parRe = Str.regexp "\\\\par *" in
let underRe = Str.regexp "\\\\_ *" in
let dollarRe = Str.regexp "\\\\\\$ *" in
let formatDoc doc =
doc >>>
Str.global_replace newlineRe " " >>>
escapeMarkup >>>
Str.global_substitute styleRe
(fun s ->
try
let tag =
match Str.matched_group 1 s with
"em" -> "i"
| "tt" -> "tt"
| _ -> raise Exit
in
Format.sprintf "<%s>%s%s>" tag (Str.matched_group 2 s) tag
with Exit ->
Str.matched_group 0 s) >>>
Str.global_replace verbRe "\\1" >>>
Str.global_replace argRe "\\1" >>>
Str.global_replace textttRe "\\1" >>>
Str.global_replace emphRe "\\1" >>>
Str.global_replace sectionRe "Section '\\2'" >>>
Str.global_replace emdash "\xe2\x80\x94" >>>
Str.global_replace parRe "\n" >>>
Str.global_replace underRe "_" >>>
Str.global_replace dollarRe "_"
in
let tags =
let create = longDescr#buffer#create_tag in
[("i", create [`FONT_DESC (Lazy.force fontItalic)]);
("tt", create [`FONT_DESC (Lazy.force fontMonospace)])]
in
fun nm ->
let (short, long, _) =
match nm with
Some nm ->
tbl#misc#set_sensitive true;
Prefs.documentation nm
| _ ->
tbl#misc#set_sensitive false;
("", "", false)
in
shortDescr#set_text (String.capitalize short);
insertMarkup tags longDescr (formatDoc long)
(* longDescr#buffer#set_text (formatDoc long)*)
let addPreference parent =
let t =
GWindow.dialog ~parent ~border_width:12
~no_separator:true ~title:"Add a Preference"
~modal:true () in
let vb = t#vbox in
(* vb#set_spacing 18;*)
let paned = GPack.paned `VERTICAL ~packing:vb#add () in
let lvb = GPack.vbox ~spacing:6 ~packing:paned#pack1 () in
let preferenceLabel =
GMisc.label
~text:"_Preferences:" ~use_underline:true
~xalign:0. ~packing:(lvb#pack ~expand:false) ()
in
let cols = new GTree.column_list in
let c_name = cols#add Gobject.Data.string in
let basic_store = GTree.list_store cols in
let full_store = GTree.list_store cols in
let lst =
let sw =
GBin.scrolled_window ~packing:(lvb#pack ~expand:true)
~shadow_type:`IN ~height:200 ~width:400
~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in
GTree.view ~headers_visible:false ~packing:sw#add () in
preferenceLabel#set_mnemonic_widget (Some (lst :> GObj.widget));
ignore (lst#append_column
(GTree.view_column
~renderer:(GTree.cell_renderer_text [], ["text", c_name]) ()));
let hiddenPrefs =
["auto"; "doc"; "silent"; "terse"; "testserver"; "version"] in
let shownPrefs =
["label"; "key"] in
let insert (store : #GTree.list_store) all =
List.iter
(fun nm ->
if
all || List.mem nm shownPrefs ||
(let (_, _, basic) = Prefs.documentation nm in basic &&
not (List.mem nm hiddenPrefs))
then begin
let row = store#append () in
store#set ~row ~column:c_name nm
end)
(Prefs.list ())
in
insert basic_store false;
insert full_store true;
let showAll =
GtkReact.toggle_button
(GButton.check_button ~label:"_Show all preferences"
~use_mnemonic:true ~active:false ~packing:(lvb#pack ~expand:false) ())
in
showAll >|
(fun b ->
lst#set_model
(Some (if b then full_store else basic_store :> GTree.model)));
let selection = GtkReact.tree_view_selection lst in
let updateDoc = documentPreference ~compact:true ~packing:paned#pack2 in
selection >|
(fun l ->
let nm =
match l with
[rf] ->
let row = rf#iter in
let store =
if React.state showAll then full_store else basic_store in
Some (store#get ~row ~column:c_name)
| _ ->
None
in
updateDoc nm);
let cancelCommand () = t#destroy () 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:(fun _ -> cancelCommand (); true));
let ok = ref false in
let addCommand _ = ok := true; t#destroy () in
let addButton =
GButton.button ~stock:`ADD ~packing:t#action_area#add () in
ignore (addButton#connect#clicked ~callback:addCommand);
GtkReact.set_sensitive addButton (selection >> fun l -> l <> []);
ignore (lst#connect#row_activated ~callback:(fun _ _ -> addCommand ()));
addButton#grab_default ();
ignore (t#connect#destroy ~callback:GMain.Main.quit);
t#show ();
GMain.Main.main ();
if not !ok then None else
match React.state selection with
[rf] ->
let row = rf#iter in
let store =
if React.state showAll then full_store else basic_store in
Some (store#get ~row ~column:c_name)
| _ ->
None
let editProfile parent name =
let t =
GWindow.dialog ~parent ~border_width:12
~no_separator:true ~title:(Format.sprintf "%s - Profile Editor" name)
~modal:true () in
let vb = t#vbox in
(* t#vbox#set_spacing 18;*)
let paned = GPack.paned `VERTICAL ~packing:vb#add () in
let lvb = GPack.vbox ~spacing:6 ~packing:paned#pack1 () in
let preferenceLabel =
GMisc.label
~text:"_Preferences:" ~use_underline:true
~xalign:0. ~packing:(lvb#pack ~expand:false) ()
in
let hb = GPack.hbox ~spacing:12 ~packing:(lvb#add) () in
let cols = new GTree.column_list in
let c_name = cols#add Gobject.Data.string in
let c_type = cols#add Gobject.Data.string in
let c_value = cols#add Gobject.Data.string in
let c_ml = cols#add Gobject.Data.caml in
let lst_store = GTree.list_store cols in
let lst_sorted_store = GTree.model_sort lst_store in
lst_sorted_store#set_sort_column_id 0 `ASCENDING;
let lst =
let sw =
GBin.scrolled_window ~packing:(hb#pack ~expand:true)
~shadow_type:`IN ~height:300 ~width:600
~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in
GTree.view ~model:lst_sorted_store ~packing:sw#add
~headers_clickable:true () in
preferenceLabel#set_mnemonic_widget (Some (lst :> GObj.widget));
let vc_name =
GTree.view_column
~title:"Name"
~renderer:(GTree.cell_renderer_text [], ["text", c_name]) () in
vc_name#set_sort_column_id 0;
ignore (lst#append_column vc_name);
ignore (lst#append_column
(GTree.view_column
~title:"Type"
~renderer:(GTree.cell_renderer_text [], ["text", c_type]) ()));
ignore (lst#append_column
(GTree.view_column
~title:"Value"
~renderer:(GTree.cell_renderer_text [], ["text", c_value]) ()));
let vb =
GPack.button_box
`VERTICAL ~layout:`START ~spacing:6 ~packing:(hb#pack ~expand:false) ()
in
let selection = GtkReact.tree_view_selection lst in
let hasSel = selection >> fun l -> l <> [] in
let addB =
GButton.button ~stock:`ADD ~packing:(vb#pack ~expand:false) () in
let editB =
GButton.button ~stock:`EDIT ~packing:(vb#pack ~expand:false) () in
let deleteB =
GButton.button ~stock:`DELETE ~packing:(vb#pack ~expand:false) () in
List.iter (fun b -> b#set_xalign 0.) [addB; editB; deleteB];
GtkReact.set_sensitive editB hasSel;
GtkReact.set_sensitive deleteB hasSel;
let (modified, setModified) = React.make false in
let formatValue vl = Unicode.protect (String.concat ", " vl) in
let deletePref () =
match React.state selection with
[rf] ->
let row = lst_sorted_store#convert_iter_to_child_iter rf#iter in
let (nm, ty, vl) = lst_store#get ~row ~column:c_ml in
if
twoBox ~kind:`DIALOG_QUESTION ~parent:t ~title:"Preference Deletion"
~bstock:`CANCEL ~astock:`DELETE
(Format.sprintf "Do you really want to delete preference %s?"
(Unicode.protect nm))
then begin
ignore (lst_store#remove row);
setModified true
end
| _ ->
()
in
let editPref path =
let row =
lst_sorted_store#convert_iter_to_child_iter
(lst_sorted_store#get_iter path) in
let (nm, ty, vl) = lst_store#get ~row ~column:c_ml in
match editPreference t nm ty vl with
Some [] ->
deletePref ()
| Some vl' when vl <> vl' ->
lst_store#set ~row ~column:c_ml (nm, ty, vl');
lst_store#set ~row ~column:c_value (formatValue vl');
setModified true
| _ ->
()
in
let add () =
match addPreference t with
None ->
()
| Some nm ->
let existing = ref false in
lst_store#foreach
(fun path row ->
let (nm', _, _) = lst_store#get ~row ~column:c_ml in
if nm = nm' then begin
existing := true; editPref path; true
end else
false);
if not !existing then begin
let ty = Prefs.typ nm in
match editPreference parent nm ty (defaultValue ty) with
Some vl when vl <> [] ->
let row = lst_store#append () in
lst_store#set ~row ~column:c_name (Unicode.protect nm);
lst_store#set ~row ~column:c_type (nameOfType ty);
lst_store#set ~row ~column:c_ml (nm, ty, vl);
lst_store#set ~row ~column:c_value (formatValue vl);
setModified true
| _ ->
()
end
in
ignore (addB#connect#clicked ~callback:add);
ignore (editB#connect#clicked
~callback:(fun () ->
match React.state selection with
[p] -> editPref p#path
| _ -> ()));
ignore (deleteB#connect#clicked ~callback:deletePref);
let updateDoc = documentPreference ~compact:true ~packing:paned#pack2 in
selection >|
(fun l ->
let nm =
match l with
[rf] ->
let row = rf#iter in
Some (lst_sorted_store#get ~row ~column:c_name)
| _ ->
None
in
updateDoc nm);
ignore (lst#connect#row_activated ~callback:(fun path _ -> editPref path));
let group l =
let rec groupRec l k vl l' =
match l with
(k', v) :: r ->
if k = k' then
groupRec r k (v :: vl) l'
else
groupRec r k' [v] ((k, vl) :: l')
| [] ->
Safelist.fold_left
(fun acc (k, l) -> (k, List.rev l) :: acc) [] ((k, vl) :: l')
in
match l with
(k, v) :: r -> groupRec r k [v] []
| [] -> []
in
let lastOne l = [List.hd (Safelist.rev l)] in
let normalizeValue t vl =
match t with
`BOOL | `INT | `STRING -> lastOne vl
| `STRING_LIST | `CUSTOM | `UNKNOWN -> vl
| `BOOLDEF ->
let l = lastOne vl in
if l = ["default"] || l = ["auto"] then [] else l
in
let (>>>) x f = f x in
Prefs.readAFile name
>>> List.map (fun (_, _, nm, v) -> Prefs.canonicalName nm, v)
>>> List.stable_sort (fun (nm, _) (nm', _) -> compare nm nm')
>>> group
>>> List.iter
(fun (nm, vl) ->
let nm = Prefs.canonicalName nm in
let ty = Prefs.typ nm in
let vl = normalizeValue ty vl in
if vl <> [] then begin
let row = lst_store#append () in
lst_store#set ~row ~column:c_name (Unicode.protect nm);
lst_store#set ~row ~column:c_type (nameOfType ty);
lst_store#set ~row ~column:c_value (formatValue vl);
lst_store#set ~row ~column:c_ml (nm, ty, vl)
end);
let applyCommand _ =
if React.state modified then begin
let filename = Prefs.profilePathname name in
try
let ch =
System.open_out_gen [Open_wronly; Open_creat; Open_trunc] 0o600
filename
in
(*XXX Should trim whitespaces and check for '\n' at some point *)
Printf.fprintf ch "# Unison preferences\n";
lst_store#foreach
(fun path row ->
let (nm, _, vl) = lst_store#get ~row ~column:c_ml in
List.iter (fun v -> Printf.fprintf ch "%s = %s\n" nm v) vl;
false);
close_out ch;
setModified false
with Sys_error _ as e ->
okBox ~parent:t ~typ:`ERROR ~title:"Could not save profile"
~message:(Uicommon.exn2string e)
end
in
let applyButton =
GButton.button ~stock:`APPLY ~packing:t#action_area#add () in
ignore (applyButton#connect#clicked ~callback:applyCommand);
GtkReact.set_sensitive applyButton modified;
let cancelCommand () = t#destroy () 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:(fun _ -> cancelCommand (); true));
let okCommand _ = applyCommand (); t#destroy () in
let okButton =
GButton.button ~stock:`OK ~packing:t#action_area#add () in
ignore (okButton#connect#clicked ~callback:okCommand);
okButton#grab_default ();
(*
List.iter
(fun (nm, _, long) ->
try
let long = formatDoc long in
ignore (Str.search_forward (Str.regexp_string "\\") long 0);
Format.eprintf "%s %s@." nm long
with Not_found -> ())
(Prefs.listVisiblePrefs ());
*)
(*
TODO:
- Extra tabs for common preferences
(should keep track of any change, or blacklist some preferences)
- Add, modify, delete
- Keep track of whether there is any change (apply button)
*)
ignore (t#connect#destroy ~callback:GMain.Main.quit);
t#show ();
GMain.Main.main ()
(* ------ *)
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 Os.unisonDir "*.prf")))
let getProfile quit =
let ok = ref false in
(* Build the dialog *)
let t =
GWindow.dialog ~parent:(toplevelWindow ()) ~border_width:12
~no_separator:true ~title:"Profile Selection"
~modal:true () in
t#set_default_width 550;
let cancelCommand _ = t#destroy () in
let cancelButton =
GButton.button ~stock:(if quit then `QUIT else `CANCEL)
~packing:t#action_area#add () in
ignore (cancelButton#connect#clicked ~callback:cancelCommand);
ignore (t#event#connect#delete ~callback:(fun _ -> cancelCommand (); true));
cancelButton#misc#set_can_default true;
let okCommand() = ok := true; t#destroy () in
let okButton =
GButton.button ~stock:`OPEN ~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
t#vbox#set_spacing 18;
let al = GBin.alignment ~packing:(vb#add) () in
al#set_left_padding 12;
let lvb = GPack.vbox ~spacing:6 ~packing:(al#add) () in
let selectLabel =
GMisc.label
~text:"Select a _profile:" ~use_underline:true
~xalign:0. ~packing:(lvb#pack ~expand:false) ()
in
let hb = GPack.hbox ~spacing:12 ~packing:(lvb#add) () in
let sw =
GBin.scrolled_window ~packing:(hb#pack ~expand:true) ~height:300
~shadow_type:`IN ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in
let cols = new GTree.column_list in
let c_name = cols#add Gobject.Data.string in
let c_label = cols#add Gobject.Data.string in
let c_ml = cols#add Gobject.Data.caml in
let lst_store = GTree.list_store cols in
let lst = GTree.view ~model:lst_store ~packing:sw#add () in
selectLabel#set_mnemonic_widget (Some (lst :> GObj.widget));
let vc_name =
GTree.view_column
~title:"Profile"
~renderer:(GTree.cell_renderer_text [], ["text", c_name]) ()
in
ignore (lst#append_column vc_name);
ignore (lst#append_column
(GTree.view_column
~title:"Description"
~renderer:(GTree.cell_renderer_text [], ["text", c_label]) ()));
let vb = GPack.vbox ~spacing:6 ~packing:(vb#pack ~expand:false) () in
ignore (GMisc.label ~markup:"Summary" ~xalign:0.
~packing:(vb#pack ~expand:false) ());
let al = GBin.alignment ~packing:(vb#pack ~expand:false) () in
al#set_left_padding 12;
let tbl =
GPack.table ~rows:2 ~columns:2 ~col_spacings:12 ~row_spacings:6
~packing:(al#add) () in
tbl#misc#set_sensitive false;
ignore (GMisc.label ~text:"First root:" ~xalign:0.
~packing:(tbl#attach ~left:0 ~top:0 ~expand:`NONE) ());
ignore (GMisc.label ~text:"Second root:" ~xalign:0.
~packing:(tbl#attach ~left:0 ~top:1 ~expand:`NONE) ());
let root1 =
GMisc.label ~packing:(tbl#attach ~left:1 ~top:0 ~expand:`X)
~xalign:0. ~selectable:true () in
let root2 =
GMisc.label ~packing:(tbl#attach ~left:1 ~top:1 ~expand:`X)
~xalign:0. ~selectable:true () in
let fillLst default =
scanProfiles();
lst_store#clear ();
Safelist.iter
(fun (profile, info) ->
let labeltext =
match info.label with None -> "" | Some l -> l in
let row = lst_store#append () in
lst_store#set ~row ~column:c_name (Unicode.protect profile);
lst_store#set ~row ~column:c_label (Unicode.protect labeltext);
lst_store#set ~row ~column:c_ml (profile, info);
if Some profile = default then begin
lst#selection#select_iter row;
lst#scroll_to_cell (lst_store#get_path row) vc_name
end)
(Safelist.sort (fun (p, _) (p', _) -> compare p p') !profilesAndRoots)
in
let selection = GtkReact.tree_view_selection lst in
let hasSel = selection >> fun l -> l <> [] in
let selInfo =
selection >> fun l ->
match l with
[rf] -> Some (lst_store#get ~row:rf#iter ~column:c_ml, rf)
| _ -> None
in
selInfo >|
(fun info ->
match info with
Some ((profile, info), _) ->
begin match info.roots with
[r1; r2] -> root1#set_text (Unicode.protect r1);
root2#set_text (Unicode.protect r2);
tbl#misc#set_sensitive true
| _ -> root1#set_text ""; root2#set_text "";
tbl#misc#set_sensitive false
end
| None ->
root1#set_text ""; root2#set_text "";
tbl#misc#set_sensitive false);
GtkReact.set_sensitive okButton hasSel;
let vb =
GPack.button_box
`VERTICAL ~layout:`START ~spacing:6 ~packing:(hb#pack ~expand:false) ()
in
let addButton =
GButton.button ~stock:`ADD ~packing:(vb#pack ~expand:false) () in
ignore (addButton#connect#clicked
~callback:(fun () ->
match createProfile t with
Some p -> fillLst (Some p) | None -> ()));
let editButton =
GButton.button ~stock:`EDIT ~packing:(vb#pack ~expand:false) () in
ignore (editButton#connect#clicked
~callback:(fun () -> match React.state selInfo with
None ->
()
| Some ((p, _), _) ->
editProfile t p; fillLst (Some p)));
GtkReact.set_sensitive editButton hasSel;
let deleteProfile () =
match React.state selInfo with
Some ((profile, _), rf) ->
if
twoBox ~kind:`DIALOG_QUESTION ~parent:t ~title:"Profile Deletion"
~bstock:`CANCEL ~astock:`DELETE
(Format.sprintf "Do you really want to delete profile %s?"
(transcode profile))
then begin
try
System.unlink (Prefs.profilePathname profile);
ignore (lst_store#remove rf#iter)
with Unix.Unix_error _ -> ()
end
| None ->
()
in
let deleteButton =
GButton.button ~stock:`DELETE ~packing:(vb#pack ~expand:false) () in
ignore (deleteButton#connect#clicked ~callback:deleteProfile);
GtkReact.set_sensitive deleteButton hasSel;
List.iter (fun b -> b#set_xalign 0.) [addButton; editButton; deleteButton];
ignore (lst#connect#row_activated ~callback:(fun _ _ -> okCommand ()));
fillLst None;
lst#misc#grab_focus ();
ignore (t#connect#destroy ~callback:GMain.Main.quit);
t#show ();
GMain.Main.main ();
match React.state selInfo with
Some ((p, _), _) when !ok -> Some p
| _ -> None
(* ------ *)
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) message =
let utitle = transcode title in
let t = GWindow.dialog ~title:utitle ~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 ()
(* 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
~parent ~title ~message ~longtext ~advLabel ~astock ~bstock =
let t =
GWindow.dialog ~parent ~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_QUESTION ~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" 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);
t#show();
GMain.Main.main();
!res
let summaryBox ~parent ~title ~message ~f =
let t =
GWindow.dialog ~parent ~border_width:6 ~modal:true ~no_separator:true
~allow_grow:false ~focus_on_map: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 ~xalign:0. ~yalign:0. ~packing:v1#add ());
let exp = GBin.expander ~spacing:12 ~label:"Show details" ~packing:v1#add () in
let t_text =
new scrolled_text ~editable:false ~shadow_type:`IN
~width:60 ~height:10 ~packing:exp#add ()
in
f (t_text#text);
t#add_button_stock `OK `OK;
t#set_default_response `OK;
let setRes signal = t#destroy () in
ignore (t#connect#response ~callback:setRes);
ignore (t#connect#destroy ~callback:GMain.Main.quit);
t#show();
GMain.Main.main()
(**********************************************************************
TOP-LEVEL WINDOW
**********************************************************************)
let displayWaitMessage () =
make_busy (toplevelWindow ());
Trace.status (Uicommon.contactingServerMsg ())
(* ------ *)
type status = NoStatus | Done | Failed
let createToplevelWindow () =
let toplevelWindow =
GWindow.window ~kind:`TOPLEVEL ~position:`CENTER
~title:myNameCapitalized ()
in
setToplevelWindow toplevelWindow;
(* 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 (statWin, startStats, stopStats) = 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 grRescan = ref [] in
let grDetail = 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
let grDisactivateAll () =
grSet grAction false;
grSet grDiff false;
grSet grGo false;
grSet grRescan false;
grSet grDetail false
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 gMenuFactory ~accel_modi:[] menuBar in
let accel_group = menus#accel_group in
toplevelWindow#add_accel_group accel_group;
let add_submenu ?(modi=[]) label =
let (menu, item) = menus#add_submenu label in
(new gMenuFactory ~accel_group:(menus#accel_group)
~accel_path:(menus#accel_path ^ label ^ "/")
~accel_modi:modi menu,
item)
in
let replace_submenu ?(modi=[]) label item =
let menu = menus#replace_submenu item in
new gMenuFactory ~accel_group:(menus#accel_group)
~accel_path:(menus#accel_path ^ label ^ "/")
~accel_modi:modi menu
in
let profileLabel =
GMisc.label ~text:"" ~packing:(topHBox#pack ~expand:false ~padding:2) () in
let displayNewProfileLabel () =
let p = match !Prefs.profileName with None -> "" | Some p -> p in
let label = Prefs.read Uicommon.profileLabel in
let s =
match p, label with
"", _ -> ""
| _, "" -> p
| "default", _ -> label
| _ -> Format.sprintf "%s (%s)" p label
in
toplevelWindow#set_title
(if s = "" then myNameCapitalized else
Format.sprintf "%s [%s]" myNameCapitalized s);
let s = if s="" then "No profile" else "Profile: " ^ s in
profileLabel#set_text (transcode s)
in
displayNewProfileLabel ();
(*********************************************************************
Create the menus
*********************************************************************)
let (fileMenu, _) = add_submenu "_Synchronization" in
let (actionMenu, actionItem) = add_submenu "_Actions" in
let (ignoreMenu, _) = add_submenu ~modi:[`SHIFT] "_Ignore" in
let (sortMenu, _) = add_submenu "S_ort" in
let (helpMenu, _) = add_submenu "_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 mainWindowSW =
GBin.scrolled_window ~packing:(toplevelVBox#pack ~expand:true)
~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC ()
in
let sizeMainWindow () =
let ctx = mainWindowSW#misc#pango_context in
let metrics = ctx#get_metrics () in
let h = GPango.to_pixels (metrics#ascent+metrics#descent) in
mainWindowSW#misc#set_size_request
~height:((h + 1) * (Prefs.read Uicommon.mainWindowHeight + 1) + 10) ()
in
let mainWindow =
GList.clist ~columns:5 ~titles_show:true
~selection_mode:`MULTIPLE ~packing:mainWindowSW#add ()
in
(*
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:(" " ^ Unicode.protect (String.sub s 0 12) ^ " ")
~renderer:(GTree.cell_renderer_text [], ["text", c_replica1]) ()));
ignore (lst#append_column
(GTree.view_column ~title:" Action "
~renderer:(GTree.cell_renderer_pixbuf [], ["pixbuf", c_action]) ()));
ignore (lst#append_column
(GTree.view_column
~title:(" " ^ Unicode.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 s =
Array.iteri
(fun i data ->
mainWindow#set_column
~title_active:false ~auto_resize:true ~title:data i)
[| " " ^ Unicode.protect (String.sub s 0 12) ^ " "; " Action ";
" " ^ Unicode.protect (String.sub s 15 12) ^ " "; " Status ";
" Path" |];
sizeMainWindow ()
in
setMainWindowColumnHeaders " ";
(*********************************************************************
Create the details window
*********************************************************************)
let showDetCommand () =
let details =
match currentRow () with
None ->
None
| Some row ->
let path = Path.toString !theState.(row).ri.path1 in
match !theState.(row).whatHappened with
Some (Util.Failed _, Some det) ->
Some ("Merge execution details for file" ^
transcodeFilename path,
det)
| _ ->
match !theState.(row).ri.replicas with
Problem err ->
Some ("Errors for file " ^ transcodeFilename path, err)
| Different diff ->
let prefix s l =
Safelist.map (fun err -> Format.sprintf "%s%s\n" s err) l
in
let errors =
Safelist.append
(prefix "[root 1]: " diff.errors1)
(prefix "[root 2]: " diff.errors2)
in
let errors =
match !theState.(row).whatHappened with
Some (Util.Failed err, _) -> err :: errors
| _ -> errors
in
Some ("Errors for file " ^ transcodeFilename path,
String.concat "\n" errors)
in
match details with
None -> ((* Should not happen *))
| Some (title, details) -> messageBox ~title (transcode details)
in
let detailsWindowSW =
GBin.scrolled_window ~packing:(toplevelVBox#pack ~expand:false)
~shadow_type:`IN ~hpolicy:`NEVER ~vpolicy:`AUTOMATIC ()
in
let detailsWindow =
GText.view ~editable:false ~packing:detailsWindowSW#add ()
in
let detailsWindowPath = detailsWindow#buffer#create_tag [] in
let detailsWindowInfo =
detailsWindow#buffer#create_tag [`FONT_DESC (Lazy.force fontMonospace)] in
let detailsWindowError =
detailsWindow#buffer#create_tag [`WRAP_MODE `WORD] in
detailsWindow#misc#set_size_chars ~height:3 ~width:112 ();
detailsWindow#misc#set_can_focus false;
let updateButtons () =
if not !busy then
let actionPossible row =
let si = !theState.(row) in
match si.whatHappened, si.ri.replicas with
None, Different _ -> true
| _ -> false
in
match currentRow () with
None ->
grSet grAction (IntSet.exists actionPossible !current);
grSet grDiff false;
grSet grDetail false
| Some row ->
let details =
begin match !theState.(row).ri.replicas with
Different diff -> diff.errors1 <> [] || diff.errors2 <> []
| Problem _ -> true
end
||
begin match !theState.(row).whatHappened with
Some (Util.Failed _, _) -> true
| _ -> false
end
in
grSet grDetail details;
let activateAction = actionPossible row in
let activateDiff =
activateAction &&
match !theState.(row).ri.replicas with
Different {rc1 = {typ = `FILE}; rc2 = {typ = `FILE}} ->
true
| _ ->
false
in
grSet grAction activateAction;
grSet grDiff activateDiff
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 makeRowVisible im 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 currentRow () with
None ->
detailsWindow#buffer#set_text ""
| Some row ->
(* makeRowVisible row;*)
let (formated, details) =
match !theState.(row).whatHappened with
| Some(Util.Failed(s), _) ->
(false, s)
| None | Some(Util.Succeeded, _) ->
match !theState.(row).ri.replicas with
Problem _ ->
(false, Uicommon.details2string !theState.(row).ri " ")
| Different _ ->
(true, Uicommon.details2string !theState.(row).ri " ")
in
let path = Path.toString !theState.(row).ri.path1 in
detailsWindow#buffer#set_text "";
detailsWindow#buffer#insert ~tags:[detailsWindowPath]
(transcodeFilename path);
let len = String.length details in
let details =
if details.[len - 1] = '\n' then String.sub details 0 (len - 1)
else details
in
if details <> "" then
detailsWindow#buffer#insert
~tags:[if formated then detailsWindowInfo else detailsWindowError]
("\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#misc#set_size_chars ~height:1 ~width:28 ();
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 false
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 delayUpdates = ref false in
let hasFocus = ref false in
let select i scroll =
if !hasFocus then begin
(* If we have the focus, we move the focus row directely *)
if scroll then begin
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.)
end;
if IntSet.is_empty !current then mainWindow#select i 0
end else begin
(* If we don't have the focus, we just move the selection.
We delay updates to make sure not to change the button
states unnecessarily (which could result in a button
losing the focus). *)
delayUpdates := true;
mainWindow#unselect_all ();
mainWindow#select i 0;
delayUpdates := false;
if scroll then makeRowVisible i;
updateDetails ()
end
in
ignore (mainWindow#event#connect#focus_in ~callback:
(fun _ ->
hasFocus := true;
(* Adjust the focus row. We cannot do it immediately,
otherwise the focus row is not drawn correctly. *)
ignore (GMain.Idle.add (fun () ->
begin match currentRow () with
Some i -> select i false
| None -> ()
end;
false));
false));
ignore (mainWindow#event#connect#focus_out ~callback:
(fun _ -> hasFocus := false; false));
ignore (mainWindow#connect#select_row ~callback:
(fun ~row ~column ~event ->
current := IntSet.add row !current;
if not !delayUpdates then updateDetails ()));
ignore (mainWindow#connect#unselect_row ~callback:
(fun ~row ~column ~event ->
current := IntSet.remove row !current;
if not !delayUpdates then updateDetails ()));
let nextInteresting () =
let l = Array.length !theState in
let start = match currentRow () with Some i -> i + 1 | None -> 0 in
let rec loop i =
if i < l then
match !theState.(i).ri.replicas with
Different {direction = dir}
when not (Prefs.read Uicommon.auto) || isConflict dir ->
select i true
| _ ->
loop (i + 1) in
loop start in
let selectSomethingIfPossible () =
if IntSet.is_empty !current then nextInteresting () in
let columnsOf i =
let oldPath = if i = 0 then Path.empty else !theState.(i-1).ri.path1 in
let status =
match !theState.(i).ri.replicas with
Different {direction = Conflict _} | Problem _ ->
NoStatus
| _ ->
match !theState.(i).whatHappened with
None -> NoStatus
| Some (Util.Succeeded, _) -> Done
| Some (Util.Failed _, _) -> Failed
in
let (r1, action, r2, path) =
Uicommon.reconItem2stringList oldPath !theState.(i).ri in
(r1, action, r2, status, path)
in
let greenPixel = "00dd00" in
let redPixel = "ff2040" in
let lightbluePixel = "8888FF" in
let orangePixel = "ff9303" in
(*
let yellowPixel = "999900" 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 doneIcon = buildPixmap Pixmaps.success in
let failedIcon = buildPixmap Pixmaps.failure in
let rightArrow = buildPixmaps Pixmaps.copyAB greenPixel in
let leftArrow = buildPixmaps Pixmaps.copyBA greenPixel in
let orangeRightArrow = buildPixmaps Pixmaps.copyAB orangePixel in
let orangeLeftArrow = buildPixmaps Pixmaps.copyBA orangePixel in
let ignoreAct = buildPixmaps Pixmaps.ignore redPixel in
let failedIcons = (failedIcon, failedIcon) in
let mergeLogo = buildPixmaps Pixmaps.mergeLogo greenPixel in
(*
let rightArrowBlack = buildPixmap (Pixmaps.copyAB blackPixel) in
let leftArrowBlack = buildPixmap (Pixmaps.copyBA blackPixel) in
let mergeLogoBlack = buildPixmap (Pixmaps.mergeLogo blackPixel) in
*)
let displayArrow i j action =
let changedFromDefault = match !theState.(j).ri.replicas with
Different diff -> diff.direction <> diff.default_direction
| _ -> false in
let sel pixmaps =
if changedFromDefault then snd pixmaps else fst pixmaps in
let pixmaps =
match action with
Uicommon.AError -> failedIcons
| Uicommon.ASkip _ -> ignoreAct
| Uicommon.ALtoR false -> rightArrow
| Uicommon.ALtoR true -> orangeRightArrow
| Uicommon.ARtoL false -> leftArrow
| Uicommon.ARtoL true -> orangeLeftArrow
| Uicommon.AMerge -> mergeLogo
in
mainWindow#set_cell ~pixmap:(sel pixmaps) i 1
in
let displayStatusIcon i status =
match status with
| Failed -> mainWindow#set_cell ~pixmap:failedIcon i 3
| Done -> mainWindow#set_cell ~pixmap:doneIcon i 3
| NoStatus -> mainWindow#set_cell ~text:" " 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 = currentRow () 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; ""; transcodeFilename path ]);
displayArrow 0 i action;
displayStatusIcon i status
done;
debug (fun()-> Util.msg "reset current to %s\n"
(match savedCurrent with None->"None" | Some(i) -> string_of_int i));
begin match savedCurrent with
None -> selectSomethingIfPossible ()
| Some idx -> select idx true
end;
mainWindow#thaw ();
updateDetails (); (* Do we need this line? *)
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
mainWindow#set_cell
~text:(transcodeFilename path ^
" [failed: click on this line for details]") i 4;
(*mainWindow#thaw ();*)
if currentRow () = Some i then begin
updateDetails (); updateButtons ()
end
in
let fastRedisplay i =
let (r1, action, r2, status, path) = columnsOf i in
displayStatusIcon i status;
if status = Failed then
mainWindow#set_cell
~text:(transcodeFilename path ^
" [failed: click on this line for details]") i 4;
if currentRow () = Some i then updateDetails ();
in
let totalBytesToTransfer = ref Uutil.Filesize.zero in
let totalBytesTransferred = ref Uutil.Filesize.zero in
let t0 = ref 0. in
let t1 = ref 0. in
let lastFrac = ref 0. in
let oldWritten = ref 0. in
let writeRate = ref 0. in
let displayGlobalProgress v =
if v = 0. || abs_float (v -. !lastFrac) > 1. then begin
lastFrac := v;
progressBar#set_fraction (max 0. (min 1. (v /. 100.)))
end;
if v < 0.001 then
progressBar#set_text " "
else begin
let t = Unix.gettimeofday () in
let delta = t -. !t1 in
if delta >= 0.5 then begin
t1 := t;
let remTime =
if v >= 100. then "00:00 remaining" else
let t = truncate ((!t1 -. !t0) *. (100. -. v) /. v +. 0.5) in
Format.sprintf "%02d:%02d remaining" (t / 60) (t mod 60)
in
let written = !clientWritten +. !serverWritten in
let b = 0.64 ** delta in
writeRate :=
b *. !writeRate +.
(1. -. b) *. (written -. !oldWritten) /. delta;
oldWritten := written;
let rate = !writeRate (*!emitRate2 +. !receiveRate2*) in
let txt =
if rate > 99. then
Format.sprintf "%s (%s)" remTime (rate2str rate)
else
remTime
in
progressBar#set_text txt
end
end
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 root1IsLocal = ref true in
let root2IsLocal = ref true in
let initGlobalProgress b =
let (root1,root2) = Globals.roots () in
root1IsLocal := fst root1 = Local;
root2IsLocal := fst root2 = Local;
totalBytesToTransfer := b;
totalBytesTransferred := Uutil.Filesize.zero;
t0 := Unix.gettimeofday (); t1 := !t0;
writeRate := 0.; oldWritten := !clientWritten +. !serverWritten;
displayGlobalProgress 0.
in
let showProgress i bytes dbg =
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 = item.bytesToTransfer 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
let oldstatus = mainWindow#cell_text i 3 in
if oldstatus <> newstatus then mainWindow#set_cell ~text:newstatus i 3;
showGlobalProgress bytes;
gtk_sync false;
begin match item.ri.replicas with
Different diff ->
begin match diff.direction 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.path1) in
begin match currentRow () with
None ->
theState := Array.of_list (Safelist.filter keep lst);
current := IntSet.empty
| 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 IntSet.empty
else IntSet.singleton (min (!i) ((Array.length !theState) - 1))
end;
displayMain() in
let sortAndRedisplay () =
current := IntSet.empty;
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 commitUpdates () =
Trace.status "Updating synchronizer state";
let t = Trace.startTimer "Updating synchronizer state" in
gtk_sync true;
Update.commitUpdates();
Trace.showTimer t
in
let clearMainWindow () =
grDisactivateAll ();
make_busy toplevelWindow;
mainWindow#clear();
detailsWindow#buffer#set_text ""
in
let detectUpdatesAndReconcile () =
clearMainWindow ();
startStats ();
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 ~wantWatcher:() !unsynchronizedPaths in
Trace.showTimer t;
updates in
let reconcile updates =
let t = Trace.startTimer "Reconciling" in
let reconRes = Recon.reconcileAll ~allowPartial:true updates in
Trace.showTimer t;
reconRes in
let (reconItemList, thereAreEqualUpdates, dangerousPaths) =
reconcile (findUpdates ()) in
if not !Update.foundArchives then commitUpdates ();
if reconItemList = [] then
if thereAreEqualUpdates then begin
if !Update.foundArchives then commitUpdates ();
Trace.status
"Replicas have been changed only in identical ways since last sync"
end 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;
bytesToTransfer = Uutil.Filesize.zero;
whatHappened = None })
reconItemList);
unsynchronizedPaths :=
Some (List.map (fun ri -> ri.path1) reconItemList, []);
current := IntSet.empty;
displayMain();
progressBarPulse := false; sync_action := None; displayGlobalProgress 0.;
stopStats ();
grSet grGo (Array.length !theState > 0);
grSet grRescan true;
make_interactive toplevelWindow;
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 = "about" then
ignore (helpMenu#add_image_item
~stock:`ABOUT ~callback:(fun () -> documentation shortname)
name)
else if shortname <> "" && name <> "" then
ignore (helpMenu#add_item
~callback:(fun () -> documentation shortname)
name) in
Safelist.iter addDocSection Strings.docs;
(*********************************************************************
Ignore menu
*********************************************************************)
let addRegExpByPath pathfunc =
Util.StringSet.iter (fun pat -> Uicommon.addIgnorePattern pat)
(IntSet.fold
(fun i s -> Util.StringSet.add (pathfunc !theState.(i).ri.path1) s)
!current Util.StringSet.empty);
ignoreAndRedisplay ()
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 grRescan
(ignoreMenu#add_item ~callback:
(fun () -> getLock ignoreDialog) "Edit ignore patterns");
*)
(*********************************************************************
Sort menu
*********************************************************************)
grAdd grRescan
(sortMenu#add_item
~callback:(fun () -> getLock (fun () ->
Sortri.sortByName();
sortAndRedisplay()))
"Sort by _Name");
grAdd grRescan
(sortMenu#add_item
~callback:(fun () -> getLock (fun () ->
Sortri.sortBySize();
sortAndRedisplay()))
"Sort by _Size");
grAdd grRescan
(sortMenu#add_item
~callback:(fun () -> getLock (fun () ->
Sortri.sortNewFirst();
sortAndRedisplay()))
"Sort Ne_w Entries First");
grAdd grRescan
(sortMenu#add_item
~callback:(fun () -> getLock (fun () ->
Sortri.restoreDefaultSettings();
sortAndRedisplay()))
"_Default Ordering");
(*********************************************************************
Main function : synchronize
*********************************************************************)
let synchronize () =
if Array.length !theState = 0 then
Trace.status "Nothing to synchronize"
else begin
grDisactivateAll ();
make_busy toplevelWindow;
Trace.status "Propagating changes";
Transport.logStart ();
let totalLength =
Array.fold_left
(fun l si ->
si.bytesTransferred <- Uutil.Filesize.zero;
let len =
if si.whatHappened = None then Common.riLength si.ri else
Uutil.Filesize.zero
in
si.bytesToTransfer <- len;
Uutil.Filesize.add l len)
Uutil.Filesize.zero !theState in
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
~parent:toplevelWindow
~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 ->
let rem =
Uutil.Filesize.sub
theSI.bytesToTransfer theSI.bytesTransferred
in
if rem <> Uutil.Filesize.zero then
showProgress (Uutil.File.ofLine i) rem "done";
theSI.whatHappened <- Some (res, !textDetailed);
fastRedisplay i;
(* JV (7/09): It does not seem that useful to me to scroll the display
to make the first unfinished item visible. The scrolling is way
too fast, and it makes it impossible to browse the list. *)
(*
sync_action :=
Some
(fun () ->
makeFirstUnfinishedVisible pRiThisRound;
sync_action := None);
*)
gtk_sync false;
return ())
| Some _ ->
return () (* Already processed this one (e.g. merged it) *)
in
loop (i + 1) (action :: actions) pRiThisRound
end else
actions
in
startStats ();
Lwt_unix.run
(let actions = loop 0 [] (fun ri -> not (Common.isDeletion ri)) in
Lwt_util.join actions);
Lwt_unix.run
(let actions = loop 0 [] Common.isDeletion in
Lwt_util.join actions);
Transport.logFinish ();
Trace.showTimer t;
commitUpdates ();
stopStats ();
let failureList =
Array.fold_right
(fun si l ->
match si.whatHappened with
Some (Util.Failed err, _) ->
(si, [err], "transport failure") :: l
| _ ->
l)
!theState []
in
let failureCount = List.length failureList in
let failures =
if failureCount = 0 then [] else
[Printf.sprintf "%d failure%s"
failureCount (if failureCount = 1 then "" else "s")]
in
let partialList =
Array.fold_right
(fun si l ->
match si.whatHappened with
Some (Util.Succeeded, _)
when partiallyProblematic si.ri &&
not (problematic si.ri) ->
let errs =
match si.ri.replicas with
Different diff -> diff.errors1 @ diff.errors2
| _ -> assert false
in
(si, errs,
"partial transfer (errors during update detection)") :: l
| _ ->
l)
!theState []
in
let partialCount = List.length partialList in
let partials =
if partialCount = 0 then [] else
[Printf.sprintf "%d partially transferred" partialCount]
in
let skippedList =
Array.fold_right
(fun si l ->
match si.ri.replicas with
Problem err ->
(si, [err], "error during update detection") :: l
| Different diff when isConflict diff.direction ->
(si, [],
if isConflict diff.default_direction then
"conflict"
else "skipped") :: l
| _ ->
l)
!theState []
in
let skippedCount = List.length skippedList in
let skipped =
if skippedCount = 0 then [] else
[Printf.sprintf "%d skipped" skippedCount]
in
unsynchronizedPaths :=
Some (List.map (fun (si, _, _) -> si.ri.path1)
(failureList @ partialList @ skippedList),
[]);
Trace.status
(Printf.sprintf "Synchronization complete %s"
(String.concat ", " (failures @ partials @ skipped)));
displayGlobalProgress 0.;
grSet grRescan true;
make_interactive toplevelWindow;
let totalCount = failureCount + partialCount + skippedCount in
if totalCount > 0 then begin
let format n item sing plur =
match n with
0 -> []
| 1 -> [Format.sprintf "one %s%s" item sing]
| n -> [Format.sprintf "%d %s%s" n item plur]
in
let infos =
format failureCount "failure" "" "s" @
format partialCount "partially transferred director" "y" "ies" @
format skippedCount "skipped item" "" "s"
in
let message =
(if failureCount = 0 then "The synchronization was successful.\n\n"
else "") ^
"The replicas are not fully synchronized.\n" ^
(if totalCount < 2 then "There was" else "There were") ^
begin match infos with
[] -> assert false
| [x] -> " " ^ x
| l -> ":\n - " ^ String.concat ";\n - " l
end ^
"."
in
summaryBox ~parent:toplevelWindow
~title:"Synchronization summary" ~message ~f:
(fun t ->
let bullet = "\xe2\x80\xa2 " in
let layout = t#misc#pango_context#create_layout in
Pango.Layout.set_text layout bullet;
let (n, _) = Pango.Layout.get_pixel_size layout in
let path =
t#buffer#create_tag [`FONT_DESC (Lazy.force fontBold)] in
let description =
t#buffer#create_tag [`FONT_DESC (Lazy.force fontItalic)] in
let errorFirstLine =
t#buffer#create_tag [`LEFT_MARGIN (n); `INDENT (- n)] in
let errorNextLines =
t#buffer#create_tag [`LEFT_MARGIN (2 * n)] in
List.iter
(fun (si, errs, desc) ->
t#buffer#insert ~tags:[path]
(transcodeFilename (Path.toString si.ri.path1));
t#buffer#insert ~tags:[description]
(" \xe2\x80\x94 " ^ desc ^ "\n");
List.iter
(fun err ->
let errl =
Str.split (Str.regexp_string "\n") (transcode err) in
match errl with
[] ->
()
| f :: rem ->
t#buffer#insert ~tags:[errorFirstLine]
(bullet ^ f ^ "\n");
List.iter
(fun n ->
t#buffer#insert ~tags:[errorNextLines]
(n ^ "\n"))
rem)
errs)
(failureList @ partialList @ skippedList))
end
end in
(*********************************************************************
Buttons for -->, M, <--, Skip
*********************************************************************)
let doActionOnRow f i =
let theSI = !theState.(i) in
begin match theSI.whatHappened, theSI.ri.replicas with
None, Different diff ->
f theSI.ri diff;
redisplay i
| _ ->
()
end
in
let updateCurrent () =
let n = mainWindow#rows in
(* This has quadratic complexity, thus we only do it when
the list is not too long... *)
if n < 300 then begin
current := IntSet.empty;
for i = 0 to n -1 do
if mainWindow#get_row_state i = `SELECTED then
current := IntSet.add i !current
done
end
in
let doAction f =
(* FIX: when the window does not have the focus, we are not notified
immediately from changes to the list of selected items. So, we
update our view of the current selection here. *)
updateCurrent ();
match currentRow () with
Some i ->
doActionOnRow f i;
nextInteresting ()
| None ->
(* FIX: this is quadratic when all items are selected.
We could trigger a redisplay instead, but it may be tricky
to preserve the set of selected rows, the focus row and the
scrollbar position.
The right fix is probably to move to a GTree.column_list. *)
let n = IntSet.cardinal !current in
if n > 0 then begin
if n > 20 then mainWindow#freeze ();
IntSet.iter (fun i -> doActionOnRow f i) !current;
if n > 20 then mainWindow#thaw ()
end
in
let leftAction _ =
doAction (fun _ diff -> diff.direction <- Replica2ToReplica1) in
let rightAction _ =
doAction (fun _ diff -> diff.direction <- Replica1ToReplica2) in
let questionAction _ = doAction (fun _ diff -> diff.direction <- Conflict "") in
let mergeAction _ = doAction (fun _ diff -> diff.direction <- Merge) in
(* 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 selected items\n\
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 selected items"
~callback:questionAction ());
(* 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 selected items\n\
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"
~tooltip:"Merge selected files"
~callback:mergeAction ());
(*********************************************************************
Diff / merge buttons
*********************************************************************)
let diffCmd () =
match currentRow () with
Some i ->
getLock (fun () ->
let item = !theState.(i) in
let len =
match item.ri.replicas with
Problem _ ->
Uutil.Filesize.zero
| Different diff ->
snd (if !root1IsLocal then diff.rc2 else diff.rc1).size
in
item.bytesTransferred <- Uutil.Filesize.zero;
item.bytesToTransfer <- len;
initGlobalProgress len;
startStats ();
Uicommon.showDiffs item.ri
(fun title text ->
messageBox ~title:(transcode title) (transcode text))
Trace.status (Uutil.File.ofLine i);
stopStats ();
displayGlobalProgress 0.;
fastRedisplay i)
| None ->
() in
actionBar#insert_space ();
grAdd grDiff (actionBar#insert_button ~text:"Diff"
~icon:((GMisc.image ~stock:`DIALOG_INFO ())#coerce)
~tooltip:"Compare the two files at each replica"
~callback:diffCmd ());
(*********************************************************************
Detail button
*********************************************************************)
(* actionBar#insert_space ();*)
grAdd grDetail (actionBar#insert_button ~text:"Details"
~icon:((GMisc.image ~stock:`INFO ())#coerce)
~tooltip:"Show detailed information about\n\
an item, when available"
~callback:showDetCommand ());
(*********************************************************************
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) ());
(* Does not quite work: too slow, and Files.copy must be modifed to
support an interruption without error. *)
(*
ignore (actionBar#insert_button ~text:"Stop"
~icon:((GMisc.image ~stock:`STOP ())#coerce)
~tooltip:"Exit Unison"
~callback:Abort.all ());
*)
(*********************************************************************
Rescan button
*********************************************************************)
let updateFromProfile = ref (fun () -> ()) in
let loadProfile p reload =
debug (fun()-> Util.msg "Loading profile %s..." p);
Trace.status "Loading profile";
unsynchronizedPaths := None;
Uicommon.initPrefs p
(fun () -> if not reload then displayWaitMessage ())
getFirstRoot getSecondRoot termInteract;
!updateFromProfile ()
in
let reloadProfile () =
let n =
match !Prefs.profileName with
None -> assert false
| Some n -> n
in
clearMainWindow ();
if not (Prefs.profileUnchanged ()) then loadProfile n true
in
let detectCmd () =
getLock detectUpdatesAndReconcile;
updateDetails ();
if Prefs.read Globals.batch then begin
Prefs.set Globals.batch false; synchronize()
end
in
(* actionBar#insert_space ();*)
grAdd grRescan
(actionBar#insert_button ~text:"Rescan"
~icon:((GMisc.image ~stock:`REFRESH ())#coerce)
~tooltip:"Check for updates"
~callback: (fun () -> reloadProfile(); detectCmd()) ());
(*********************************************************************
Profile change button
*********************************************************************)
actionBar#insert_space ();
let profileChange _ =
match getProfile false with
None -> ()
| Some p -> clearMainWindow (); loadProfile p false; detectCmd ()
in
grAdd grRescan (actionBar#insert_button ~text:"Change Profile"
~icon:((GMisc.image ~stock:`OPEN ())#coerce)
~tooltip:"Select a different profile"
~callback:profileChange ());
(*********************************************************************
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 buildActionMenu init =
let actionMenu = replace_submenu "_Actions" actionItem in
grAdd grRescan
(actionMenu#add_image_item
~callback:(fun _ -> mainWindow#select_all ())
~image:((GMisc.image ~stock:`SELECT_ALL ~icon_size:`MENU ())#coerce)
~modi:[`CONTROL] ~key:GdkKeysyms._A
"Select _All");
grAdd grRescan
(actionMenu#add_item
~callback:(fun _ -> mainWindow#unselect_all ())
~modi:[`SHIFT; `CONTROL] ~key:GdkKeysyms._A
"_Deselect All");
ignore (actionMenu#add_separator ());
let (loc1, loc2) =
if init then ("", "") else
let (root1,root2) = Globals.roots () in
(root2hostname root1, root2hostname root2)
in
let def_descr = "Left to Right" in
let descr =
if init || loc1 = loc2 then def_descr else
Printf.sprintf "from %s to %s" loc1 loc2 in
let left =
actionMenu#add_image_item ~key:GdkKeysyms._greater ~callback:rightAction
~image:((GMisc.image ~stock:`GO_FORWARD ~icon_size:`MENU ())#coerce)
~name:("Propagate " ^ def_descr) ("Propagate " ^ descr) in
grAdd grAction left;
left#add_accelerator ~group:accel_group ~modi:[`SHIFT] GdkKeysyms._greater;
left#add_accelerator ~group:accel_group GdkKeysyms._period;
let def_descl = "Right to Left" in
let descl =
if init || loc1 = loc2 then def_descr else
Printf.sprintf "from %s to %s"
(Unicode.protect loc2) (Unicode.protect loc1) in
let right =
actionMenu#add_image_item ~key:GdkKeysyms._less ~callback:leftAction
~image:((GMisc.image ~stock:`GO_BACK ~icon_size:`MENU ())#coerce)
~name:("Propagate " ^ def_descl) ("Propagate " ^ 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
(actionMenu#add_image_item ~key:GdkKeysyms._slash ~callback:questionAction
~image:((GMisc.image ~stock:`NO ~icon_size:`MENU ())#coerce)
"Do _Not Propagate Changes");
let merge =
actionMenu#add_image_item ~key:GdkKeysyms._m ~callback:mergeAction
~image:((GMisc.image ~stock:`ADD ~icon_size:`MENU ())#coerce)
"_Merge the Files" in
grAdd grAction merge;
(* merge#add_accelerator ~group:accel_group ~modi:[`SHIFT] GdkKeysyms._m; *)
(* Override actions *)
ignore (actionMenu#add_separator ());
grAdd grAction
(actionMenu#add_item
~callback:(fun () ->
doAction (fun ri _ ->
Recon.setDirection ri `Replica1ToReplica2 `Prefer))
"Resolve Conflicts in Favor of First Root");
grAdd grAction
(actionMenu#add_item
~callback:(fun () ->
doAction (fun ri _ ->
Recon.setDirection ri `Replica2ToReplica1 `Prefer))
"Resolve Conflicts in Favor of Second Root");
grAdd grAction
(actionMenu#add_item
~callback:(fun () ->
doAction (fun ri _ ->
Recon.setDirection ri `Newer `Prefer))
"Resolve Conflicts in Favor of Most Recently Modified");
grAdd grAction
(actionMenu#add_item
~callback:(fun () ->
doAction (fun ri _ ->
Recon.setDirection ri `Older `Prefer))
"Resolve Conflicts in Favor of Least Recently Modified");
ignore (actionMenu#add_separator ());
grAdd grAction
(actionMenu#add_item
~callback:(fun () ->
doAction (fun ri _ -> Recon.setDirection ri `Newer `Force))
"Force Newer Files to Replace Older Ones");
grAdd grAction
(actionMenu#add_item
~callback:(fun () ->
doAction (fun ri _ -> Recon.setDirection ri `Older `Force))
"Force Older Files to Replace Newer Ones");
ignore (actionMenu#add_separator ());
grAdd grAction
(actionMenu#add_item
~callback:(fun () ->
doAction (fun ri _ -> Recon.revertToDefaultDirection ri))
"_Revert to Unison's Recommendations");
grAdd grAction
(actionMenu#add_item
~callback:(fun () ->
doAction (fun ri _ -> Recon.setDirection ri `Merge `Force))
"Revert to the Merging Default, if Available");
(* Diff *)
ignore (actionMenu#add_separator ());
grAdd grDiff (actionMenu#add_image_item ~key:GdkKeysyms._d ~callback:diffCmd
~image:((GMisc.image ~stock:`DIALOG_INFO ~icon_size:`MENU ())#coerce)
"Show _Diffs");
(* Details *)
grAdd grDetail
(actionMenu#add_image_item ~key:GdkKeysyms._i ~callback:showDetCommand
~image:((GMisc.image ~stock:`INFO ~icon_size:`MENU ())#coerce)
"Detailed _Information")
in
buildActionMenu true;
(*********************************************************************
Synchronization menu
*********************************************************************)
grAdd grGo
(fileMenu#add_image_item ~key:GdkKeysyms._g
~image:(GMisc.image ~stock:`EXECUTE ~icon_size:`MENU () :> GObj.widget)
~callback:(fun () -> getLock synchronize)
"_Go");
grAdd grRescan
(fileMenu#add_image_item ~key:GdkKeysyms._r
~image:(GMisc.image ~stock:`REFRESH ~icon_size:`MENU () :> GObj.widget)
~callback:(fun () -> reloadProfile(); detectCmd())
"_Rescan");
grAdd grRescan
(fileMenu#add_item ~key:GdkKeysyms._a
~callback:(fun () ->
reloadProfile();
Prefs.set Globals.batch true;
detectCmd())
"_Detect Updates and Proceed (Without Waiting)");
grAdd grRescan
(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 diff -> isConflict diff.direction 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.path1) failedindices in
debug (fun()-> Util.msg "Rescaning with paths = %s\n"
(String.concat ", " (Safelist.map
(fun p -> "'"^(Path.toString p)^"'")
failedpaths)));
let paths = Prefs.read Globals.paths in
let confirmBigDeletes = Prefs.read Globals.confirmBigDeletes in
Prefs.set Globals.paths failedpaths;
Prefs.set Globals.confirmBigDeletes false;
(* Modifying global paths does not play well with filesystem
monitoring, so we disable it. *)
unsynchronizedPaths := None;
detectCmd();
Prefs.set Globals.paths paths;
Prefs.set Globals.confirmBigDeletes confirmBigDeletes;
unsynchronizedPaths := None)
"Re_check Unsynchronized Items");
ignore (fileMenu#add_separator ());
grAdd grRescan
(fileMenu#add_image_item ~key:GdkKeysyms._p
~callback:(fun _ ->
match getProfile false with
None -> ()
| Some(p) -> clearMainWindow (); loadProfile p false; detectCmd ())
~image:(GMisc.image ~stock:`OPEN ~icon_size:`MENU () :> GObj.widget)
"Change _Profile...");
let fastProf name key =
grAdd grRescan
(fileMenu#add_item ~key:key
~callback:(fun _ ->
if System.file_exists (Prefs.profilePathname name) then begin
Trace.status ("Loading profile " ^ name);
loadProfile name false; 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 _ -> statWin#show ()) "Show _Statistics");
ignore (fileMenu#add_separator ());
let quit =
fileMenu#add_image_item
~key:GdkKeysyms._q ~callback:safeExit
~image:((GMisc.image ~stock:`QUIT ~icon_size:`MENU ())#coerce)
"_Quit"
in
quit#add_accelerator ~group:accel_group ~modi:[`CONTROL] GdkKeysyms._q;
(*********************************************************************
Expert menu
*********************************************************************)
if Prefs.read Uicommon.expert then begin
let (expertMenu, _) = add_submenu "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
*********************************************************************)
grDisactivateAll ();
updateFromProfile :=
(fun () ->
displayNewProfileLabel ();
setMainWindowColumnHeaders (Uicommon.roots2string ());
buildActionMenu false);
ignore (toplevelWindow#event#connect#delete ~callback:
(fun _ -> safeExit (); true));
toplevelWindow#show ();
fun () ->
!updateFromProfile ();
mainWindow#misc#grab_focus ();
detectCmd ()
(*********************************************************************
STARTUP
*********************************************************************)
let start _ =
begin try
(* Initialize the GTK library *)
ignore (GMain.Main.init ());
Util.warnPrinter :=
Some (fun msg -> warnBox ~parent:(toplevelWindow ()) "Warning" msg);
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 true;
Lwt_unix.sleep 0.05 >>= tick
in
ignore_result (tick ());
let detectCmd = createToplevelWindow() in
Uicommon.uiInit
fatalError
tryAgainOrQuit
displayWaitMessage
(fun () -> getProfile true)
getFirstRoot
getSecondRoot
termInteract;
scanProfiles();
detectCmd ();
(* Display the ui *)
(*JV: not useful, as Unison does not handle any signal
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 System.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.48.3/uigtk2.mli 000644 000766 000000 00000000222 12450317305 015742 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/uigtk2.mli *)
(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
module Body : Uicommon.UI
unison-2.48.3/uimac14/ 000755 000766 000000 00000000000 12467142516 015311 5 ustar 00bcpierce wheel 000000 000000 unison-2.48.3/uimacbridge.ml 000644 000766 000000 00000047372 12010741735 016660 0 ustar 00bcpierce wheel 000000 000000 (* 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 unsynchronizedPaths = ref None;;
let unisonDirectory() = System.fspathToPrintString 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 -> 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
| [root2;root1] -> Globals.setRawRoots [root1;root2]
| [root2;root1;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(System.file_exists f)
then (Printf.eprintf "Profile %s does not exist"
(System.fspathToPrintString 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();
unsynchronizedPaths := None;
(* 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(System.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 *)
Recon.checkThatPreferredRootIsValid();
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"
);
Lwt_unix.run
(Uicommon.validateAndFixupPrefs () >>=
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 ~wantWatcher:() !unsynchronizedPaths 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;
unsynchronizedPaths :=
Some (List.map (fun ri -> ri.path1) reconItemList, []);
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.path1) ^ "\n" ^ s
| _ -> (Path.toString ri.ri.path1) ^ "\n" ^ (Uicommon.details2string ri.ri " ");;
Callback.register "unisonRiToDetails" unisonRiToDetails;;
let unisonRiToPath ri = Path.toString ri.ri.path1;;
Callback.register "unisonRiToPath" unisonRiToPath;;
let rcToString rc =
match rc.status with
`Deleted -> "Deleted"
| `Modified -> "Modified"
| `PropsChanged -> "PropsChanged"
| `Created -> "Created"
| `Unchanged -> "";;
let unisonRiToLeft ri =
match ri.ri.replicas with
Problem _ -> ""
| Different diff -> rcToString diff.rc1;;
Callback.register "unisonRiToLeft" unisonRiToLeft;;
let unisonRiToRight ri =
match ri.ri.replicas with
Problem _ -> ""
| Different diff -> rcToString diff.rc2;;
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 diff -> direction2niceString diff.direction;;
Callback.register "unisonRiToDirection" unisonRiToDirection;;
let unisonRiSetLeft ri =
match ri.ri.replicas with
Problem _ -> ()
| Different diff -> diff.direction <- Replica2ToReplica1;;
Callback.register "unisonRiSetLeft" unisonRiSetLeft;;
let unisonRiSetRight ri =
match ri.ri.replicas with
Problem _ -> ()
| Different diff -> diff.direction <- Replica1ToReplica2;;
Callback.register "unisonRiSetRight" unisonRiSetRight;;
let unisonRiSetConflict ri =
match ri.ri.replicas with
Problem _ -> ()
| Different diff -> diff.direction <- Conflict;;
Callback.register "unisonRiSetConflict" unisonRiSetConflict;;
let unisonRiSetMerge ri =
match ri.ri.replicas with
Problem _ -> ()
| Different diff -> diff.direction <- 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 {direction = 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 failureList =
Array.fold_right
(fun si l ->
match si.whatHappened with
Some (Util.Failed err) ->
(si, [err], "transport failure") :: l
| _ ->
l)
!theState []
in
let failureCount = List.length failureList in
let failures =
if failureCount = 0 then [] else
[Printf.sprintf "%d failure%s"
failureCount (if failureCount = 1 then "" else "s")]
in
let partialList =
Array.fold_right
(fun si l ->
match si.whatHappened with
Some Util.Succeeded
when partiallyProblematic si.ri &&
not (problematic si.ri) ->
let errs =
match si.ri.replicas with
Different diff -> diff.errors1 @ diff.errors2
| _ -> assert false
in
(si, errs,
"partial transfer (errors during update detection)") :: l
| _ ->
l)
!theState []
in
let partialCount = List.length partialList in
let partials =
if partialCount = 0 then [] else
[Printf.sprintf "%d partially transferred" partialCount]
in
let skippedList =
Array.fold_right
(fun si l ->
match si.ri.replicas with
Problem err ->
(si, [err], "error during update detection") :: l
| Different diff when diff.direction = Conflict ->
(si, [],
if diff.default_direction = Conflict then
"conflict"
else "skipped") :: l
| _ ->
l)
!theState []
in
let skippedCount = List.length skippedList in
let skipped =
if skippedCount = 0 then [] else
[Printf.sprintf "%d skipped" skippedCount]
in
unsynchronizedPaths :=
Some (List.map (fun (si, _, _) -> si.ri.path1)
(failureList @ partialList @ skippedList),
[]);
Trace.status
(Printf.sprintf "Synchronization complete %s"
(String.concat ", " (failures @ partials @ skipped)));
end;;
Callback.register "unisonSynchronize" unisonSynchronize;;
let unisonIgnorePath si =
Uicommon.addIgnorePattern (Uicommon.ignorePath si.ri.path1);;
let unisonIgnoreExt si =
Uicommon.addIgnorePattern (Uicommon.ignoreExt si.ri.path1);;
let unisonIgnoreName si =
Uicommon.addIgnorePattern (Uicommon.ignoreName si.ri.path1);;
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.path1) 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 {default_direction = Conflict} -> true
| _ -> false;;
Callback.register "unisonRiIsConflict" unisonRiIsConflict;;
let unisonRiRevert ri =
match ri.ri.replicas with
| Different diff -> diff.direction <- diff.default_direction
| _ -> ();;
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.48.3/uimacbridgenew.ml 000644 000766 000000 00000070027 12356072107 017366 0 ustar 00bcpierce wheel 000000 000000 (* 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 bytesToTransfer : Uutil.Filesize.t;
mutable whatHappened : Util.confirmation option;
mutable statusMessage : string option };;
let theState = ref [| |];;
let unsynchronizedPaths = ref None;;
let unisonDirectory() = System.fspathToString 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 lastFrac = ref 0.;;
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
if v = 0. || abs_float (v -. !lastFrac) > 1. then begin
lastFrac := v;
displayGlobalProgress v
end;;
let initGlobalProgress b =
totalBytesToTransfer := b;
totalBytesTransferred := Uutil.Filesize.zero;
displayGlobalProgress 0.;;
(* 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";;
let displayStatus s = displayStatus (Unicode.protect s);;
(*
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 ignore (Thread.create tCode ()); ignore (Thread.create tCode ());
let tid = Thread.create tCode ()
in Thread.join tid;
;;
Callback.register "callbackThreadCreate" callbackThreadCreate;;
(* Defined in MyController.m; display the error message and exit *)
external displayFatalError : string -> unit = "fatalError";;
let fatalError message =
Trace.log (message ^ "\n");
displayFatalError message
(* Defined in MyController.m; display the warning and ask whether to
exit or proceed *)
external displayWarnPanel : string -> bool = "warnPanel";;
let setWarnPrinter() =
Util.warnPrinter :=
Some(fun s ->
Trace.log ("Warning: " ^ s ^ "\n");
if not (Prefs.read Globals.batch) then begin
if (displayWarnPanel s) then begin
Lwt_unix.run (Update.unlockArchives ());
exit Uicommon.fatalExit
end
end)
let doInOtherThread f =
Thread.create
(fun () ->
try
f ()
with
Util.Transient s | Util.Fatal s -> fatalError s
| exn -> fatalError (Uicommon.exn2string exn))
()
(* 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"; *)
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 = item.bytesToTransfer 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 oldstatus = item.statusMessage in
item.statusMessage <- Some newstatus;
showGlobalProgress bytes;
(* FIX: No status window in Mac version, see GTK version for how to do it *)
if oldstatus <> Some newstatus then 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 -> 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
| [root2;root1] -> Globals.setRawRoots [root1;root2]
| [root2;root1;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(System.file_exists f)
then (Printf.eprintf "Profile %s does not exist"
(System.fspathToPrintString f);
exit 1)
end;
!clprofile
;;
Callback.register "unisonInit0" unisonInit0;;
(* Utility function to tell the UI whether roots were set *)
let areRootsSet () =
match Globals.rawRoots() with
| [] -> false
| _ -> true
;;
Callback.register "areRootsSet" areRootsSet;;
(* Utility function to tell the UI whether -batch is set *)
let isBatchSet () =
Prefs.read Globals.batch
;;
Callback.register "isBatchSet" isBatchSet;;
(* 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. If the profileName is the empty
string, it means that only the roots were specified on the command
line *)
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();
unsynchronizedPaths := None;
if profileName <> "" then begin
(* 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(System.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())
end;
(* 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 *)
Recon.checkThatPreferredRootIsValid();
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 =
doInOtherThread
(fun () ->
let r = do_unisonInit1 profileName in
unisonInit1Complete r)
;;
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 commitUpdates () =
Trace.status "Updating synchronizer state";
let t = Trace.startTimer "Updating synchronizer state" in
Update.commitUpdates();
Trace.showTimer t
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"
);
(* Install the warning panel, hopefully it's not too late *)
setWarnPrinter();
Lwt_unix.run
(Uicommon.validateAndFixupPrefs () >>=
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 ~wantWatcher:() !unsynchronizedPaths in
Trace.showTimer t;
updates in
let reconcile updates = Recon.reconcileAll updates in
let (reconItemList, thereAreEqualUpdates, dangerousPaths) =
reconcile (findUpdates ()) in
if not !Update.foundArchives then commitUpdates ();
if reconItemList = [] then
if thereAreEqualUpdates then begin
if !Update.foundArchives then commitUpdates ();
Trace.status
"Replicas have been changed only in identical ways since last sync"
end 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;
bytesToTransfer = Uutil.Filesize.zero;
whatHappened = None; statusMessage = None })
reconItemList in
theState := Array.of_list stateItemList;
unsynchronizedPaths :=
Some (List.map (fun ri -> ri.path1) reconItemList, []);
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 () =
doInOtherThread
(fun () ->
let r = do_unisonInit2 () in
unisonInit2Complete r)
;;
Callback.register "unisonInit2" unisonInit2;;
let unisonRiToDetails ri =
Unicode.protect
(match ri.whatHappened with
Some (Util.Failed s) ->
Path.toString ri.ri.path1 ^ "\n" ^ s
| _ ->
Path.toString ri.ri.path1 ^ "\n" ^
Uicommon.details2string ri.ri " ");;
Callback.register "unisonRiToDetails" unisonRiToDetails;;
let unisonRiToPath ri = Unicode.protect (Path.toString ri.ri.path1);;
Callback.register "unisonRiToPath" unisonRiToPath;;
let rcToString rc =
match rc.status with
`Deleted -> "Deleted"
| `Modified -> "Modified"
| `PropsChanged -> "PropsChanged"
| `Created -> "Created"
| `Unchanged -> "";;
let unisonRiToLeft ri =
match ri.ri.replicas with
Problem _ -> ""
| Different {rc1 = rc} -> rcToString rc;;
Callback.register "unisonRiToLeft" unisonRiToLeft;;
let unisonRiToRight ri =
match ri.ri.replicas with
Problem _ -> ""
| Different {rc2 = rc} -> rcToString rc;;
Callback.register "unisonRiToRight" unisonRiToRight;;
let unisonRiToFileSize ri =
Uutil.Filesize.toFloat (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 diff -> direction2niceString diff.direction;;
Callback.register "unisonRiToDirection" unisonRiToDirection;;
let unisonRiSetLeft ri =
match ri.ri.replicas with
Problem _ -> ()
| Different diff -> diff.direction <- Replica2ToReplica1;;
Callback.register "unisonRiSetLeft" unisonRiSetLeft;;
let unisonRiSetRight ri =
match ri.ri.replicas with
Problem _ -> ()
| Different diff -> diff.direction <- Replica1ToReplica2;;
Callback.register "unisonRiSetRight" unisonRiSetRight;;
let unisonRiSetConflict ri =
match ri.ri.replicas with
Problem _ -> ()
| Different diff -> diff.direction <- Conflict "skip requested";;
Callback.register "unisonRiSetConflict" unisonRiSetConflict;;
let unisonRiSetMerge ri =
match ri.ri.replicas with
Problem _ -> ()
| Different diff -> diff.direction <- 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,_) -> Unicode.protect s
| (_,_,Different {direction = Conflict "files differed"}) -> ""
| (_,_,Problem _) -> ""
| (_,Some Util.Succeeded,_) -> "done"
| (_,Some (Util.Failed s),_) -> "FAILED";;
Callback.register "unisonRiToProgress" unisonRiToProgress;;
let unisonRiToBytesTransferred ri =
Uutil.Filesize.toFloat 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";;
let displayDiff title text =
displayDiff (Unicode.protect title) (Unicode.protect text);;
let displayDiffErr err = displayDiffErr (Unicode.protect err)
(* 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 {rc1 = {typ = `FILE; status = status1};
rc2 = {typ = `FILE; status = 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 =
match ri.replicas with
Problem _ ->
errprinter
"Can't diff files: there was a problem during update detection"
| Different
{rc1 = {typ = `FILE; status = status1; ui = ui1};
rc2 = {typ = `FILE; status = status2; ui = ui2}} ->
if filesAreDifferent status1 status2 then
(let (root1,root2) = Globals.roots() in
begin
try Files.diff root1 ri.path1 ui1 root2 ri.path2 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 ->
si.bytesTransferred <- Uutil.Filesize.zero;
let len =
if si.whatHappened = None then Common.riLength si.ri else
Uutil.Filesize.zero
in
si.bytesToTransfer <- len;
Uutil.Filesize.add l len)
Uutil.Filesize.zero !theState in
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 ->
let rem =
Uutil.Filesize.sub
theSI.bytesToTransfer theSI.bytesTransferred
in
if rem <> Uutil.Filesize.zero then
showProgress (Uutil.File.ofLine i) rem "done";
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;
commitUpdates ();
let failureList =
Array.fold_right
(fun si l ->
match si.whatHappened with
Some (Util.Failed err) ->
(si, [err], "transport failure") :: l
| _ ->
l)
!theState []
in
let failureCount = List.length failureList in
let failures =
if failureCount = 0 then [] else
[Printf.sprintf "%d failure%s"
failureCount (if failureCount = 1 then "" else "s")]
in
let partialList =
Array.fold_right
(fun si l ->
match si.whatHappened with
Some Util.Succeeded
when partiallyProblematic si.ri &&
not (problematic si.ri) ->
let errs =
match si.ri.replicas with
Different diff -> diff.errors1 @ diff.errors2
| _ -> assert false
in
(si, errs,
"partial transfer (errors during update detection)") :: l
| _ ->
l)
!theState []
in
let partialCount = List.length partialList in
let partials =
if partialCount = 0 then [] else
[Printf.sprintf "%d partially transferred" partialCount]
in
let skippedList =
Array.fold_right
(fun si l ->
match si.ri.replicas with
Problem err ->
(si, [err], "error during update detection") :: l
| Different diff when (isConflict diff.direction) ->
(si, [],
if (isConflict diff.default_direction) then
"conflict"
else "skipped") :: l
| _ ->
l)
!theState []
in
let skippedCount = List.length skippedList in
let skipped =
if skippedCount = 0 then [] else
[Printf.sprintf "%d skipped" skippedCount]
in
unsynchronizedPaths :=
Some (List.map (fun (si, _, _) -> si.ri.path1)
(failureList @ partialList @ skippedList),
[]);
Trace.status
(Printf.sprintf "Synchronization complete %s"
(String.concat ", " (failures @ partials @ skipped)));
initGlobalProgress Uutil.Filesize.dummy;
end;;
external syncComplete : unit -> unit = "syncComplete";;
(* Do this in another thread and return immedidately to free up main thread in cocoa *)
let unisonSynchronize () =
doInOtherThread
(fun () ->
do_unisonSynchronize ();
syncComplete ())
;;
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.path1) 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
Unicode.protect replica1;;
let unisonSecondRootString() =
let replica1, replica2 = roots2niceStrings 32 (Globals.roots()) in
Unicode.protect 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 {default_direction = Conflict "files differ"} -> 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 diff -> diff.direction <> diff.default_direction
| _ -> false;;
Callback.register "changedFromDefault" changedFromDefault;;
let unisonRiRevert ri =
match ri.ri.replicas with
| Different diff -> diff.direction <- diff.default_direction
| _ -> ();;
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"
(fun e -> Unicode.protect (unisonExnInfo e));;
unison-2.48.3/uimacnew/ 000755 000766 000000 00000000000 12467142517 015657 5 ustar 00bcpierce wheel 000000 000000 unison-2.48.3/uitext.ml 000644 000766 000000 00000077056 12450317305 015731 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/uitext.ml *)
(* Copyright 1999-2015, 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"
(try System.getenv "EMACS" <> "" with Not_found -> false)
"!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 supportSignals = Util.osType = `Unix || Util.isCygwin
let rawTerminal () =
match !cbreakMode with
None -> ()
| Some funs -> funs.System.rawTerminal ()
let defaultTerminal () =
match !cbreakMode with
None -> ()
| Some funs -> funs.System.defaultTerminal ()
let restoreTerminal() =
if supportSignals && not (Prefs.read dumbtty) then
Sys.set_signal Sys.sigcont Sys.Signal_default;
defaultTerminal ();
cbreakMode := None
let setupTerminal() =
if not (Prefs.read dumbtty) then
try
cbreakMode := Some (System.terminalStateFunctions ());
let suspend _ =
defaultTerminal ();
Sys.set_signal Sys.sigtstp Sys.Signal_default;
Unix.kill (Unix.getpid ()) Sys.sigtstp
in
let resume _ =
if supportSignals then
Sys.set_signal Sys.sigtstp (Sys.Signal_handle suspend);
rawTerminal ()
in
if supportSignals then
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 () =
match !cbreakMode with
None ->
let l = input_line stdin in
if l="" then "" else String.sub l 0 1
| Some funs ->
let input_char () =
(* We cannot used buffered I/Os under Windows, as character
'\r' is not passed through (probably due to the code that
turns \r\n into \n) *)
let s = String.create 1 in
let n = Unix.read Unix.stdin s 0 1 in
if n = 0 then raise End_of_file;
if s.[0] = '\003' then raise Sys.Break;
s.[0]
in
funs.System.startReading ();
let c = input_char () in
funs.System.stopReading ();
let c = if c='\n' || c = '\r' 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
let action = try Some (find a actions) with Not_found -> None in
match action with
Some action ->
action ()
| None ->
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 alwaysDisplayErrors prefix l =
List.iter
(fun err -> alwaysDisplay (Format.sprintf "%s%s\n" prefix err)) l
let alwaysDisplayDetails ri =
alwaysDisplay ((Uicommon.details2string ri " ") ^ "\n");
match ri.replicas with
Problem _ ->
()
| Different diff ->
alwaysDisplayErrors "[root 1]: " diff.errors1;
alwaysDisplayErrors "[root 2]: " diff.errors2
let displayDetails ri =
if not (Prefs.read silent) then alwaysDisplayDetails ri
let displayri ri =
let (r1, action, r2, path) = Uicommon.reconItem2stringList Path.empty ri in
let forced =
match ri.replicas with
Different diff -> diff.direction <> diff.default_direction
| Problem _ -> false
in
let (defaultAction, forcedAction) =
match action with
Uicommon.AError -> ("error", "error")
| Uicommon.ASkip _ -> ("<-?->", "<=?=>")
| Uicommon.ALtoR false -> ("---->", "====>")
| Uicommon.ALtoR true -> ("--?->", "==?=>")
| Uicommon.ARtoL false -> ("<----", "<====")
| Uicommon.ARtoL true -> ("<-?--", "<=?==")
| Uicommon.AMerge -> ("<-M->", "<=M=>")
in
let action = if forced then forcedAction else defaultAction in
let s = Format.sprintf "%s %s %s %s " r1 action r2 path in
match ri.replicas with
Problem _ ->
alwaysDisplay s
| Different {direction = d} when isConflict d ->
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 "
^ System.fspathToPrintString (Prefs.profilePathname n)
^ " and restart " ^ Uutil.myName ^ "\n") end;
let nukeIgnoredRis =
Safelist.filter (fun ri -> not (Globals.shouldIgnore ri.path1)) 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 = rc1; rc2 = rc2; direction = dir} as diff) ->
if Prefs.read Uicommon.auto && not (isConflict dir) 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 (isConflict dir) && 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 (isConflict dir) && 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.path1) rest
"this path"));
(["E"],
("permanently ignore files with this extension"),
(fun () ->
ignore (Uicommon.ignoreExt ri.path1) rest
"files with this extension"));
(["N"],
("permanently ignore paths ending with this name"),
(fun () ->
ignore (Uicommon.ignoreName ri.path1) rest
"files with this name"));
(["m"],
("merge the versions"),
(fun () ->
diff.direction <- Merge;
redisplayri();
next()));
(["d"],
("show differences"),
(fun () ->
newLine ();
Uicommon.showDiffs ri
(fun title text ->
try
let pager = System.getenv "PAGER" in
restoreTerminal ();
let out = System.open_process_out pager in
Printf.fprintf out "\n%s\n\n%s\n\n" title text;
let _ = System.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 () ->
if not (isConflict dir) then diff.direction <- Conflict "skip requested";
redisplayri();
next()));
([">";"."],
("propagate from " ^ descr),
(fun () ->
diff.direction <- Replica1ToReplica2;
redisplayri();
next()));
(["<";","],
("propagate from " ^ descl),
(fun () ->
diff.direction <- 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
type stateItem =
{ mutable ri : reconItem;
mutable bytesTransferred : Uutil.Filesize.t;
mutable bytesToTransfer : Uutil.Filesize.t }
let doTransport reconItemList =
let items =
Array.map
(fun ri ->
{ri = ri;
bytesTransferred = Uutil.Filesize.zero;
bytesToTransfer = Common.riLength ri})
(Array.of_list reconItemList)
in
let totalBytesTransferred = ref Uutil.Filesize.zero in
let totalBytesToTransfer =
ref
(Array.fold_left
(fun s item -> Uutil.Filesize.add item.bytesToTransfer s)
Uutil.Filesize.zero items)
in
let t0 = Unix.gettimeofday () in
let showProgress i bytes dbg =
let i = Uutil.File.toLine i in
let item = items.(i) in
item.bytesTransferred <- Uutil.Filesize.add item.bytesTransferred bytes;
totalBytesTransferred := Uutil.Filesize.add !totalBytesTransferred bytes;
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 fPartialPaths = ref [] in
let uiWrapper i item f =
Lwt.try_bind f
(fun () ->
if partiallyProblematic item.ri && not (problematic item.ri) then
fPartialPaths := item.ri.path1 :: !fPartialPaths;
Lwt.return ())
(fun e ->
match e with
Util.Transient s ->
let rem =
Uutil.Filesize.sub
item.bytesToTransfer item.bytesTransferred
in
if rem <> Uutil.Filesize.zero then
showProgress (Uutil.File.ofLine i) rem "done";
let m = "[" ^ (Path.toString item.ri.path1) ^ "]: " ^ s in
alwaysDisplay ("Failed " ^ m ^ "\n");
fFailedPaths := item.ri.path1 :: !fFailedPaths;
return ()
| _ ->
fail e) in
let im = Array.length items in
let rec loop i actions pRiThisRound =
if i < im then begin
let item = items.(i) in
let actions =
if pRiThisRound item.ri then
uiWrapper i item
(fun () -> Transport.transportItem item.ri
(Uutil.File.ofLine i) verifyMerge)
:: actions
else
actions
in
loop (i + 1) actions pRiThisRound
end else
actions
in
Lwt_unix.run
(let actions = loop 0 [] (fun ri -> not (Common.isDeletion ri)) in
Lwt_util.join actions);
Lwt_unix.run
(let actions = loop 0 [] Common.isDeletion in
Lwt_util.join actions);
Transport.logFinish ();
Uutil.setProgressPrinter (fun _ _ _ -> ());
Util.set_infos "";
(Safelist.rev !fFailedPaths, Safelist.rev !fPartialPaths)
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 * bool * (Path.t list)
(* anySkipped?, anyPartial?, 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, partialPaths) = doTransport newReconItemList in
let failures = Safelist.length failedPaths in
let partials = Safelist.length partialPaths 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, %s%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")
(if partials <> 0 then
Format.sprintf "%d partially transferred, " partials
else
"")
skipped
failures in
Trace.log (summary ^ "\n");
if skipped>0 then
Safelist.iter
(fun ri ->
match ri.replicas with
Problem r
| Different {rc1 = _; rc2 = _; direction = Conflict r; default_direction = _} ->
alwaysDisplayAndLog (Printf.sprintf " skipped: %s (%s)"
(Path.toString ri.path1) r)
| _ -> ())
newReconItemList;
if partials>0 then
Safelist.iter
(fun p ->
alwaysDisplayAndLog (" partially transferred: " ^ Path.toString p))
partialPaths;
if failures>0 then
Safelist.iter
(fun p -> alwaysDisplayAndLog (" failed: " ^ (Path.toString p)))
failedPaths;
(skipped > 0, partials > 0, failures > 0, failedPaths) in
if not !Update.foundArchives then Update.commitUpdates ();
if updatesToDo = 0 then begin
(* 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 !Update.foundArchives && Prefs.read Uicommon.repeat = "" then
Update.commitUpdates ();
display "No updates to propagate\n";
if skipped > 0 then begin
let summary =
Printf.sprintf
"Synchronization complete at %s (0 item transferred, %d skipped, 0 failed)"
(let tm = Util.localtime (Util.time()) in
Printf.sprintf "%02d:%02d:%02d"
tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec)
skipped in
Trace.log (summary ^ "\n");
Safelist.iter
(fun ri ->
match ri.replicas with
Problem r
| Different {rc1 = _; rc2 = _; direction = Conflict r; default_direction = _} ->
alwaysDisplayAndLog (Printf.sprintf " skipped: %s (%s)"
(Path.toString ri.path1) r)
| _ -> ())
newReconItemList
end;
(skipped > 0, false, 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 ?wantWatcher ?skipRecentFiles pathsOpt =
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);
debug (fun() -> Util.msg "temp: Globals.paths = %s\n"
(String.concat " "
(Safelist.map Path.toString (Prefs.read Globals.paths))));
let updates = Update.findUpdates ?wantWatcher pathsOpt in
Uutil.setUpdateStatusPrinter None;
Util.set_infos "";
let (reconItemList, anyEqualUpdates, dangerousPaths) =
Recon.reconcileAll ~allowPartial:true 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, anyPartial, anyFailures, failedPaths) =
interactAndPropagateChanges reconItemList in
let exitStatus = Uicommon.exitCode(anySkipped || anyPartial,anyFailures) in
(exitStatus, failedPaths)
end
(* ----------------- Filesystem watching mode ---------------- *)
let watchinterval = 1. (* Minimal interval between two synchronizations *)
let retrydelay = 5. (* Minimal delay to retry failed paths *)
let maxdelay = 30. *. 60. (* Maximal delay to retry failed paths *)
module PathMap = Map.Make (Path)
let waitForChangesRoot: Common.root -> unit -> unit Lwt.t =
Remote.registerRootCmd
"waitForChanges"
(fun (fspath, _) -> Fswatchold.wait (Update.archiveHash fspath))
let waitForChanges t =
let dt = t -. Unix.gettimeofday () in
if dt > 0. then begin
let timeout = if dt <= maxdelay then [Lwt_unix.sleep dt] else [] in
Lwt_unix.run
(Globals.allRootsMap (fun r -> Lwt.return (waitForChangesRoot r ()))
>>= fun l ->
Lwt.choose (timeout @ l))
end
let synchronizePathsFromFilesystemWatcher () =
let rec loop isStart delayInfo =
let t = Unix.gettimeofday () in
let (delayedPaths, readyPaths) =
PathMap.fold
(fun p (t', _) (delayed, ready) ->
if t' <= t then (delayed, p :: ready) else (p :: delayed, ready))
delayInfo ([], [])
in
let (exitStatus, failedPaths) =
synchronizeOnce ~wantWatcher:() ~skipRecentFiles:()
(if isStart then None else Some (readyPaths, delayedPaths))
in
(* After a failure, we retry at once, then use an exponential backoff *)
let delayInfo =
Safelist.fold_left
(fun newDelayInfo p ->
PathMap.add p
(try
let (t', d) = PathMap.find p delayInfo in
if t' > t then (t', d) else
let d = max retrydelay (min maxdelay (2. *. d)) in
(t +. d, d)
with Not_found ->
(t, 0.))
newDelayInfo)
PathMap.empty
(Safelist.append delayedPaths failedPaths)
in
Lwt_unix.run (Lwt_unix.sleep watchinterval);
let nextTime =
PathMap.fold (fun _ (t, d) t' -> min t t') delayInfo 1e20 in
waitForChanges nextTime;
loop false delayInfo
in
loop true PathMap.empty
(* ----------------- Repetition ---------------- *)
let synchronizeUntilNoFailures repeatMode =
let rec loop triesLeft pathsOpt =
let (exitStatus, failedPaths) =
synchronizeOnce
?wantWatcher:(if repeatMode then Some () else None) pathsOpt in
if failedPaths <> [] && triesLeft <> 0 then begin
loop (triesLeft - 1) (Some (failedPaths, []))
end else begin
exitStatus
end in
loop (Prefs.read Uicommon.retry) None
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(repeatinterval >= 0) 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
(* ----------------- Startup ---------------- *)
let handleException 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
let rec start interface =
if interface <> Uicommon.Text then
Util.msg "This Unison binary only provides the text GUI...\n";
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 () -> setWarnPrinter();
if Prefs.read silent then Prefs.set Trace.terse true;
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
Sys.Break -> begin
(* If we've been killed, then die *)
handleException Sys.Break;
exit Uicommon.fatalExit
end
| e -> begin
(* If any other bad thing happened and the -repeat preference is
set, then restart *)
(* JV: it seems safer to just abort here, as we don't know in which
state Unison is; for instance, if the connection is lost, there
is no point in restarting as Unison will currently not attempt to
establish a new connection. *)
handleException e;
if false (*Prefs.read Uicommon.repeat <> ""*) then begin
Util.msg "Restarting in 10 seconds...\n";
Unix.sleep 10;
start interface
end else
exit Uicommon.fatalExit
end
end
let defaultUi = Uicommon.Text
end
unison-2.48.3/uitext.mli 000644 000766 000000 00000000222 12450317305 016057 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/uitext.mli *)
(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
module Body : Uicommon.UI
unison-2.48.3/unicode.ml 000644 000766 000000 00000206211 12450317305 016020 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/unicode.ml *)
(* Copyright 1999-2015, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
*)
open Unicode_tables
exception Invalid
let fail () = raise Invalid
let get s i = Char.code (String.unsafe_get s i)
let set s i v = String.unsafe_set s i (Char.unsafe_chr v)
(****)
let rec decode_char s i l =
if i = l then fail () else
let c = get s i in
if c < 0x80 then
cont s (i + 1) l c
else if c < 0xE0 then begin
(* 80 - 7FF *)
if c < 0xc2 || i + 1 >= l then fail () else
let c1 = get s (i + 1) in
if c1 land 0xc0 <> 0x80 then fail () else
let v = c lsl 6 + c1 - 0x3080 in
cont s (i + 2) l v
end else if c < 0xF0 then begin
(* 800 - FFFF *)
if i + 2 >= l then fail () else
let c1 = get s (i + 1) in
let c2 = get s (i + 2) in
if (c1 lor c2) land 0xc0 <> 0x80 then fail () else
let v = c lsl 12 + c1 lsl 6 + c2 - 0xe2080 in
if v < 0x800 then fail () else
cont s (i + 3) l v
end else begin
(* 10000 - 10FFFF *)
if i + 3 >= l then fail () else
let c1 = get s (i + 1) in
let c2 = get s (i + 2) in
let c3 = get s (i + 3) in
if (c1 lor c2 lor c3) land 0xc0 <> 0x80 then fail () else
let v = c lsl 18 + c1 lsl 12 + c2 lsl 6 + c3 - 0x03c82080 in
if v < 0x10000 || v > 0x10ffff then fail () else
cont s (i + 4) l v
end
and cont s i l v = (v, i)
let encode_char s i l c =
if c < 0x80 then begin
if i >= l then fail () else begin
set s i c;
i + 1
end
end else if c < 0x800 then begin
if i + 1 >= l then fail () else begin
set s i (c lsr 6 + 0xC0);
set s (i + 1) (c land 0x3f + 0x80);
i + 2
end
end else if c < 0x10000 then begin
if i + 1 >= l then fail () else begin
set s i (c lsr 12 + 0xE0);
set s (i + 1) ((c lsr 6) land 0x3f + 0x80);
set s (i + 2) (c land 0x3f + 0x80);
i + 3
end
end else begin
if i + 1 >= l then fail () else begin
set s i (c lsr 18 + 0xF0);
set s (i + 1) ((c lsr 12) land 0x3f + 0x80);
set s (i + 2) ((c lsr 6) land 0x3f + 0x80);
set s (i + 3) (c land 0x3f + 0x80);
i + 4
end
end
let rec prev_char s i =
let i = i - 1 in
if i < 0 then fail () else
if (get s i) land 0xc0 <> 0x80 then i else prev_char s i
(****)
let combining_property_bitmap = "\
\x00\x00\x00\x01\x02\x03\x04\x05\
\x00\x06\x07\x08\x09\x0A\x0B\x0C\
\x0D\x00\x00\x00\x00\x00\x00\x0E\
\x0F\x10\x00\x00\x00\x00\x00\x00\
\x11\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x12\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x13\x00\x00\x14\x00\
\xE6\xE6\xE6\xE6\xE6\xE6\xE6\xE6\
\xE6\xE6\xE6\xE6\xE6\xE6\xE6\xE6\
\xE6\xE6\xE6\xE6\xE6\xE8\xDC\xDC\
\xDC\xDC\xE8\xD8\xDC\xDC\xDC\xDC\
\xDC\xCA\xCA\xDC\xDC\xDC\xDC\xCA\
\xCA\xDC\xDC\xDC\xDC\xDC\xDC\xDC\
\xDC\xDC\xDC\xDC\x01\x01\x01\x01\
\x01\xDC\xDC\xDC\xDC\xE6\xE6\xE6\
\xE6\xE6\xE6\xE6\xE6\xF0\xE6\xDC\
\xDC\xDC\xE6\xE6\xE6\xDC\xDC\x00\
\xE6\xE6\xE6\xDC\xDC\xDC\xDC\xE6\
\x00\x00\x00\x00\x00\xEA\xEA\xE9\
\xEA\xEA\xE9\xE6\xE6\xE6\xE6\xE6\
\xE6\xE6\xE6\xE6\xE6\xE6\xE6\xE6\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\xE6\xE6\xE6\xE6\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\xDC\xE6\xE6\xE6\xE6\xDC\xE6\
\xE6\xE6\xDE\xDC\xE6\xE6\xE6\xE6\
\xE6\xE6\x00\xDC\xDC\xDC\xDC\xDC\
\xE6\xE6\xDC\xE6\xE6\xDE\xE4\xE6\
\x0A\x0B\x0C\x0D\x0E\x0F\x10\x11\
\x12\x13\x00\x14\x15\x16\x00\x17\
\x00\x18\x19\x00\xE6\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\xE6\xE6\xE6\xE6\xE6\xE6\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x1B\x1C\x1D\x1E\x1F\
\x20\x21\x22\xE6\xE6\xDC\xDC\xE6\
\xE6\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x23\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\xE6\xE6\
\xE6\xE6\xE6\xE6\xE6\x00\x00\xE6\
\xE6\xE6\xE6\xDC\xE6\x00\x00\xE6\
\xE6\x00\xDC\xE6\xE6\xDC\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x24\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\xE6\xDC\xE6\xE6\xDC\xE6\xE6\xDC\
\xDC\xDC\xE6\xDC\xDC\xE6\xDC\xE6\
\xE6\xE6\xDC\xE6\xDC\xE6\xDC\xE6\
\xDC\xE6\xE6\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x07\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x09\x00\x00\
\x00\xE6\xDC\xE6\xE6\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x07\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x09\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x07\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x09\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x07\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x09\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x07\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x09\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x09\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x09\x00\x00\
\x00\x00\x00\x00\x00\x54\x5B\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x07\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x09\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x09\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x09\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x67\x67\x09\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x6B\x6B\x6B\x6B\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x76\x76\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x7A\x7A\x7A\x7A\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\xDC\xDC\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\xDC\x00\xDC\
\x00\xD8\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x81\x82\x00\x84\x00\x00\x00\
\x00\x00\x82\x82\x82\x82\x00\x00\
\x82\x00\xE6\xE6\x09\x00\xE6\xE6\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\xDC\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x07\
\x00\x09\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x09\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x09\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x09\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\xE6\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\xE4\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\xDE\xE6\xDC\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\xE6\xE6\x01\x01\xE6\xE6\xE6\xE6\
\x01\x01\x01\xE6\xE6\x00\x00\x00\
\x00\xE6\x00\x00\x00\x01\x01\xE6\
\xDC\xE6\x01\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\xDA\xE4\xE8\xDE\xE0\xE0\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x08\x08\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x1A\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\xE6\xE6\xE6\xE6\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00"
let combining_class c =
if c > 0xffff then 0 else
let v = get combining_property_bitmap (c lsr 8) in
if v = 0 then 0 else
get combining_property_bitmap (v lsl 8 + c land 0xff)
let rec find_loc s i l p =
if i = 0 then i else
let i' = prev_char s i in
let (v, _) = decode_char s i' l in
let p' = combining_class v in
if p' <= p then i else
find_loc s i' l p
let rec scan s i l p =
if i < l then begin
let c = get s i in
if c < 0x80 then
scan s (i + 1) l 0
else if c < 0xE0 then begin
(* 80 - 7FF *)
if i + 1 >= l then fail () else
let c1 = get s (i + 1) in
let v = c lsl 6 + c1 - 0x3080 in
cont s i l (i + 2) p v
end else if c < 0xF0 then begin
(* 800 - FFFF *)
if i + 2 >= l then fail () else
let c1 = get s (i + 1) in
let c2 = get s (i + 2) in
let v = c lsl 12 + c1 lsl 6 + c2 - 0xe2080 in
cont s i l (i + 3) p v
end else begin
(* 10000 - 10FFFF *)
if i + 3 >= l then fail () else
scan s (i + 4) l 0
end
end
and cont s i l j p v =
let p' = combining_class v in
if p' = 0 || p <= p' then
scan s j l p'
else begin
(* move char to the right location *)
let k = find_loc s i l p' in
let d = j - i in
let s' = String.sub s i d in
String.blit s k s (k + d) (i - k);
String.blit s' 0 s k d;
scan s j l p
end
let order s =
scan s 0 (String.length s) 0
(****)
let hangul_sbase = 0xAC00
let hangul_lbase = 0x1100
let hangul_vbase = 0x1161
let hangul_tbase = 0x11A7
let hangul_scount = 11172
let hangul_lcount = 19
let hangul_vcount = 21
let hangul_tcount = 28
let hangul_ncount = hangul_vcount * hangul_tcount
let set_char_3 s i c =
set s i (c lsr 12 + 0xE0);
set s (i + 1) ((c lsr 6) land 0x3f + 0x80);
set s (i + 2) (c land 0x3f + 0x80)
let rec norm s i l s' j =
if i < l then begin
let c = get s i in
if c < 0x80 then begin
set s' j (get norm_ascii c);
norm s (i + 1) l s' (j + 1)
end else if c < 0xE0 then begin
(* 80 - 7FF *)
if c < 0xc2 || i + 1 >= l then raise Invalid;
let c1 = get s (i + 1) in
if c1 land 0xc0 <> 0x80 then raise Invalid;
let idx = get norm_prim (c - 0xc0) in
let idx = idx lsl 6 + c1 - 0x80 in
let k = get norm_second_high idx in
if k = 0 then begin
set s' j c;
set s' (j + 1) c1;
norm s (i + 2) l s' (j + 2)
end else begin
let k = (k - 2) lsl 8 + get norm_second_low idx in
let n = get norm_repl k in
String.blit norm_repl (k + 1) s' j n;
norm s (i + 2) l s' (j + n)
end
end else if c < 0xF0 then begin
(* 800 - FFFF *)
if i + 2 >= l then raise Invalid;
let c1 = get s (i + 1) in
if c1 land 0xc0 <> 0x80 then raise Invalid;
let idx = c lsl 6 + c1 - 0x3880 in
if idx < 0x20 then raise Invalid;
let c2 = get s (i + 2) in
if c2 land 0xc0 <> 0x80 then raise Invalid;
let idx = get norm_prim idx in
let idx = idx lsl 6 + c2 - 0x80 in
let k = get norm_second_high idx in
if k = 0 then begin
set s' j c;
set s' (j + 1) c1;
set s' (j + 2) c2;
norm s (i + 3) l s' (j + 3)
end else if k = 1 then begin
let v = c lsl 12 + c1 lsl 6 + c2 - (0x000E2080 + hangul_sbase) in
if v >= hangul_scount then begin
set s' j c;
set s' (j + 1) c1;
set s' (j + 2) c2;
norm s (i + 3) l s' (j + 3)
end else begin
set_char_3 s' j (v / hangul_ncount + hangul_lbase);
set_char_3 s' (j + 3)
((v mod hangul_ncount) / hangul_tcount + hangul_vbase);
if v mod hangul_tcount = 0 then
norm s (i + 3) l s' (j + 6)
else begin
set_char_3 s' (j + 6) ((v mod hangul_tcount) + hangul_tbase);
norm s (i + 3) l s' (j + 9)
end
end
end else begin
let k = (k - 2) lsl 8 + get norm_second_low idx in
let n = get norm_repl k in
String.blit norm_repl (k + 1) s' j n;
norm s (i + 3) l s' (j + n)
end
end else begin
(* 10000 - 10FFFF *)
if i + 3 >= l then raise Invalid;
let c1 = get s (i + 1) in
let c2 = get s (i + 2) in
let c3 = get s (i + 3) in
if (c1 lor c2 lor c3) land 0xc0 <> 0x80 then raise Invalid;
let v = c lsl 18 + c1 lsl 12 + c2 lsl 6 + c3 - 0x03c82080 in
if v < 0x10000 || v > 0x10ffff then raise Invalid;
set s' j c;
set s' (j + 1) c1;
set s' (j + 2) c2;
set s' (j + 3) c3;
norm s (i + 4) l s' (j + 4)
end
end else
String.sub s' 0 j
let normalize s =
let l = String.length s in
let s' = String.create (3 * l) in
try
let s' = norm s 0 l s' 0 in order s'; s'
with Invalid ->
(* We need a comparison function which is coherent (transitive)
also with non-unicode strings. The optimization below assumes
a case-insensitive comparison on ASCII characters, thus we
translate the string to lowercase *)
String.lowercase s
(****)
let rec decomp s i l s' j =
if i < l then begin
let c = get s i in
if c < 0x80 then begin
set s' j (get decomp_ascii c);
decomp s (i + 1) l s' (j + 1)
end else if c < 0xE0 then begin
(* 80 - 7FF *)
if c < 0xc2 || i + 1 >= l then raise Invalid;
let c1 = get s (i + 1) in
if c1 land 0xc0 <> 0x80 then raise Invalid;
let idx = get decomp_prim (c - 0xc0) in
let idx = idx lsl 6 + c1 - 0x80 in
let k = get decomp_second_high idx in
if k = 0 then begin
set s' j c;
set s' (j + 1) c1;
decomp s (i + 2) l s' (j + 2)
end else begin
let k = (k - 2) lsl 8 + get decomp_second_low idx in
let n = get decomp_repl k in
String.blit decomp_repl (k + 1) s' j n;
decomp s (i + 2) l s' (j + n)
end
end else if c < 0xF0 then begin
(* 800 - FFFF *)
if i + 2 >= l then raise Invalid;
let c1 = get s (i + 1) in
if c1 land 0xc0 <> 0x80 then raise Invalid;
let idx = c lsl 6 + c1 - 0x3880 in
if idx < 0x20 then raise Invalid;
let c2 = get s (i + 2) in
if c2 land 0xc0 <> 0x80 then raise Invalid;
let idx = get decomp_prim idx in
let idx = idx lsl 6 + c2 - 0x80 in
let k = get decomp_second_high idx in
if k = 0 then begin
set s' j c;
set s' (j + 1) c1;
set s' (j + 2) c2;
decomp s (i + 3) l s' (j + 3)
end else if k = 1 then begin
let v = c lsl 12 + c1 lsl 6 + c2 - (0x000E2080 + hangul_sbase) in
if v >= hangul_scount then begin
set s' j c;
set s' (j + 1) c1;
set s' (j + 2) c2;
decomp s (i + 3) l s' (j + 3)
end else begin
set_char_3 s' j (v / hangul_ncount + hangul_lbase);
set_char_3 s' (j + 3)
((v mod hangul_ncount) / hangul_tcount + hangul_vbase);
if v mod hangul_tcount = 0 then
decomp s (i + 3) l s' (j + 6)
else begin
set_char_3 s' (j + 6) ((v mod hangul_tcount) + hangul_tbase);
decomp s (i + 3) l s' (j + 9)
end
end
end else begin
let k = (k - 2) lsl 8 + get decomp_second_low idx in
let n = get decomp_repl k in
String.blit decomp_repl (k + 1) s' j n;
decomp s (i + 3) l s' (j + n)
end
end else begin
(* 10000 - 10FFFF *)
if i + 3 >= l then raise Invalid;
let c1 = get s (i + 1) in
let c2 = get s (i + 2) in
let c3 = get s (i + 3) in
if (c1 lor c2 lor c3) land 0xc0 <> 0x80 then raise Invalid;
let v = c lsl 18 + c1 lsl 12 + c2 lsl 6 + c3 - 0x03c82080 in
if v < 0x10000 || v > 0x10ffff then raise Invalid;
set s' j c;
set s' (j + 1) c1;
set s' (j + 2) c2;
set s' (j + 3) c3;
decomp s (i + 4) l s' (j + 4)
end
end else
String.sub s' 0 j
let decompose s =
let l = String.length s in
let s' = String.create (3 * l) in
try
let s' = decomp s 0 l s' 0 in order s'; s'
with Invalid ->
s
(****)
let rec compare_rec s s' i l =
if i = l then begin
if l < String.length s then 1 else
if l < String.length s' then -1 else
0
end else begin
let c = get s i in
let c' = get s' i in
if c < 0x80 && c' < 0x80 then begin
let v = compare (get norm_ascii c) (get norm_ascii c') in
if v <> 0 then v else compare_rec s s' (i + 1) l
end else
compare (normalize s) (normalize s')
end
let case_insensitive_compare s s' =
compare_rec s s' 0 (min (String.length s) (String.length s'))
(****)
let rec compare_cs_rec s s' i l =
if i = l then begin
if l < String.length s then 1 else
if l < String.length s' then -1 else
0
end else begin
let c = get s i in
let c' = get s' i in
if c < 0x80 && c' < 0x80 then begin
let v = compare c c' in
if v <> 0 then v else compare_cs_rec s s' (i + 1) l
end else
compare (decompose s) (decompose s')
end
let case_sensitive_compare s s' =
compare_cs_rec s s' 0 (min (String.length s) (String.length s'))
(****)
let uniCharPrecompSourceTable = [|
0x00000300; 0x00540000; 0x00000301; 0x00750054;
0x00000302; 0x002000C9; 0x00000303; 0x001C00E9;
0x00000304; 0x002C0105; 0x00000306; 0x00200131;
0x00000307; 0x002E0151; 0x00000308; 0x0036017F;
0x00000309; 0x001801B5; 0x0000030A; 0x000601CD;
0x0000030B; 0x000601D3; 0x0000030C; 0x002501D9;
0x0000030F; 0x000E01FE; 0x00000311; 0x000C020C;
0x00000313; 0x000E0218; 0x00000314; 0x00100226;
0x0000031B; 0x00040236; 0x00000323; 0x002A023A;
0x00000324; 0x00020264; 0x00000325; 0x00020266;
0x00000326; 0x00040268; 0x00000327; 0x0016026C;
0x00000328; 0x000A0282; 0x0000032D; 0x000C028C;
0x0000032E; 0x00020298; 0x00000330; 0x0006029A;
0x00000331; 0x001102A0; 0x00000338; 0x002C02B1;
0x00000342; 0x001D02DD; 0x00000345; 0x003F02FA;
0x00000653; 0x00010339; 0x00000654; 0x0006033A;
0x00000655; 0x00010340; 0x0000093C; 0x00030341;
0x000009BE; 0x00010344; 0x000009D7; 0x00010345;
0x00000B3E; 0x00010346; 0x00000B56; 0x00010347;
0x00000B57; 0x00010348; 0x00000BBE; 0x00020349;
0x00000BD7; 0x0002034B; 0x00000C56; 0x0001034D;
0x00000CC2; 0x0001034E; 0x00000CD5; 0x0003034F;
0x00000CD6; 0x00010352; 0x00000D3E; 0x00020353;
0x00000D57; 0x00010355; 0x00000DCA; 0x00020356;
0x00000DCF; 0x00010358; 0x00000DDF; 0x00010359;
0x0000102E; 0x0001035A; 0x00003099; 0x0030035B;
0x0000309A; 0x000A038B
|]
let uniCharBMPPrecompDestinationTable = [|
0x0041; 0x00C0; 0x0045; 0x00C8; 0x0049; 0x00CC; 0x004E; 0x01F8;
0x004F; 0x00D2; 0x0055; 0x00D9; 0x0057; 0x1E80; 0x0059; 0x1EF2;
0x0061; 0x00E0; 0x0065; 0x00E8; 0x0069; 0x00EC; 0x006E; 0x01F9;
0x006F; 0x00F2; 0x0075; 0x00F9; 0x0077; 0x1E81; 0x0079; 0x1EF3;
0x00A8; 0x1FED; 0x00C2; 0x1EA6; 0x00CA; 0x1EC0; 0x00D4; 0x1ED2;
0x00DC; 0x01DB; 0x00E2; 0x1EA7; 0x00EA; 0x1EC1; 0x00F4; 0x1ED3;
0x00FC; 0x01DC; 0x0102; 0x1EB0; 0x0103; 0x1EB1; 0x0112; 0x1E14;
0x0113; 0x1E15; 0x014C; 0x1E50; 0x014D; 0x1E51; 0x01A0; 0x1EDC;
0x01A1; 0x1EDD; 0x01AF; 0x1EEA; 0x01B0; 0x1EEB; 0x0391; 0x1FBA;
0x0395; 0x1FC8; 0x0397; 0x1FCA; 0x0399; 0x1FDA; 0x039F; 0x1FF8;
0x03A5; 0x1FEA; 0x03A9; 0x1FFA; 0x03B1; 0x1F70; 0x03B5; 0x1F72;
0x03B7; 0x1F74; 0x03B9; 0x1F76; 0x03BF; 0x1F78; 0x03C5; 0x1F7A;
0x03C9; 0x1F7C; 0x03CA; 0x1FD2; 0x03CB; 0x1FE2; 0x0415; 0x0400;
0x0418; 0x040D; 0x0435; 0x0450; 0x0438; 0x045D; 0x1F00; 0x1F02;
0x1F01; 0x1F03; 0x1F08; 0x1F0A; 0x1F09; 0x1F0B; 0x1F10; 0x1F12;
0x1F11; 0x1F13; 0x1F18; 0x1F1A; 0x1F19; 0x1F1B; 0x1F20; 0x1F22;
0x1F21; 0x1F23; 0x1F28; 0x1F2A; 0x1F29; 0x1F2B; 0x1F30; 0x1F32;
0x1F31; 0x1F33; 0x1F38; 0x1F3A; 0x1F39; 0x1F3B; 0x1F40; 0x1F42;
0x1F41; 0x1F43; 0x1F48; 0x1F4A; 0x1F49; 0x1F4B; 0x1F50; 0x1F52;
0x1F51; 0x1F53; 0x1F59; 0x1F5B; 0x1F60; 0x1F62; 0x1F61; 0x1F63;
0x1F68; 0x1F6A; 0x1F69; 0x1F6B; 0x1FBF; 0x1FCD; 0x1FFE; 0x1FDD;
0x0041; 0x00C1; 0x0043; 0x0106; 0x0045; 0x00C9; 0x0047; 0x01F4;
0x0049; 0x00CD; 0x004B; 0x1E30; 0x004C; 0x0139; 0x004D; 0x1E3E;
0x004E; 0x0143; 0x004F; 0x00D3; 0x0050; 0x1E54; 0x0052; 0x0154;
0x0053; 0x015A; 0x0055; 0x00DA; 0x0057; 0x1E82; 0x0059; 0x00DD;
0x005A; 0x0179; 0x0061; 0x00E1; 0x0063; 0x0107; 0x0065; 0x00E9;
0x0067; 0x01F5; 0x0069; 0x00ED; 0x006B; 0x1E31; 0x006C; 0x013A;
0x006D; 0x1E3F; 0x006E; 0x0144; 0x006F; 0x00F3; 0x0070; 0x1E55;
0x0072; 0x0155; 0x0073; 0x015B; 0x0075; 0x00FA; 0x0077; 0x1E83;
0x0079; 0x00FD; 0x007A; 0x017A; 0x00A8; 0x0385; 0x00C2; 0x1EA4;
0x00C5; 0x01FA; 0x00C6; 0x01FC; 0x00C7; 0x1E08; 0x00CA; 0x1EBE;
0x00CF; 0x1E2E; 0x00D4; 0x1ED0; 0x00D5; 0x1E4C; 0x00D8; 0x01FE;
0x00DC; 0x01D7; 0x00E2; 0x1EA5; 0x00E5; 0x01FB; 0x00E6; 0x01FD;
0x00E7; 0x1E09; 0x00EA; 0x1EBF; 0x00EF; 0x1E2F; 0x00F4; 0x1ED1;
0x00F5; 0x1E4D; 0x00F8; 0x01FF; 0x00FC; 0x01D8; 0x0102; 0x1EAE;
0x0103; 0x1EAF; 0x0112; 0x1E16; 0x0113; 0x1E17; 0x014C; 0x1E52;
0x014D; 0x1E53; 0x0168; 0x1E78; 0x0169; 0x1E79; 0x01A0; 0x1EDA;
0x01A1; 0x1EDB; 0x01AF; 0x1EE8; 0x01B0; 0x1EE9; 0x0391; 0x0386;
0x0395; 0x0388; 0x0397; 0x0389; 0x0399; 0x038A; 0x039F; 0x038C;
0x03A5; 0x038E; 0x03A9; 0x038F; 0x03B1; 0x03AC; 0x03B5; 0x03AD;
0x03B7; 0x03AE; 0x03B9; 0x03AF; 0x03BF; 0x03CC; 0x03C5; 0x03CD;
0x03C9; 0x03CE; 0x03CA; 0x0390; 0x03CB; 0x03B0; 0x03D2; 0x03D3;
0x0413; 0x0403; 0x041A; 0x040C; 0x0433; 0x0453; 0x043A; 0x045C;
0x1F00; 0x1F04; 0x1F01; 0x1F05; 0x1F08; 0x1F0C; 0x1F09; 0x1F0D;
0x1F10; 0x1F14; 0x1F11; 0x1F15; 0x1F18; 0x1F1C; 0x1F19; 0x1F1D;
0x1F20; 0x1F24; 0x1F21; 0x1F25; 0x1F28; 0x1F2C; 0x1F29; 0x1F2D;
0x1F30; 0x1F34; 0x1F31; 0x1F35; 0x1F38; 0x1F3C; 0x1F39; 0x1F3D;
0x1F40; 0x1F44; 0x1F41; 0x1F45; 0x1F48; 0x1F4C; 0x1F49; 0x1F4D;
0x1F50; 0x1F54; 0x1F51; 0x1F55; 0x1F59; 0x1F5D; 0x1F60; 0x1F64;
0x1F61; 0x1F65; 0x1F68; 0x1F6C; 0x1F69; 0x1F6D; 0x1FBF; 0x1FCE;
0x1FFE; 0x1FDE; 0x0041; 0x00C2; 0x0043; 0x0108; 0x0045; 0x00CA;
0x0047; 0x011C; 0x0048; 0x0124; 0x0049; 0x00CE; 0x004A; 0x0134;
0x004F; 0x00D4; 0x0053; 0x015C; 0x0055; 0x00DB; 0x0057; 0x0174;
0x0059; 0x0176; 0x005A; 0x1E90; 0x0061; 0x00E2; 0x0063; 0x0109;
0x0065; 0x00EA; 0x0067; 0x011D; 0x0068; 0x0125; 0x0069; 0x00EE;
0x006A; 0x0135; 0x006F; 0x00F4; 0x0073; 0x015D; 0x0075; 0x00FB;
0x0077; 0x0175; 0x0079; 0x0177; 0x007A; 0x1E91; 0x1EA0; 0x1EAC;
0x1EA1; 0x1EAD; 0x1EB8; 0x1EC6; 0x1EB9; 0x1EC7; 0x1ECC; 0x1ED8;
0x1ECD; 0x1ED9; 0x0041; 0x00C3; 0x0045; 0x1EBC; 0x0049; 0x0128;
0x004E; 0x00D1; 0x004F; 0x00D5; 0x0055; 0x0168; 0x0056; 0x1E7C;
0x0059; 0x1EF8; 0x0061; 0x00E3; 0x0065; 0x1EBD; 0x0069; 0x0129;
0x006E; 0x00F1; 0x006F; 0x00F5; 0x0075; 0x0169; 0x0076; 0x1E7D;
0x0079; 0x1EF9; 0x00C2; 0x1EAA; 0x00CA; 0x1EC4; 0x00D4; 0x1ED6;
0x00E2; 0x1EAB; 0x00EA; 0x1EC5; 0x00F4; 0x1ED7; 0x0102; 0x1EB4;
0x0103; 0x1EB5; 0x01A0; 0x1EE0; 0x01A1; 0x1EE1; 0x01AF; 0x1EEE;
0x01B0; 0x1EEF; 0x0041; 0x0100; 0x0045; 0x0112; 0x0047; 0x1E20;
0x0049; 0x012A; 0x004F; 0x014C; 0x0055; 0x016A; 0x0059; 0x0232;
0x0061; 0x0101; 0x0065; 0x0113; 0x0067; 0x1E21; 0x0069; 0x012B;
0x006F; 0x014D; 0x0075; 0x016B; 0x0079; 0x0233; 0x00C4; 0x01DE;
0x00C6; 0x01E2; 0x00D5; 0x022C; 0x00D6; 0x022A; 0x00DC; 0x01D5;
0x00E4; 0x01DF; 0x00E6; 0x01E3; 0x00F5; 0x022D; 0x00F6; 0x022B;
0x00FC; 0x01D6; 0x01EA; 0x01EC; 0x01EB; 0x01ED; 0x0226; 0x01E0;
0x0227; 0x01E1; 0x022E; 0x0230; 0x022F; 0x0231; 0x0391; 0x1FB9;
0x0399; 0x1FD9; 0x03A5; 0x1FE9; 0x03B1; 0x1FB1; 0x03B9; 0x1FD1;
0x03C5; 0x1FE1; 0x0418; 0x04E2; 0x0423; 0x04EE; 0x0438; 0x04E3;
0x0443; 0x04EF; 0x1E36; 0x1E38; 0x1E37; 0x1E39; 0x1E5A; 0x1E5C;
0x1E5B; 0x1E5D; 0x0041; 0x0102; 0x0045; 0x0114; 0x0047; 0x011E;
0x0049; 0x012C; 0x004F; 0x014E; 0x0055; 0x016C; 0x0061; 0x0103;
0x0065; 0x0115; 0x0067; 0x011F; 0x0069; 0x012D; 0x006F; 0x014F;
0x0075; 0x016D; 0x0228; 0x1E1C; 0x0229; 0x1E1D; 0x0391; 0x1FB8;
0x0399; 0x1FD8; 0x03A5; 0x1FE8; 0x03B1; 0x1FB0; 0x03B9; 0x1FD0;
0x03C5; 0x1FE0; 0x0410; 0x04D0; 0x0415; 0x04D6; 0x0416; 0x04C1;
0x0418; 0x0419; 0x0423; 0x040E; 0x0430; 0x04D1; 0x0435; 0x04D7;
0x0436; 0x04C2; 0x0438; 0x0439; 0x0443; 0x045E; 0x1EA0; 0x1EB6;
0x1EA1; 0x1EB7; 0x0041; 0x0226; 0x0042; 0x1E02; 0x0043; 0x010A;
0x0044; 0x1E0A; 0x0045; 0x0116; 0x0046; 0x1E1E; 0x0047; 0x0120;
0x0048; 0x1E22; 0x0049; 0x0130; 0x004D; 0x1E40; 0x004E; 0x1E44;
0x004F; 0x022E; 0x0050; 0x1E56; 0x0052; 0x1E58; 0x0053; 0x1E60;
0x0054; 0x1E6A; 0x0057; 0x1E86; 0x0058; 0x1E8A; 0x0059; 0x1E8E;
0x005A; 0x017B; 0x0061; 0x0227; 0x0062; 0x1E03; 0x0063; 0x010B;
0x0064; 0x1E0B; 0x0065; 0x0117; 0x0066; 0x1E1F; 0x0067; 0x0121;
0x0068; 0x1E23; 0x006D; 0x1E41; 0x006E; 0x1E45; 0x006F; 0x022F;
0x0070; 0x1E57; 0x0072; 0x1E59; 0x0073; 0x1E61; 0x0074; 0x1E6B;
0x0077; 0x1E87; 0x0078; 0x1E8B; 0x0079; 0x1E8F; 0x007A; 0x017C;
0x015A; 0x1E64; 0x015B; 0x1E65; 0x0160; 0x1E66; 0x0161; 0x1E67;
0x017F; 0x1E9B; 0x1E62; 0x1E68; 0x1E63; 0x1E69; 0x0041; 0x00C4;
0x0045; 0x00CB; 0x0048; 0x1E26; 0x0049; 0x00CF; 0x004F; 0x00D6;
0x0055; 0x00DC; 0x0057; 0x1E84; 0x0058; 0x1E8C; 0x0059; 0x0178;
0x0061; 0x00E4; 0x0065; 0x00EB; 0x0068; 0x1E27; 0x0069; 0x00EF;
0x006F; 0x00F6; 0x0074; 0x1E97; 0x0075; 0x00FC; 0x0077; 0x1E85;
0x0078; 0x1E8D; 0x0079; 0x00FF; 0x00D5; 0x1E4E; 0x00F5; 0x1E4F;
0x016A; 0x1E7A; 0x016B; 0x1E7B; 0x0399; 0x03AA; 0x03A5; 0x03AB;
0x03B9; 0x03CA; 0x03C5; 0x03CB; 0x03D2; 0x03D4; 0x0406; 0x0407;
0x0410; 0x04D2; 0x0415; 0x0401; 0x0416; 0x04DC; 0x0417; 0x04DE;
0x0418; 0x04E4; 0x041E; 0x04E6; 0x0423; 0x04F0; 0x0427; 0x04F4;
0x042B; 0x04F8; 0x042D; 0x04EC; 0x0430; 0x04D3; 0x0435; 0x0451;
0x0436; 0x04DD; 0x0437; 0x04DF; 0x0438; 0x04E5; 0x043E; 0x04E7;
0x0443; 0x04F1; 0x0447; 0x04F5; 0x044B; 0x04F9; 0x044D; 0x04ED;
0x0456; 0x0457; 0x04D8; 0x04DA; 0x04D9; 0x04DB; 0x04E8; 0x04EA;
0x04E9; 0x04EB; 0x0041; 0x1EA2; 0x0045; 0x1EBA; 0x0049; 0x1EC8;
0x004F; 0x1ECE; 0x0055; 0x1EE6; 0x0059; 0x1EF6; 0x0061; 0x1EA3;
0x0065; 0x1EBB; 0x0069; 0x1EC9; 0x006F; 0x1ECF; 0x0075; 0x1EE7;
0x0079; 0x1EF7; 0x00C2; 0x1EA8; 0x00CA; 0x1EC2; 0x00D4; 0x1ED4;
0x00E2; 0x1EA9; 0x00EA; 0x1EC3; 0x00F4; 0x1ED5; 0x0102; 0x1EB2;
0x0103; 0x1EB3; 0x01A0; 0x1EDE; 0x01A1; 0x1EDF; 0x01AF; 0x1EEC;
0x01B0; 0x1EED; 0x0041; 0x00C5; 0x0055; 0x016E; 0x0061; 0x00E5;
0x0075; 0x016F; 0x0077; 0x1E98; 0x0079; 0x1E99; 0x004F; 0x0150;
0x0055; 0x0170; 0x006F; 0x0151; 0x0075; 0x0171; 0x0423; 0x04F2;
0x0443; 0x04F3; 0x0041; 0x01CD; 0x0043; 0x010C; 0x0044; 0x010E;
0x0045; 0x011A; 0x0047; 0x01E6; 0x0048; 0x021E; 0x0049; 0x01CF;
0x004B; 0x01E8; 0x004C; 0x013D; 0x004E; 0x0147; 0x004F; 0x01D1;
0x0052; 0x0158; 0x0053; 0x0160; 0x0054; 0x0164; 0x0055; 0x01D3;
0x005A; 0x017D; 0x0061; 0x01CE; 0x0063; 0x010D; 0x0064; 0x010F;
0x0065; 0x011B; 0x0067; 0x01E7; 0x0068; 0x021F; 0x0069; 0x01D0;
0x006A; 0x01F0; 0x006B; 0x01E9; 0x006C; 0x013E; 0x006E; 0x0148;
0x006F; 0x01D2; 0x0072; 0x0159; 0x0073; 0x0161; 0x0074; 0x0165;
0x0075; 0x01D4; 0x007A; 0x017E; 0x00DC; 0x01D9; 0x00FC; 0x01DA;
0x01B7; 0x01EE; 0x0292; 0x01EF; 0x0041; 0x0200; 0x0045; 0x0204;
0x0049; 0x0208; 0x004F; 0x020C; 0x0052; 0x0210; 0x0055; 0x0214;
0x0061; 0x0201; 0x0065; 0x0205; 0x0069; 0x0209; 0x006F; 0x020D;
0x0072; 0x0211; 0x0075; 0x0215; 0x0474; 0x0476; 0x0475; 0x0477;
0x0041; 0x0202; 0x0045; 0x0206; 0x0049; 0x020A; 0x004F; 0x020E;
0x0052; 0x0212; 0x0055; 0x0216; 0x0061; 0x0203; 0x0065; 0x0207;
0x0069; 0x020B; 0x006F; 0x020F; 0x0072; 0x0213; 0x0075; 0x0217;
0x0391; 0x1F08; 0x0395; 0x1F18; 0x0397; 0x1F28; 0x0399; 0x1F38;
0x039F; 0x1F48; 0x03A9; 0x1F68; 0x03B1; 0x1F00; 0x03B5; 0x1F10;
0x03B7; 0x1F20; 0x03B9; 0x1F30; 0x03BF; 0x1F40; 0x03C1; 0x1FE4;
0x03C5; 0x1F50; 0x03C9; 0x1F60; 0x0391; 0x1F09; 0x0395; 0x1F19;
0x0397; 0x1F29; 0x0399; 0x1F39; 0x039F; 0x1F49; 0x03A1; 0x1FEC;
0x03A5; 0x1F59; 0x03A9; 0x1F69; 0x03B1; 0x1F01; 0x03B5; 0x1F11;
0x03B7; 0x1F21; 0x03B9; 0x1F31; 0x03BF; 0x1F41; 0x03C1; 0x1FE5;
0x03C5; 0x1F51; 0x03C9; 0x1F61; 0x004F; 0x01A0; 0x0055; 0x01AF;
0x006F; 0x01A1; 0x0075; 0x01B0; 0x0041; 0x1EA0; 0x0042; 0x1E04;
0x0044; 0x1E0C; 0x0045; 0x1EB8; 0x0048; 0x1E24; 0x0049; 0x1ECA;
0x004B; 0x1E32; 0x004C; 0x1E36; 0x004D; 0x1E42; 0x004E; 0x1E46;
0x004F; 0x1ECC; 0x0052; 0x1E5A; 0x0053; 0x1E62; 0x0054; 0x1E6C;
0x0055; 0x1EE4; 0x0056; 0x1E7E; 0x0057; 0x1E88; 0x0059; 0x1EF4;
0x005A; 0x1E92; 0x0061; 0x1EA1; 0x0062; 0x1E05; 0x0064; 0x1E0D;
0x0065; 0x1EB9; 0x0068; 0x1E25; 0x0069; 0x1ECB; 0x006B; 0x1E33;
0x006C; 0x1E37; 0x006D; 0x1E43; 0x006E; 0x1E47; 0x006F; 0x1ECD;
0x0072; 0x1E5B; 0x0073; 0x1E63; 0x0074; 0x1E6D; 0x0075; 0x1EE5;
0x0076; 0x1E7F; 0x0077; 0x1E89; 0x0079; 0x1EF5; 0x007A; 0x1E93;
0x01A0; 0x1EE2; 0x01A1; 0x1EE3; 0x01AF; 0x1EF0; 0x01B0; 0x1EF1;
0x0055; 0x1E72; 0x0075; 0x1E73; 0x0041; 0x1E00; 0x0061; 0x1E01;
0x0053; 0x0218; 0x0054; 0x021A; 0x0073; 0x0219; 0x0074; 0x021B;
0x0043; 0x00C7; 0x0044; 0x1E10; 0x0045; 0x0228; 0x0047; 0x0122;
0x0048; 0x1E28; 0x004B; 0x0136; 0x004C; 0x013B; 0x004E; 0x0145;
0x0052; 0x0156; 0x0053; 0x015E; 0x0054; 0x0162; 0x0063; 0x00E7;
0x0064; 0x1E11; 0x0065; 0x0229; 0x0067; 0x0123; 0x0068; 0x1E29;
0x006B; 0x0137; 0x006C; 0x013C; 0x006E; 0x0146; 0x0072; 0x0157;
0x0073; 0x015F; 0x0074; 0x0163; 0x0041; 0x0104; 0x0045; 0x0118;
0x0049; 0x012E; 0x004F; 0x01EA; 0x0055; 0x0172; 0x0061; 0x0105;
0x0065; 0x0119; 0x0069; 0x012F; 0x006F; 0x01EB; 0x0075; 0x0173;
0x0044; 0x1E12; 0x0045; 0x1E18; 0x004C; 0x1E3C; 0x004E; 0x1E4A;
0x0054; 0x1E70; 0x0055; 0x1E76; 0x0064; 0x1E13; 0x0065; 0x1E19;
0x006C; 0x1E3D; 0x006E; 0x1E4B; 0x0074; 0x1E71; 0x0075; 0x1E77;
0x0048; 0x1E2A; 0x0068; 0x1E2B; 0x0045; 0x1E1A; 0x0049; 0x1E2C;
0x0055; 0x1E74; 0x0065; 0x1E1B; 0x0069; 0x1E2D; 0x0075; 0x1E75;
0x0042; 0x1E06; 0x0044; 0x1E0E; 0x004B; 0x1E34; 0x004C; 0x1E3A;
0x004E; 0x1E48; 0x0052; 0x1E5E; 0x0054; 0x1E6E; 0x005A; 0x1E94;
0x0062; 0x1E07; 0x0064; 0x1E0F; 0x0068; 0x1E96; 0x006B; 0x1E35;
0x006C; 0x1E3B; 0x006E; 0x1E49; 0x0072; 0x1E5F; 0x0074; 0x1E6F;
0x007A; 0x1E95; 0x003C; 0x226E; 0x003D; 0x2260; 0x003E; 0x226F;
0x2190; 0x219A; 0x2192; 0x219B; 0x2194; 0x21AE; 0x21D0; 0x21CD;
0x21D2; 0x21CF; 0x21D4; 0x21CE; 0x2203; 0x2204; 0x2208; 0x2209;
0x220B; 0x220C; 0x2223; 0x2224; 0x2225; 0x2226; 0x223C; 0x2241;
0x2243; 0x2244; 0x2245; 0x2247; 0x2248; 0x2249; 0x224D; 0x226D;
0x2261; 0x2262; 0x2264; 0x2270; 0x2265; 0x2271; 0x2272; 0x2274;
0x2273; 0x2275; 0x2276; 0x2278; 0x2277; 0x2279; 0x227A; 0x2280;
0x227B; 0x2281; 0x227C; 0x22E0; 0x227D; 0x22E1; 0x2282; 0x2284;
0x2283; 0x2285; 0x2286; 0x2288; 0x2287; 0x2289; 0x2291; 0x22E2;
0x2292; 0x22E3; 0x22A2; 0x22AC; 0x22A8; 0x22AD; 0x22A9; 0x22AE;
0x22AB; 0x22AF; 0x22B2; 0x22EA; 0x22B3; 0x22EB; 0x22B4; 0x22EC;
0x22B5; 0x22ED; 0x00A8; 0x1FC1; 0x03B1; 0x1FB6; 0x03B7; 0x1FC6;
0x03B9; 0x1FD6; 0x03C5; 0x1FE6; 0x03C9; 0x1FF6; 0x03CA; 0x1FD7;
0x03CB; 0x1FE7; 0x1F00; 0x1F06; 0x1F01; 0x1F07; 0x1F08; 0x1F0E;
0x1F09; 0x1F0F; 0x1F20; 0x1F26; 0x1F21; 0x1F27; 0x1F28; 0x1F2E;
0x1F29; 0x1F2F; 0x1F30; 0x1F36; 0x1F31; 0x1F37; 0x1F38; 0x1F3E;
0x1F39; 0x1F3F; 0x1F50; 0x1F56; 0x1F51; 0x1F57; 0x1F59; 0x1F5F;
0x1F60; 0x1F66; 0x1F61; 0x1F67; 0x1F68; 0x1F6E; 0x1F69; 0x1F6F;
0x1FBF; 0x1FCF; 0x1FFE; 0x1FDF; 0x0391; 0x1FBC; 0x0397; 0x1FCC;
0x03A9; 0x1FFC; 0x03AC; 0x1FB4; 0x03AE; 0x1FC4; 0x03B1; 0x1FB3;
0x03B7; 0x1FC3; 0x03C9; 0x1FF3; 0x03CE; 0x1FF4; 0x1F00; 0x1F80;
0x1F01; 0x1F81; 0x1F02; 0x1F82; 0x1F03; 0x1F83; 0x1F04; 0x1F84;
0x1F05; 0x1F85; 0x1F06; 0x1F86; 0x1F07; 0x1F87; 0x1F08; 0x1F88;
0x1F09; 0x1F89; 0x1F0A; 0x1F8A; 0x1F0B; 0x1F8B; 0x1F0C; 0x1F8C;
0x1F0D; 0x1F8D; 0x1F0E; 0x1F8E; 0x1F0F; 0x1F8F; 0x1F20; 0x1F90;
0x1F21; 0x1F91; 0x1F22; 0x1F92; 0x1F23; 0x1F93; 0x1F24; 0x1F94;
0x1F25; 0x1F95; 0x1F26; 0x1F96; 0x1F27; 0x1F97; 0x1F28; 0x1F98;
0x1F29; 0x1F99; 0x1F2A; 0x1F9A; 0x1F2B; 0x1F9B; 0x1F2C; 0x1F9C;
0x1F2D; 0x1F9D; 0x1F2E; 0x1F9E; 0x1F2F; 0x1F9F; 0x1F60; 0x1FA0;
0x1F61; 0x1FA1; 0x1F62; 0x1FA2; 0x1F63; 0x1FA3; 0x1F64; 0x1FA4;
0x1F65; 0x1FA5; 0x1F66; 0x1FA6; 0x1F67; 0x1FA7; 0x1F68; 0x1FA8;
0x1F69; 0x1FA9; 0x1F6A; 0x1FAA; 0x1F6B; 0x1FAB; 0x1F6C; 0x1FAC;
0x1F6D; 0x1FAD; 0x1F6E; 0x1FAE; 0x1F6F; 0x1FAF; 0x1F70; 0x1FB2;
0x1F74; 0x1FC2; 0x1F7C; 0x1FF2; 0x1FB6; 0x1FB7; 0x1FC6; 0x1FC7;
0x1FF6; 0x1FF7; 0x0627; 0x0622; 0x0627; 0x0623; 0x0648; 0x0624;
0x064A; 0x0626; 0x06C1; 0x06C2; 0x06D2; 0x06D3; 0x06D5; 0x06C0;
0x0627; 0x0625; 0x0928; 0x0929; 0x0930; 0x0931; 0x0933; 0x0934;
0x09C7; 0x09CB; 0x09C7; 0x09CC; 0x0B47; 0x0B4B; 0x0B47; 0x0B48;
0x0B47; 0x0B4C; 0x0BC6; 0x0BCA; 0x0BC7; 0x0BCB; 0x0B92; 0x0B94;
0x0BC6; 0x0BCC; 0x0C46; 0x0C48; 0x0CC6; 0x0CCA; 0x0CBF; 0x0CC0;
0x0CC6; 0x0CC7; 0x0CCA; 0x0CCB; 0x0CC6; 0x0CC8; 0x0D46; 0x0D4A;
0x0D47; 0x0D4B; 0x0D46; 0x0D4C; 0x0DD9; 0x0DDA; 0x0DDC; 0x0DDD;
0x0DD9; 0x0DDC; 0x0DD9; 0x0DDE; 0x1025; 0x1026; 0x3046; 0x3094;
0x304B; 0x304C; 0x304D; 0x304E; 0x304F; 0x3050; 0x3051; 0x3052;
0x3053; 0x3054; 0x3055; 0x3056; 0x3057; 0x3058; 0x3059; 0x305A;
0x305B; 0x305C; 0x305D; 0x305E; 0x305F; 0x3060; 0x3061; 0x3062;
0x3064; 0x3065; 0x3066; 0x3067; 0x3068; 0x3069; 0x306F; 0x3070;
0x3072; 0x3073; 0x3075; 0x3076; 0x3078; 0x3079; 0x307B; 0x307C;
0x309D; 0x309E; 0x30A6; 0x30F4; 0x30AB; 0x30AC; 0x30AD; 0x30AE;
0x30AF; 0x30B0; 0x30B1; 0x30B2; 0x30B3; 0x30B4; 0x30B5; 0x30B6;
0x30B7; 0x30B8; 0x30B9; 0x30BA; 0x30BB; 0x30BC; 0x30BD; 0x30BE;
0x30BF; 0x30C0; 0x30C1; 0x30C2; 0x30C4; 0x30C5; 0x30C6; 0x30C7;
0x30C8; 0x30C9; 0x30CF; 0x30D0; 0x30D2; 0x30D3; 0x30D5; 0x30D6;
0x30D8; 0x30D9; 0x30DB; 0x30DC; 0x30EF; 0x30F7; 0x30F0; 0x30F8;
0x30F1; 0x30F9; 0x30F2; 0x30FA; 0x30FD; 0x30FE; 0x306F; 0x3071;
0x3072; 0x3074; 0x3075; 0x3077; 0x3078; 0x307A; 0x307B; 0x307D;
0x30CF; 0x30D1; 0x30D2; 0x30D4; 0x30D5; 0x30D7; 0x30D8; 0x30DA;
0x30DB; 0x30DD
|]
let uniCharCombiningBitmap = "\
\x00\x00\x00\x01\x02\x03\x04\x05\
\x00\x06\x07\x08\x09\x0A\x0B\x0C\
\x0D\x14\x00\x00\x00\x00\x00\x0E\
\x0F\x00\x00\x00\x00\x00\x00\x00\
\x10\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x11\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x12\x00\x00\x13\x00\
\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\
\xFF\xFF\x00\x00\xFF\xFF\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x78\x03\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\xFE\xFF\xFB\xFF\xFF\xBB\
\x16\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\xF8\x3F\x00\x00\x00\x01\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\xC0\xFF\x9F\x3D\x00\x00\
\x00\x00\x02\x00\x00\x00\xFF\xFF\
\xFF\x07\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\xC0\xFF\x01\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x0E\x00\x00\x00\x00\x00\x00\xD0\
\xFF\x3F\x1E\x00\x0C\x00\x00\x00\
\x0E\x00\x00\x00\x00\x00\x00\xD0\
\x9F\x39\x80\x00\x0C\x00\x00\x00\
\x04\x00\x00\x00\x00\x00\x00\xD0\
\x87\x39\x00\x00\x00\x00\x03\x00\
\x0E\x00\x00\x00\x00\x00\x00\xD0\
\xBF\x3B\x00\x00\x00\x00\x00\x00\
\x0E\x00\x00\x00\x00\x00\x00\xD0\
\x8F\x39\xC0\x00\x00\x00\x00\x00\
\x04\x00\x00\x00\x00\x00\x00\xC0\
\xC7\x3D\x80\x00\x00\x00\x00\x00\
\x0E\x00\x00\x00\x00\x00\x00\xC0\
\xDF\x3D\x60\x00\x00\x00\x00\x00\
\x0C\x00\x00\x00\x00\x00\x00\xC0\
\xDF\x3D\x60\x00\x00\x00\x00\x00\
\x0C\x00\x00\x00\x00\x00\x00\xC0\
\xCF\x3D\x80\x00\x00\x00\x00\x00\
\x0C\x00\x00\x00\x00\x00\x00\x00\
\x00\x84\x5F\xFF\x00\x00\x0C\x00\
\x00\x00\x00\x00\x00\x00\xF2\x07\
\x80\x7F\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\xF2\x1B\
\x00\x3F\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x03\x00\x00\xA0\xC2\
\x00\x00\x00\x00\x00\x00\xFE\xFF\
\xDF\x00\xFF\xFE\xFF\xFF\xFF\x1F\
\x40\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\xF0\xC7\x03\
\x00\x00\xC0\x03\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x1C\x00\x00\x00\x1C\x00\
\x00\x00\x0C\x00\x00\x00\x0C\x00\
\x00\x00\x00\x00\x00\x00\xF0\xFF\
\xFF\xFF\x0F\x00\x00\x00\x00\x00\
\x00\x38\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x02\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\xFF\xFF\xFF\x07\x00\x00\
\x00\x00\x00\x00\x00\xFC\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x06\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x40\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\xFF\xFF\x00\x00\x0F\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\x00\x00\x00\x00\
\x00\x00\x00\x00\xFE\xFF\x3F\x00\
\x00\x00\x00\x00\x00\xFF\xFF\xFF\
\x07\x00\x00\x00\x00\x00\x00\x00"
(****)
let bitmap_test base bitmap character =
character >= base && character < 0x10000
&&
(let value = get bitmap ((character lsr 8) land 0xFF) in
value = 0xFF
||
(value <> 0
&&
get bitmap ((value - 1) * 32 + 256 + (character land 0xFF) / 8)
land (1 lsl (character land 7)) <> 0))
let unicode_combinable character =
bitmap_test 0x0300 uniCharCombiningBitmap character
let rec find_rec t i j v =
if i + 1 = j then begin
if t.(i * 2) = v then t.(i * 2 + 1) else 0
end else begin
let k = (i + j) / 2 in
if v < t.(k * 2) then
find_rec t i k v
else
find_rec t k j v
end
let find t i n v =
let j = i + n in
if v < t.(2 * i) || v > t.(2 * (j - 1)) then 0 else
find_rec t i j v
let uniCharPrecompSourceTableLen = Array.length uniCharPrecompSourceTable / 2
let combine v v' =
if v' >= hangul_vbase && v' < hangul_tbase + hangul_tcount then begin
if
v' < hangul_vbase + hangul_vcount &&
v >= hangul_lbase && v < hangul_lbase + hangul_lcount
then
hangul_sbase + ((v - hangul_lbase) * (hangul_vcount * hangul_tcount)) +
((v' - hangul_vbase) * hangul_tcount)
else if
v' > hangul_tbase &&
v >= hangul_sbase && v < hangul_sbase + hangul_scount
then
if (v - hangul_sbase) mod hangul_tcount <> 0 then 0 else
v + v' - hangul_tbase
else
0
end else begin
let k =
find uniCharPrecompSourceTable 0
uniCharPrecompSourceTableLen v'
in
if k = 0 then 0 else
find uniCharBMPPrecompDestinationTable (k land 0xFFFF) (k lsr 16) v
end
(****)
let rec scan d s i l =
if i < l then begin
let c = get s i in
if c < 0x80 then
cont d s i l (i + 1) c
else if c < 0xE0 then begin
(* 80 - 7FF *)
if c < 0xc2 || i + 1 >= l then fail () else
let c1 = get s (i + 1) in
if c1 land 0xc0 <> 0x80 then fail () else
let v = c lsl 6 + c1 - 0x3080 in
cont d s i l (i + 2) v
end else if c < 0xF0 then begin
(* 800 - FFFF *)
if i + 2 >= l then fail () else
let c1 = get s (i + 1) in
let c2 = get s (i + 2) in
if (c1 lor c2) land 0xc0 <> 0x80 then fail () else
let v = c lsl 12 + c1 lsl 6 + c2 - 0xe2080 in
if v < 0x800 then fail () else
cont d s i l (i + 3) v
end else begin
(* 10000 - 10FFFF *)
if i + 3 >= l then fail () else
let c1 = get s (i + 1) in
let c2 = get s (i + 2) in
let c3 = get s (i + 3) in
if (c1 lor c2 lor c3) land 0xc0 <> 0x80 then fail () else
let v = c lsl 18 + c1 lsl 12 + c2 lsl 6 + c3 - 0x03c82080 in
if v < 0x10000 || v > 0x10ffff then fail () else
cont d s i l (i + 4) v
end
end else begin
let (i1, i2) = d in
String.blit s i2 s i1 (l - i2);
String.sub s 0 (i1 + l - i2)
end
and cont d s i l j v' =
if unicode_combinable v' then begin
let i = prev_char s i in
let (v, _) = decode_char s i l in
let v'' = combine v v' in
if v'' = 0 then
scan d s j l
else begin
let (i1, i2) = d in
String.blit s i2 s i1 (i - i2);
let i1 = i1 + i - i2 in
let (v'', i) = compose_rec s j l v'' in
let i1 = encode_char s i1 l v'' in
scan (i1, i) s i l
end
end else
scan d s j l
and compose_rec s i l v =
try
let (v', j) = decode_char s i l in
if unicode_combinable v' then begin
let v'' = combine v v' in
if v'' = 0 then
(v, i)
else
compose_rec s j l v''
end else
(v, i)
with Invalid ->
(v, i)
let compose s =
try scan (0, 0) (String.copy s) 0 (String.length s) with Invalid -> s
(***)
let set_2 s i v =
set s i (v land 0xff);
set s (i + 1) (v lsr 8)
let get_2 s i = (get s (i + 1)) lsl 8 + get s i
let rec scan s' j s i l =
if i < l then begin
let c = get s i in
if c < 0x80 then
cont s' j s (i + 1) l c
else if c < 0xE0 then begin
(* 80 - 7FF *)
if c < 0xc2 || i + 1 >= l then fail () else
let c1 = get s (i + 1) in
if c1 land 0xc0 <> 0x80 then fail () else
let v = c lsl 6 + c1 - 0x3080 in
cont s' j s (i + 2) l v
end else if c < 0xF0 then begin
(* 800 - FFFF *)
if i + 2 >= l then fail () else
let c1 = get s (i + 1) in
let c2 = get s (i + 2) in
if (c1 lor c2) land 0xc0 <> 0x80 then fail () else
let v = c lsl 12 + c1 lsl 6 + c2 - 0xe2080 in
if v < 0x800 then fail () else
cont s' j s (i + 3) l v
end else begin
(* 10000 - 10FFFF *)
if i + 3 >= l then fail () else
let c1 = get s (i + 1) in
let c2 = get s (i + 2) in
let c3 = get s (i + 3) in
if (c1 lor c2 lor c3) land 0xc0 <> 0x80 then fail () else
let v = c lsl 18 + c1 lsl 12 + c2 lsl 6 + c3 - 0x03c82080 in
if v < 0x10000 || v > 0x10ffff then fail () else
let v = v - 0x10000 in
set_2 s' j (v lsr 10 + 0xD800);
set_2 s' (j + 2) (v land 0x3FF + 0xDC00);
scan s' (j + 4) s (i + 4) l
end
end else
String.sub s' 0 (j + 2)
and cont s' j s i l v =
set_2 s' j v;
scan s' (j + 2) s i l
let to_utf_16 s =
let l = String.length s in
let s' = String.make (2 * l + 2) '\000' in
scan s' 0 s 0 l
(***)
let sfm_encode =
[| 0x0000; 0xf001; 0xf002; 0xf003; 0xf004; 0xf005; 0xf006; 0xf007;
0xf008; 0xf009; 0xf00a; 0xf00b; 0xf00c; 0xf00d; 0xf00e; 0xf00f;
0xf010; 0xf011; 0xf012; 0xf013; 0xf014; 0xf015; 0xf016; 0xf017;
0xf018; 0xf019; 0xf01a; 0xf01b; 0xf01c; 0xf01d; 0xf01e; 0xf01f;
0x0020; 0x0021; 0xf020; 0x0023; 0x0024; 0x0025; 0x0026; 0x0027;
0x0028; 0x0029; 0xf021; 0x002b; 0x002c; 0x002d; 0x002e; 0x002f;
0x0030; 0x0031; 0x0032; 0x0033; 0x0034; 0x0035; 0x0036; 0x0037;
0x0038; 0x0039; 0xf022; 0x003b; 0xf023; 0x003d; 0xf024; 0xf025;
0x0040; 0x0041; 0x0042; 0x0043; 0x0044; 0x0045; 0x0046; 0x0047;
0x0048; 0x0049; 0x004a; 0x004b; 0x004c; 0x004d; 0x004e; 0x004f;
0x0050; 0x0051; 0x0052; 0x0053; 0x0054; 0x0055; 0x0056; 0x0057;
0x0058; 0x0059; 0x005a; 0x005b; 0xf026; 0x005d; 0x005e; 0x005f;
0x0060; 0x0061; 0x0062; 0x0063; 0x0064; 0x0065; 0x0066; 0x0067;
0x0068; 0x0069; 0x006a; 0x006b; 0x006c; 0x006d; 0x006e; 0x006f;
0x0070; 0x0071; 0x0072; 0x0073; 0x0074; 0x0075; 0x0076; 0x0077;
0x0078; 0x0079; 0x007a; 0x007b; 0xf027; 0x007d; 0x007e; 0x007f |]
let set_2 s i v =
set s i (v land 0xff);
set s (i + 1) (v lsr 8)
let get_2 s i = (get s (i + 1)) lsl 8 + get s i
let end_of_name s i l = let i' = i + 1 in i' = l || get s i' = 0x2f (*'/'*)
let rec scan s' j s i l =
if i < l then begin
let c = get s i in
if c < 0x80 then
cont s' j s (i + 1) l
(if c = 0x20 && end_of_name s i l then 0xf028
else if c = 0x2e && end_of_name s i l then 0xf029
else Array.unsafe_get sfm_encode c)
else if c < 0xE0 then begin
(* 80 - 7FF *)
if c < 0xc2 || i + 1 >= l then fail () else
let c1 = get s (i + 1) in
if c1 land 0xc0 <> 0x80 then fail () else
let v = c lsl 6 + c1 - 0x3080 in
cont s' j s (i + 2) l v
end else if c < 0xF0 then begin
(* 800 - FFFF *)
if i + 2 >= l then fail () else
let c1 = get s (i + 1) in
let c2 = get s (i + 2) in
if (c1 lor c2) land 0xc0 <> 0x80 then fail () else
let v = c lsl 12 + c1 lsl 6 + c2 - 0xe2080 in
if v < 0x800 then fail () else
cont s' j s (i + 3) l v
end else begin
(* 10000 - 10FFFF *)
if i + 3 >= l then fail () else
let c1 = get s (i + 1) in
let c2 = get s (i + 2) in
let c3 = get s (i + 3) in
if (c1 lor c2 lor c3) land 0xc0 <> 0x80 then fail () else
let v = c lsl 18 + c1 lsl 12 + c2 lsl 6 + c3 - 0x03c82080 in
if v < 0x10000 || v > 0x10ffff then fail () else
let v = v - 0x10000 in
set_2 s' j (v lsr 10 + 0xD800);
set_2 s' (j + 2) (v land 0x3FF + 0xDC00);
scan s' (j + 4) s (i + 4) l
end
end else
String.sub s' 0 (j + 2)
and cont s' j s i l v =
set_2 s' j v;
scan s' (j + 2) s i l
let to_utf_16_filename s =
let l = String.length s in
let s' = String.make (2 * l + 2) '\000' in
scan s' 0 s 0 l
(****)
let rec scan s' i' l' s i l =
if i + 2 <= l then begin
let v = get_2 s i in
if v = 0 then
String.sub s' 0 i' (* null *)
else if v < 0xD800 || v > 0xDFFF then
let i' = encode_char s' i' l' v in
scan s' i' l' s (i + 2) l
else if v >= 0xdc00 || i + 4 > l then
let i' = encode_char s' i' l' v in
scan s' i' l' s (i + 2) l
(* fail () *)
else begin
let v' = get_2 s (i + 2) in
if v' < 0xDC00 || v' > 0XDFFF then
let i' = encode_char s' i' l' v in
scan s' i' l' s (i + 2) l
(* fail ()*)
else
let i' =
encode_char s' i' l' ((v - 0xD800) lsl 10 + (v' - 0xDC00) + 0x10000)
in
scan s' i' l' s (i + 4) l
end
end else if i < l then
fail () (* Odd number of chars *)
else
String.sub s' 0 i'
let from_utf_16 s =
let l = String.length s in
let l' = 3 * l / 2 in
let s' = String.create l' in
scan s' 0 l' s 0 l
(****)
let end_of_name s i l =
i + 2 = l || (i + 4 <= l && s.[i + 2] = '/' && s.[i + 3] = '\000')
let sfm_decode =
"\x00\x01\x02\x03\x04\x05\x06\x07\
\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f\
\x10\x11\x12\x13\x14\x15\x16\x17\
\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\
\"*:<>?\\| ."
let rec scan s' i' l' s i l =
if i + 2 <= l then begin
let v = get_2 s i in
if v = 0 then
String.sub s' 0 i' (* null *)
else if v < 0xD800 then
let i' = encode_char s' i' l' v in
scan s' i' l' s (i + 2) l
else if v > 0xDFFF then begin
let v =
if v > 0xf000 && v <= 0xf029 then
if v = 0xf028 && end_of_name s i l then 0x20
else if v = 0xf029 && end_of_name s i l then 0x2e
else get sfm_decode (v - 0xf000)
else
v
in
let i' = encode_char s' i' l' v in
scan s' i' l' s (i + 2) l
end else if v >= 0xdc00 || i + 4 > l then
let i' = encode_char s' i' l' v in
scan s' i' l' s (i + 2) l
(* fail () *)
else begin
let v' = get_2 s (i + 2) in
if v' < 0xDC00 || v' > 0XDFFF then
let i' = encode_char s' i' l' v in
scan s' i' l' s (i + 2) l
(* fail ()*)
else
let i' =
encode_char s' i' l' ((v - 0xD800) lsl 10 + (v' - 0xDC00) + 0x10000)
in
scan s' i' l' s (i + 4) l
end
end else if i < l then
fail () (* Odd number of chars *)
else
String.sub s' 0 i'
(* NOTE: we MUST have to_utf_16_filename (from_utf_16 s) = s for any
Windows valid filename s *)
let from_utf_16_filename s =
let l = String.length s in
let l' = 3 * l / 2 in
let s' = String.create l' in
scan s' 0 l' s 0 l
(****)
let rec scan s i l =
i = l ||
let c = get s i in
if c < 0x80 then
c <> 0 && scan s (i + 1) l
else if c < 0xE0 then begin
(* 80 - 7FF *)
c >= 0xc2 && i + 1 < l &&
let c1 = get s (i + 1) in
c1 land 0xc0 = 0x80 &&
scan s (i + 2) l
end else if c < 0xF0 then begin
(* 800 - FFFF *)
i + 2 < l &&
let c1 = get s (i + 1) in
let c2 = get s (i + 2) in
(c1 lor c2) land 0xc0 = 0x80 &&
let v = c lsl 12 + c1 lsl 6 + c2 - 0xe2080 in
v >= 0x800 && (v < 0xd800 || (v > 0xdfff && v <> 0xfffe && v <> 0xffff)) &&
scan s (i + 3) l
end else begin
(* 10000 - 10FFFF *)
i + 3 < l &&
let c1 = get s (i + 1) in
let c2 = get s (i + 2) in
let c3 = get s (i + 3) in
(c1 lor c2 lor c3) land 0xc0 = 0x80 &&
let v = c lsl 18 + c1 lsl 12 + c2 lsl 6 + c3 - 0x03c82080 in
v >= 0x10000 && v <= 0x10ffff &&
scan s (i + 4) l
end
let check_utf_8 s = scan s 0 (String.length s)
(****)
let wf_utf8 =
[[('\x01', '\x7F')];
[('\xC2', '\xDF'); ('\x80', '\xBF')];
[('\xE0', '\xE0'); ('\xA0', '\xBF'); ('\x80', '\xBF')];
[('\xE1', '\xEC'); ('\x80', '\xBF'); ('\x80', '\xBF')];
[('\xED', '\xED'); ('\x80', '\x9F'); ('\x80', '\xBF')];
[('\xEE', '\xEF'); ('\x80', '\xBF'); ('\x80', '\xBF')];
[('\xF0', '\xF0'); ('\x90', '\xBF'); ('\x80', '\xBF'); ('\x80', '\xBF')];
[('\xF1', '\xF3'); ('\x80', '\xBF'); ('\x80', '\xBF'); ('\x80', '\xBF')];
[('\xF4', '\xF4'); ('\x80', '\x8F'); ('\x80', '\xBF'); ('\x80', '\xBF')]]
let rec accept_seq l s i len =
match l with
[] ->
Some i
| (a, b) :: r ->
if i = len || s.[i] < a || s.[i] > b then
None
else
accept_seq r s (i + 1) len
let rec accept_rec l s i len =
match l with
[] ->
None
| seq :: r ->
match accept_seq seq s i len with
None -> accept_rec r s i len
| res -> res
let accept = accept_rec wf_utf8
(***)
let protect_char buf c =
if c = '\x00' then
Buffer.add_char buf ' '
else if c < '\x80' then
Buffer.add_char buf c
else
let c = Char.code c in
Buffer.add_char buf (Char.chr (c lsr 6 + 0xC0));
Buffer.add_char buf (Char.chr (c land 0x3f + 0x80))
let rec protect_rec buf s i len =
if i = len then
Buffer.contents buf
else
match accept s i len with
Some i' ->
Buffer.add_substring buf s i (i' - i);
protect_rec buf s i' len
| None ->
protect_char buf s.[i];
protect_rec buf s (i + 1) len
let expl f s = f s 0 (String.length s)
(* Convert a string to UTF8 by keeping all UTF8 characters unchanged
and considering all other characters as ISO 8859-1 characters *)
let protect s =
let buf = Buffer.create (String.length s * 2) in
expl (protect_rec buf) s
unison-2.48.3/unicode.mli 000644 000766 000000 00000003301 12450317305 016164 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/unicode.mli *)
(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
exception Invalid
(* Case-insensitive comparison. If two strings are equal according to
Mac OS X (Darwin, actually, but the algorithm has hopefully
remained unchanged) or Windows (Samba), then this function returns 0 *)
val case_insensitive_compare : string -> string -> int
(* Corresponding normalization *)
val normalize : string -> string
(* Case-sensitive comparison (but up to decomposition). *)
val case_sensitive_compare : string -> string -> int
(* Compose Unicode strings. This is the decomposition performed
by Mac OS X. *)
val decompose : string -> string
(* Compose Unicode strings. This reverts the decomposition performed
by Mac OS X. *)
val compose : string -> string
(* Convert to and from a null-terminated little-endian UTF-16 string *)
(* Do not fail on isolated surrogate but rather generate ill-formed
UTF-8 characters, so that the conversion never fails. *)
val to_utf_16 : string -> string
val from_utf_16 : string -> string
(* Convert to and from a null-terminated little-endian UTF-16 string *)
(* Invalid NTFS characters are mapped to characters in the unicode
private use area *)
(* FIX: not correct at the moment: should deal properly with paths such as
//?/foo/ c:\foo\bar ... *)
val to_utf_16_filename : string -> string
val from_utf_16_filename : string -> string
(* Check wether the string contains only well-formed UTF-8 characters *)
val check_utf_8 : string -> bool
(* Convert a string to UTF-8 by keeping all UTF-8 characters unchanged
and considering all other characters as ISO 8859-1 characters *)
val protect : string -> string
unison-2.48.3/unicode_tables.ml 000644 000766 000000 00000225216 11362021012 017344 0 ustar 00bcpierce wheel 000000 000000 (*-*-coding: utf-8;-*-*)
let norm_ascii =
"\000\001\002\003\004\005\006\007\b\t\n\011\012\r\014\015\016\017\018\019\020\021\022\023\024\025\026\027\028\029\030\031 !\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\127"
let norm_repl =
"\003aÌ€\003aÌ\003aÌ‚\003ã\003ä\003aÌŠ\002æ\003ç\003eÌ€\003eÌ\003eÌ‚\003ë\003iÌ€\003iÌ\003iÌ‚\003ï\002ð\003ñ\003oÌ€\003oÌ\003oÌ‚\003õ\003ö\002ø\003uÌ€\003uÌ\003uÌ‚\003ü\003yÌ\002þ\003ÿ\003aÌ„\003ă\003ą\003cÌ\003cÌ‚\003ċ\003cÌŒ\003dÌŒ\002Ä‘\003eÌ„\003ĕ\003ė\003ę\003eÌŒ\003gÌ‚\003ğ\003ġ\003ģ\003hÌ‚\002ħ\003ĩ\003iÌ„\003ĭ\003į\003i̇\002ij\003jÌ‚\003ķ\003lÌ\003ļ\003lÌŒ\002Å€\002Å‚\003nÌ\003ņ\003nÌŒ\002Å‹\003oÌ„\003ŏ\003oÌ‹\002Å“\003rÌ\003ŗ\003rÌŒ\003sÌ\003sÌ‚\003ş\003sÌŒ\003ţ\003tÌŒ\002ŧ\003ũ\003uÌ„\003ŭ\003uÌŠ\003uÌ‹\003ų\003wÌ‚\003yÌ‚\003zÌ\003ż\003zÌŒ\002É“\002ƃ\002Æ…\002É”\002ƈ\002É–\002É—\002ÆŒ\002Ç\002É™\002É›\002Æ’\002É \002É£\002É©\002ɨ\002Æ™\002ɯ\002ɲ\002ɵ\003oÌ›\002Æ£\002Æ¥\002ƨ\002ʃ\002Æ\002ʈ\003uÌ›\002ÊŠ\002Ê‹\002Æ´\002ƶ\002Ê’\002ƹ\002ƽ\002dž\002lj\002ÇŒ\003aÌŒ\003iÌŒ\003oÌŒ\003uÌŒ\005ǖ\005üÌ\005ǚ\005ǜ\005ǟ\005ǡ\004ǣ\002Ç¥\003gÌŒ\003kÌŒ\003ǫ\005ǭ\004Ê’ÌŒ\003jÌŒ\002dz\003gÌ\003nÌ€\005aÌŠÌ\004æÌ\004øÌ\003aÌ\003aÌ‘\003eÌ\003eÌ‘\003iÌ\003iÌ‘\003oÌ\003oÌ‘\003rÌ\003rÌ‘\003uÌ\003uÌ‘\003ș\003ț\003hÌŒ\003ȧ\003ȩ\005ȫ\005ȭ\003ȯ\005ȱ\003yÌ„\002Ì€\002Ì\002Ì“\004̈Ì\002ʹ\001;\004¨Ì\004αÌ\002·\004εÌ\004ηÌ\004ιÌ\004οÌ\004Ï…Ì\004ωÌ\006ϊÌ\002α\002β\002γ\002δ\002ε\002ζ\002η\002θ\002ι\002κ\002λ\002μ\002ν\002ξ\002ο\002Ï€\002Ï\002σ\002Ï„\002Ï…\002φ\002χ\002ψ\002ω\004ϊ\004ϋ\006ϋÌ\004Ï’Ì\004ϔ\002Ï£\002Ï¥\002ϧ\002Ï©\002Ï«\002Ï\002ϯ\004ѐ\004ё\002Ñ’\004гÌ\002Ñ”\002Ñ•\002Ñ–\004ї\002ј\002Ñ™\002Ñš\002Ñ›\004кÌ\004ѝ\004ў\002ÑŸ\002а\002б\002в\002г\002д\002е\002ж\002з\002и\004й\002к\002л\002м\002н\002о\002п\002Ñ€\002Ñ\002Ñ‚\002у\002Ñ„\002Ñ…\002ц\002ч\002ш\002щ\002ÑŠ\002Ñ‹\002ÑŒ\002Ñ\002ÑŽ\002Ñ\002Ñ¡\002Ñ£\002Ñ¥\002ѧ\002Ñ©\002Ñ«\002Ñ\002ѯ\002ѱ\002ѳ\002ѵ\004ѵÌ\002ѹ\002Ñ»\002ѽ\002Ñ¿\002Ò\002Ò‘\002Ò“\002Ò•\002Ò—\002Ò™\002Ò›\002Ò\002ÒŸ\002Ò¡\002Ò£\002Ò¥\002Ò§\002Ò©\002Ò«\002Ò\002Ò¯\002Ò±\002Ò³\002Òµ\002Ò·\002Ò¹\002Ò»\002Ò½\002Ò¿\004ӂ\002Ó„\002Óˆ\002ÓŒ\004ӑ\004ӓ\002Ó•\004ӗ\002Ó™\004ӛ\004ӝ\004ӟ\002Ó¡\004ӣ\004ӥ\004ӧ\002Ó©\004ӫ\004Ñ̈\004ӯ\004ӱ\004ӳ\004ӵ\004ӹ\002Õ¡\002Õ¢\002Õ£\002Õ¤\002Õ¥\002Õ¦\002Õ§\002Õ¨\002Õ©\002Õª\002Õ«\002Õ¬\002Õ\002Õ®\002Õ¯\002Õ°\002Õ±\002Õ²\002Õ³\002Õ´\002Õµ\002Õ¶\002Õ·\002Õ¸\002Õ¹\002Õº\002Õ»\002Õ¼\002Õ½\002Õ¾\002Õ¿\002Ö€\002Ö\002Ö‚\002Öƒ\002Ö„\002Ö…\002Ö†\004آ\004أ\004ÙˆÙ”\004إ\004ÙŠÙ”\004Û•Ù”\004ÛÙ”\004Û’Ù”\006ऩ\006ऱ\006ऴ\006क़\006ख़\006ग़\006ज़\006ड़\006ढ़\006फ़\006य़\006ো\006ৌ\006ড়\006ঢ়\006য়\006ਲ਼\006ਸ਼\006ਖ਼\006ਗ਼\006ਜ਼\006ਫ਼\006à‡à–\006à‡à¬¾\006à‡à—\006ଡ଼\006ଢ଼\006ஔ\006ொ\006ோ\006ௌ\006ై\006ೀ\006ೇ\006ೈ\006ೊ\009ೋ\006ൊ\006ോ\006ൌ\006ේ\006à·™à·\009à·™à·à·Š\006ෞ\006གྷ\006ཌྷ\006དྷ\006བྷ\006ཛྷ\006ཀྵ\006ཱི\006ཱུ\006ྲྀ\006ླྀ\006ཱྀ\006ྒྷ\006ྜྷ\006ྡྷ\006ྦྷ\006ྫྷ\006à¾à¾µ\006ဦ\003áƒ\003ბ\003გ\003დ\003ე\003ვ\003ზ\003თ\003ი\003კ\003ლ\003მ\003ნ\003áƒ\003პ\003ჟ\003რ\003ს\003ტ\003უ\003ფ\003ქ\003ღ\003ყ\003შ\003ჩ\003ც\003ძ\003წ\003áƒ\003ხ\003ჯ\003ჰ\003ჱ\003ჲ\003ჳ\003ჴ\003ჵ\003aÌ¥\003ḃ\003bÌ£\003ḇ\005çÌ\003ḋ\003dÌ£\003ḏ\003ḑ\003dÌ\005ḕ\005eÌ„Ì\003eÌ\003ḛ\005ḝ\003ḟ\003gÌ„\003ḣ\003hÌ£\003ḧ\003ḩ\003hÌ®\003ḭ\005ïÌ\003kÌ\003kÌ£\003ḵ\003lÌ£\005ḹ\003ḻ\003lÌ\003mÌ\003ṁ\003mÌ£\003ṅ\003nÌ£\003ṉ\003nÌ\005õÌ\005ṏ\005ṑ\005oÌ„Ì\003pÌ\003ṗ\003ṙ\003rÌ£\005ṝ\003ṟ\003ṡ\003sÌ£\005sÌ̇\005ṧ\005ṩ\003ṫ\003tÌ£\003ṯ\003tÌ\003ṳ\003ṵ\003uÌ\005ũÌ\005ṻ\003ṽ\003vÌ£\003wÌ€\003wÌ\003ẅ\003ẇ\003wÌ£\003ẋ\003ẍ\003ẏ\003zÌ‚\003zÌ£\003ẕ\003ẖ\003ẗ\003wÌŠ\003yÌŠ\004ẛ\003aÌ£\003ả\005aÌ‚Ì\005ầ\005ẩ\005ẫ\005ậ\005ăÌ\005ằ\005ẳ\005ẵ\005ặ\003eÌ£\003ẻ\003ẽ\005eÌ‚Ì\005ề\005ể\005ễ\005ệ\003ỉ\003iÌ£\003oÌ£\003ỏ\005oÌ‚Ì\005ồ\005ổ\005ỗ\005ộ\005oÌ›Ì\005ờ\005ở\005ỡ\005ợ\003uÌ£\003ủ\005uÌ›Ì\005ừ\005ử\005ữ\005ự\003yÌ€\003yÌ£\003ỷ\003ỹ\004ἀ\004ἁ\006ἂ\006ἃ\006ἀÌ\006ἁÌ\006ἆ\006ἇ\004ἐ\004ἑ\006ἒ\006ἓ\006ἐÌ\006ἑÌ\004ἠ\004ἡ\006ἢ\006ἣ\006ἠÌ\006ἡÌ\006ἦ\006ἧ\004ἰ\004ἱ\006ἲ\006ἳ\006ἰÌ\006ἱÌ\006ἶ\006ἷ\004ὀ\004ὁ\006ὂ\006ὃ\006ὀÌ\006ὁÌ\004Ï…Ì“\004Ï…Ì”\006ὒ\006ὓ\006Ï…Ì“Ì\006Ï…Ì”Ì\006ὖ\006ὗ\004ὠ\004ὡ\006ὢ\006ὣ\006ὠÌ\006ὡÌ\006ὦ\006ὧ\004ὰ\004ὲ\004ὴ\004ὶ\004ὸ\004Ï…Ì€\004ὼ\006ᾀ\006ᾁ\008ᾂ\008ᾃ\008ἀÌÍ…\008ἁÌÍ…\008ᾆ\008ᾇ\006ᾐ\006ᾑ\008ᾒ\008ᾓ\008ἠÌÍ…\008ἡÌÍ…\008ᾖ\008ᾗ\006ᾠ\006ᾡ\008ᾢ\008ᾣ\008ὠÌÍ…\008ὡÌÍ…\008ᾦ\008ᾧ\004ᾰ\004ᾱ\006ᾲ\004ᾳ\006αÌÍ…\004ᾶ\006ᾷ\004῁\006ῂ\004ῃ\006ηÌÍ…\004ῆ\006ῇ\005῍\005᾿Ì\005῏\004ῐ\004ῑ\006ῒ\004ῖ\006ῗ\005῝\005῾Ì\005῟\004ῠ\004Ï…Ì„\006ῢ\004ÏÌ“\004ÏÌ”\004Ï…Í‚\006ῧ\004῭\001`\006ῲ\004ῳ\006ωÌÍ…\004ῶ\006ῷ\002´\000\003â…°\003â…±\003â…²\003â…³\003â…´\003â…µ\003â…¶\003â…·\003â…¸\003â…¹\003â…º\003â…»\003â…¼\003â…½\003â…¾\003â…¿\003â“\003â“‘\003â“’\003â““\003â“”\003â“•\003â“–\003â“—\003ⓘ\003â“™\003ⓚ\003â“›\003ⓜ\003â“\003ⓞ\003ⓟ\003â“ \003â“¡\003â“¢\003â“£\003ⓤ\003â“¥\003ⓦ\003â“§\003ⓨ\003â“©\006ã‹ã‚™\006ãã‚™\006ãã‚™\006ã‘ã‚™\006ã“ã‚™\006ã•ã‚™\006ã—ã‚™\006ã™ã‚™\006ã›ã‚™\006ãã‚™\006ãŸã‚™\006ã¡ã‚™\006ã¤ã‚™\006ã¦ã‚™\006ã¨ã‚™\006ã¯ã‚™\006ã¯ã‚š\006ã²ã‚™\006ã²ã‚š\006ãµã‚™\006ãµã‚š\006ã¸ã‚™\006ã¸ã‚š\006ã»ã‚™\006ã»ã‚š\006ã†ã‚™\006ã‚ã‚™\006ã‚«ã‚™\006ã‚ã‚™\006グ\006ゲ\006ゴ\006ザ\006ã‚·ã‚™\006ズ\006ゼ\006ゾ\006ã‚¿ã‚™\006ãƒã‚™\006ヅ\006デ\006ド\006ãƒã‚™\006ãƒã‚š\006ビ\006ピ\006ブ\006プ\006ベ\006ペ\006ボ\006ポ\006ヴ\006ヷ\006ヸ\006ヹ\006ヺ\006ヾ\001\001\001\001\001\001\001\001\001 \001
\001\001\001
\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\"\001*\001:\001<\001>\001?\001\\\001|\001 \001.\004×™Ö´\004ײַ\004ש×\004שׂ\006שּ×\006שּׂ\004×Ö·\004×Ö¸\004×Ö¼\004בּ\004×’Ö¼\004דּ\004×”Ö¼\004וּ\004×–Ö¼\004טּ\004×™Ö¼\004ךּ\004×›Ö¼\004לּ\004מּ\004× Ö¼\004סּ\004×£Ö¼\004פּ\004צּ\004×§Ö¼\004רּ\004שּ\004תּ\004וֹ\004בֿ\004×›Ö¿\004פֿ\003ï½\003b\003c\003d\003ï½…\003f\003g\003h\003i\003j\003k\003l\003ï½\003n\003ï½\003ï½\003q\003ï½’\003s\003ï½”\003u\003ï½–\003ï½—\003x\003ï½™\003z"
let norm_prim =
"\000\000\000\002\003\004\005\006\007\000\000\000\000\008\009\010\011\012\013\014\015\016\000\000\017\000\000\018\000\000\000\000\000\000\000\000\019\020\000\021\022\023\000\000\000\024\025\026\000\027\000\028\000\029\000\030\000\000\000\000\000\031\032\000\033\000\034\035\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\036\037\038\039\040\041\042\043\044\045\000\000\000\046\000\000\000\000\000\000\000\000\000\000\000\000\047\048\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\049\050\051\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\052\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\053\054\000\000\000\000\000\000\000\000\000\000\000\000\000\055\056\000\000\000"
let norm_second_high =
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\000\002\002\002\002\002\002\002\000\002\002\002\002\002\002\000\002\002\002\002\002\002\002\002\002\000\002\002\002\002\002\002\000\000\002\002\002\002\002\000\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\000\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\000\002\002\002\002\002\002\002\002\002\000\002\000\002\002\002\002\000\002\002\002\002\002\002\002\000\002\000\002\002\002\002\002\002\000\003\000\003\003\003\003\003\003\003\000\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\000\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\002\003\003\003\003\003\003\000\000\003\003\000\003\000\003\003\000\003\003\003\000\000\003\003\003\003\000\003\003\000\003\003\003\000\000\000\003\003\000\003\003\003\003\000\003\000\000\003\000\003\000\000\003\000\003\003\003\003\003\003\000\003\000\003\003\000\000\000\003\000\000\000\000\000\000\000\003\003\000\003\003\000\003\003\000\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\000\004\004\004\004\004\004\004\000\004\004\004\004\004\004\004\004\004\004\004\004\004\000\004\004\000\000\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\000\000\004\004\000\000\000\000\000\000\004\004\004\004\004\004\004\004\004\004\004\004\004\004\000\000\000\000\000\000\000\000\000\000\000\000\004\004\000\004\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\004\004\004\004\004\004\000\004\000\004\004\004\004\004\004\004\004\005\005\005\005\005\005\005\005\005\005\005\005\000\005\005\005\005\005\005\005\005\005\004\004\004\004\005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\000\000\000\000\000\000\000\005\005\004\004\004\000\000\000\000\005\005\000\000\000\000\000\000\000\000\000\000\000\000\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\006\006\006\000\000\000\000\000\000\000\000\000\005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\005\000\005\000\000\000\005\000\000\000\000\005\005\005\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\006\006\000\006\000\006\000\006\000\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\000\006\006\006\000\000\000\006\000\000\000\006\000\000\000\000\006\006\006\006\006\000\006\006\006\000\006\006\006\006\006\006\006\000\006\006\006\006\006\006\006\000\006\006\006\006\006\006\006\006\006\006\006\006\000\000\006\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\006\006\006\006\006\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\007\007\007\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\000\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\000\000\000\000\000\000\000\007\000\000\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\007\007\007\007\007\007\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\007\000\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\000\000\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\008\008\000\000\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\000\000\000\000\008\008\000\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\008\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\000\000\000\000\000\000\000\008\000\000\000\000\008\000\000\000\000\008\000\000\000\000\008\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\000\000\000\000\000\000\000\008\000\008\008\000\009\000\000\000\000\000\000\000\000\009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\009\000\000\000\000\000\000\000\000\000\009\000\000\000\000\009\000\000\000\000\009\000\000\000\000\009\000\000\000\000\000\000\000\000\000\000\000\000\009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\000\011\000\000\000\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\000\000\000\000\000\000\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\000\000\012\012\012\012\012\012\000\000\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\013\013\000\000\012\012\012\012\013\013\000\000\013\013\013\013\013\013\013\013\000\013\000\013\000\013\000\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\004\013\004\013\004\013\004\013\004\013\004\013\004\000\000\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\014\014\014\014\013\013\013\013\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\000\014\014\014\014\013\004\014\000\005\000\000\014\014\014\014\000\014\014\013\004\013\004\014\014\014\014\014\014\014\004\000\000\014\014\014\014\013\004\000\014\014\014\014\014\015\005\015\015\015\015\014\014\013\004\015\015\004\015\000\000\015\015\015\000\015\015\013\004\013\004\015\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\015\015\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\015\015\015\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\015\015\015\015\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\000\015\000\015\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\000\016\000\016\000\016\000\000\000\000\000\000\016\016\000\016\016\000\016\016\000\016\016\000\016\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\000\017\000\017\000\017\000\000\000\000\000\000\017\017\000\017\017\000\017\017\000\017\017\000\017\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\000\000\017\017\017\017\000\000\000\017\000\000\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\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\017\000\017\000\000\000\000\000\000\000\000\000\000\017\017\017\017\017\018\018\018\018\018\018\018\018\000\018\018\018\018\018\000\018\000\018\018\000\018\018\000\018\018\018\018\018\018\018\018\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\018\018\018\018\018\018\018\018\018\018\018\018\018\018\018\018\018\018\018\018\018\018\018\018\018\000\000\000\000\000"
let norm_second_low =
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\008\012\016\020\024\027\031\035\039\043\047\051\055\059\063\066\070\074\078\082\086\000\090\093\097\101\105\109\113\000\000\004\008\012\016\020\000\027\031\035\039\043\047\051\055\059\000\066\070\074\078\082\086\000\000\093\097\101\105\109\000\116\120\120\124\124\128\128\132\132\136\136\140\140\144\144\148\148\152\000\155\155\159\159\163\163\167\167\171\171\175\175\179\179\183\183\187\187\191\191\195\000\198\198\202\202\206\206\210\210\214\000\218\000\221\221\225\225\000\229\229\233\233\237\237\241\000\244\000\247\247\251\251\255\255\000\003\000\006\006\010\010\014\014\018\000\021\021\025\025\029\029\033\033\037\037\041\041\045\045\049\049\053\053\057\000\060\060\064\064\068\068\072\072\076\076\080\080\084\084\088\088\116\092\092\096\096\100\100\000\000\104\107\000\110\000\113\116\000\119\122\125\000\000\128\131\134\137\000\140\143\000\146\149\152\000\000\000\155\158\000\161\164\164\168\000\171\000\000\174\000\177\000\000\180\000\183\186\186\190\193\196\000\199\000\202\205\000\000\000\208\000\000\000\000\000\000\000\211\211\000\214\214\000\217\217\000\220\220\224\224\228\228\232\232\236\236\242\242\248\248\254\254\000\004\004\010\010\016\016\021\000\024\024\028\028\032\032\036\036\042\042\047\051\051\000\054\054\000\000\058\058\062\062\068\068\073\073\078\078\082\082\086\086\090\090\094\094\098\098\102\102\106\106\110\110\114\114\118\118\122\122\126\126\130\130\000\000\134\134\000\000\000\000\000\000\138\138\142\142\146\146\152\152\158\158\162\162\168\168\000\000\000\000\000\000\000\000\000\000\000\000\172\175\000\178\181\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\186\000\000\000\000\000\000\000\000\000\189\000\000\000\000\000\000\191\196\201\204\209\214\000\219\000\224\229\234\241\244\247\250\253\000\003\006\009\012\015\018\021\024\027\030\033\000\036\039\042\045\048\051\054\057\062\196\204\209\214\067\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\036\000\000\000\000\000\000\000\057\062\219\224\229\000\000\000\000\074\079\000\000\000\000\000\000\000\000\000\000\000\000\000\084\000\087\000\090\000\093\000\096\000\099\000\102\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\105\110\115\118\123\126\129\132\137\140\143\146\149\154\159\164\167\170\173\176\179\182\185\188\191\194\199\202\205\208\211\214\217\220\223\226\229\232\235\238\241\244\247\250\253\000\003\006\000\000\000\000\000\000\000\000\000\194\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\105\110\000\118\000\000\000\132\000\000\000\000\149\154\159\000\009\000\012\000\015\000\018\000\021\000\024\000\027\000\030\000\033\000\036\000\039\000\042\042\047\000\050\000\053\000\056\000\059\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\062\000\065\000\068\000\071\000\074\000\077\000\080\000\083\000\086\000\089\000\092\000\095\000\098\000\101\000\104\000\107\000\110\000\113\000\116\000\119\000\122\000\125\000\128\000\131\000\000\134\134\139\000\000\000\142\000\000\000\145\000\000\000\000\148\148\153\153\158\000\161\161\166\000\169\169\174\174\179\179\184\000\187\187\192\192\197\197\202\000\205\205\210\210\215\215\220\220\225\225\230\230\000\000\235\235\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\240\243\246\249\252\255\002\005\008\011\014\017\020\023\026\029\032\035\038\041\044\047\050\053\056\059\062\065\068\071\074\077\080\083\086\089\092\095\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\098\103\108\113\118\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\123\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\133\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\138\000\000\000\000\000\000\000\145\000\000\152\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\159\166\173\180\187\194\201\208\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\215\222\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\229\236\000\243\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\250\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\015\022\000\000\029\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\036\000\000\043\050\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\057\064\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\071\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\078\085\092\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\099\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\106\000\000\000\000\000\000\113\120\000\127\134\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\144\151\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\165\000\172\179\189\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\000\000\000\000\000\000\000\000\000\203\000\000\000\000\210\000\000\000\000\217\000\000\000\000\224\000\000\000\000\000\000\000\000\000\000\000\000\231\000\000\000\000\000\000\000\000\000\238\000\245\252\000\003\000\000\000\000\000\000\000\000\010\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\000\000\000\000\000\000\000\000\000\024\000\000\000\000\031\000\000\000\000\038\000\000\000\000\045\000\000\000\000\000\000\000\000\000\000\000\000\052\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\059\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\066\070\074\078\082\086\090\094\098\102\106\110\114\118\122\126\130\134\138\142\146\150\154\158\162\166\170\174\178\182\186\190\194\198\202\206\210\214\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\218\218\222\222\226\226\230\230\234\234\240\240\244\244\248\248\252\252\000\000\004\004\010\010\016\016\020\020\024\024\030\030\034\034\038\038\042\042\046\046\050\050\054\054\058\058\062\062\068\068\072\072\076\076\080\080\084\084\090\090\094\094\098\098\102\102\106\106\110\110\114\114\118\118\122\122\126\126\132\132\138\138\144\144\150\150\154\154\158\158\162\162\166\166\172\172\176\176\180\180\184\184\190\190\196\196\202\202\206\206\210\210\214\214\218\218\222\222\226\226\230\230\236\236\242\242\246\246\250\250\254\254\002\002\006\006\010\010\014\014\018\018\022\022\026\026\030\030\034\034\038\042\046\050\000\054\000\000\000\000\059\059\063\063\067\067\073\073\079\079\085\085\091\091\097\097\103\103\109\109\115\115\121\121\127\127\131\131\135\135\139\139\145\145\151\151\157\157\163\163\169\169\173\173\177\177\181\181\185\185\191\191\197\197\203\203\209\209\215\215\221\221\227\227\233\233\239\239\245\245\249\249\253\253\003\003\009\009\015\015\021\021\027\027\031\031\035\035\039\039\000\000\000\000\000\000\043\048\053\060\067\074\081\088\043\048\053\060\067\074\081\088\095\100\105\112\119\126\000\000\095\100\105\112\119\126\000\000\133\138\143\150\157\164\171\178\133\138\143\150\157\164\171\178\185\190\195\202\209\216\223\230\185\190\195\202\209\216\223\230\237\242\247\254\005\012\000\000\237\242\247\254\005\012\000\000\019\024\029\036\043\050\057\064\000\024\000\036\000\050\000\064\071\076\081\088\095\102\109\116\071\076\081\088\095\102\109\116\123\196\128\204\133\209\138\214\143\219\148\224\153\229\000\000\158\165\172\181\190\199\208\217\158\165\172\181\190\199\208\217\226\233\240\249\002\011\020\029\226\233\240\249\002\011\020\029\038\045\052\061\070\079\088\097\038\045\052\061\070\079\088\097\106\111\116\123\128\000\135\140\106\111\123\196\123\000\009\000\000\147\152\159\164\000\171\176\128\204\133\209\159\183\189\195\201\206\211\234\000\000\218\223\201\206\138\214\000\230\236\242\248\253\002\067\009\014\019\024\248\253\148\224\014\031\191\036\000\000\038\045\050\000\057\062\143\219\153\229\045\069\000\000\000\000\000\000\000\000\000\000\000\000\000\000\072\072\072\072\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\072\072\072\072\072\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\072\072\072\072\072\072\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\073\077\081\085\089\093\097\101\105\109\113\117\121\125\129\133\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\137\141\145\149\153\157\161\165\169\173\177\181\185\189\193\197\201\205\209\213\217\221\225\229\233\237\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\241\000\248\000\255\000\006\000\013\000\020\000\027\000\034\000\041\000\048\000\055\000\062\000\000\069\000\076\000\083\000\000\000\000\000\000\090\097\000\104\111\000\118\125\000\132\139\000\146\153\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\160\000\000\000\000\000\000\000\000\000\167\000\000\000\000\000\000\000\000\000\000\000\000\000\174\000\181\000\188\000\195\000\202\000\209\000\216\000\223\000\230\000\237\000\244\000\251\000\000\002\000\009\000\016\000\000\000\000\000\000\023\030\000\037\044\000\051\058\000\065\072\000\079\086\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\093\000\000\100\107\114\121\000\000\000\128\000\000\135\137\139\141\143\145\147\149\151\153\155\157\159\161\163\165\167\169\171\173\175\177\179\181\183\185\187\189\191\193\195\197\199\201\203\205\207\209\211\213\215\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\217\000\222\000\000\000\000\000\000\000\000\000\000\227\232\237\244\251\000\005\010\015\020\025\030\035\000\040\045\050\055\060\000\065\000\070\075\000\080\085\000\090\095\100\105\110\115\120\125\130\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\072\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\135\139\143\147\151\155\159\163\167\171\175\179\183\187\191\195\199\203\207\211\215\219\223\227\231\235\000\000\000\000\000"
let decomp_ascii =
"\000\001\002\003\004\005\006\007\b\t\n\011\012\r\014\015\016\017\018\019\020\021\022\023\024\025\026\027\028\029\030\031 !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\127"
let decomp_repl =
"\003AÌ€\003AÌ\003AÌ‚\003Ã\003Ä\003AÌŠ\003Ç\003EÌ€\003EÌ\003EÌ‚\003Ë\003IÌ€\003IÌ\003IÌ‚\003Ï\003Ñ\003OÌ€\003OÌ\003OÌ‚\003Õ\003Ö\003UÌ€\003UÌ\003UÌ‚\003Ü\003YÌ\003aÌ€\003aÌ\003aÌ‚\003ã\003ä\003aÌŠ\003ç\003eÌ€\003eÌ\003eÌ‚\003ë\003iÌ€\003iÌ\003iÌ‚\003ï\003ñ\003oÌ€\003oÌ\003oÌ‚\003õ\003ö\003uÌ€\003uÌ\003uÌ‚\003ü\003yÌ\003ÿ\003AÌ„\003aÌ„\003Ă\003ă\003Ą\003ą\003CÌ\003cÌ\003CÌ‚\003cÌ‚\003Ċ\003ċ\003CÌŒ\003cÌŒ\003DÌŒ\003dÌŒ\003EÌ„\003eÌ„\003Ĕ\003ĕ\003Ė\003ė\003Ę\003ę\003EÌŒ\003eÌŒ\003GÌ‚\003gÌ‚\003Ğ\003ğ\003Ġ\003ġ\003Ģ\003ģ\003HÌ‚\003hÌ‚\003Ĩ\003ĩ\003IÌ„\003iÌ„\003Ĭ\003ĭ\003Į\003į\003İ\003JÌ‚\003jÌ‚\003Ķ\003ķ\003LÌ\003lÌ\003Ļ\003ļ\003LÌŒ\003lÌŒ\003NÌ\003nÌ\003Ņ\003ņ\003NÌŒ\003nÌŒ\003OÌ„\003oÌ„\003Ŏ\003ŏ\003OÌ‹\003oÌ‹\003RÌ\003rÌ\003Ŗ\003ŗ\003RÌŒ\003rÌŒ\003SÌ\003sÌ\003SÌ‚\003sÌ‚\003Ş\003ş\003SÌŒ\003sÌŒ\003Ţ\003ţ\003TÌŒ\003tÌŒ\003Ũ\003ũ\003UÌ„\003uÌ„\003Ŭ\003ŭ\003UÌŠ\003uÌŠ\003UÌ‹\003uÌ‹\003Ų\003ų\003WÌ‚\003wÌ‚\003YÌ‚\003yÌ‚\003Ÿ\003ZÌ\003zÌ\003Ż\003ż\003ZÌŒ\003zÌŒ\003OÌ›\003oÌ›\003UÌ›\003uÌ›\003AÌŒ\003aÌŒ\003IÌŒ\003iÌŒ\003OÌŒ\003oÌŒ\003UÌŒ\003uÌŒ\005Ǖ\005ǖ\005ÜÌ\005üÌ\005Ǚ\005ǚ\005Ǜ\005ǜ\005Ǟ\005ǟ\005Ǡ\005ǡ\004Ǣ\004ǣ\003GÌŒ\003gÌŒ\003KÌŒ\003kÌŒ\003Ǫ\003ǫ\005Ǭ\005ǭ\004Æ·ÌŒ\004Ê’ÌŒ\003jÌŒ\003GÌ\003gÌ\003NÌ€\003nÌ€\005AÌŠÌ\005aÌŠÌ\004ÆÌ\004æÌ\004ØÌ\004øÌ\003AÌ\003aÌ\003AÌ‘\003aÌ‘\003EÌ\003eÌ\003EÌ‘\003eÌ‘\003IÌ\003iÌ\003IÌ‘\003iÌ‘\003OÌ\003oÌ\003OÌ‘\003oÌ‘\003RÌ\003rÌ\003RÌ‘\003rÌ‘\003UÌ\003uÌ\003UÌ‘\003uÌ‘\003Ș\003ș\003Ț\003ț\003HÌŒ\003hÌŒ\003Ȧ\003ȧ\003Ȩ\003ȩ\005Ȫ\005ȫ\005Ȭ\005ȭ\003Ȯ\003ȯ\005Ȱ\005ȱ\003YÌ„\003yÌ„\002Ì€\002Ì\002Ì“\004̈Ì\002ʹ\001;\004¨Ì\004ΑÌ\002·\004ΕÌ\004ΗÌ\004ΙÌ\004ΟÌ\004Î¥Ì\004ΩÌ\006ϊÌ\004Ϊ\004Ϋ\004αÌ\004εÌ\004ηÌ\004ιÌ\006ϋÌ\004ϊ\004ϋ\004οÌ\004Ï…Ì\004ωÌ\004Ï’Ì\004ϔ\004Ѐ\004Ё\004ГÌ\004Ї\004КÌ\004Ѝ\004Ў\004Й\004й\004ѐ\004ё\004гÌ\004ї\004кÌ\004ѝ\004ў\004Ñ´Ì\004ѵÌ\004Ӂ\004ӂ\004Ð̆\004ӑ\004Ð̈\004ӓ\004Ӗ\004ӗ\004Ӛ\004ӛ\004Ӝ\004ӝ\004Ӟ\004ӟ\004Ӣ\004ӣ\004Ӥ\004ӥ\004Ӧ\004ӧ\004Ӫ\004ӫ\004Ð̈\004Ñ̈\004Ӯ\004ӯ\004Ӱ\004ӱ\004Ӳ\004ӳ\004Ӵ\004ӵ\004Ӹ\004ӹ\004آ\004أ\004ÙˆÙ”\004إ\004ÙŠÙ”\004Û•Ù”\004ÛÙ”\004Û’Ù”\006ऩ\006ऱ\006ऴ\006क़\006ख़\006ग़\006ज़\006ड़\006ढ़\006फ़\006य़\006ো\006ৌ\006ড়\006ঢ়\006য়\006ਲ਼\006ਸ਼\006ਖ਼\006ਗ਼\006ਜ਼\006ਫ਼\006à‡à–\006à‡à¬¾\006à‡à—\006ଡ଼\006ଢ଼\006ஔ\006ொ\006ோ\006ௌ\006ై\006ೀ\006ೇ\006ೈ\006ೊ\009ೋ\006ൊ\006ോ\006ൌ\006ේ\006à·™à·\009à·™à·à·Š\006ෞ\006གྷ\006ཌྷ\006དྷ\006བྷ\006ཛྷ\006ཀྵ\006ཱི\006ཱུ\006ྲྀ\006ླྀ\006ཱྀ\006ྒྷ\006ྜྷ\006ྡྷ\006ྦྷ\006ྫྷ\006à¾à¾µ\006ဦ\003AÌ¥\003aÌ¥\003Ḃ\003ḃ\003BÌ£\003bÌ£\003Ḇ\003ḇ\005ÇÌ\005çÌ\003Ḋ\003ḋ\003DÌ£\003dÌ£\003Ḏ\003ḏ\003Ḑ\003ḑ\003DÌ\003dÌ\005Ḕ\005ḕ\005EÌ„Ì\005eÌ„Ì\003EÌ\003eÌ\003Ḛ\003ḛ\005Ḝ\005ḝ\003Ḟ\003ḟ\003GÌ„\003gÌ„\003Ḣ\003ḣ\003HÌ£\003hÌ£\003Ḧ\003ḧ\003Ḩ\003ḩ\003HÌ®\003hÌ®\003Ḭ\003ḭ\005ÏÌ\005ïÌ\003KÌ\003kÌ\003KÌ£\003kÌ£\003Ḵ\003ḵ\003LÌ£\003lÌ£\005Ḹ\005ḹ\003Ḻ\003ḻ\003LÌ\003lÌ\003MÌ\003mÌ\003Ṁ\003ṁ\003MÌ£\003mÌ£\003Ṅ\003ṅ\003NÌ£\003nÌ£\003Ṉ\003ṉ\003NÌ\003nÌ\005ÕÌ\005õÌ\005Ṏ\005ṏ\005Ṑ\005ṑ\005OÌ„Ì\005oÌ„Ì\003PÌ\003pÌ\003Ṗ\003ṗ\003Ṙ\003ṙ\003RÌ£\003rÌ£\005Ṝ\005ṝ\003Ṟ\003ṟ\003Ṡ\003ṡ\003SÌ£\003sÌ£\005SÌ̇\005sÌ̇\005Ṧ\005ṧ\005Ṩ\005ṩ\003Ṫ\003ṫ\003TÌ£\003tÌ£\003Ṯ\003ṯ\003TÌ\003tÌ\003Ṳ\003ṳ\003Ṵ\003ṵ\003UÌ\003uÌ\005ŨÌ\005ũÌ\005Ṻ\005ṻ\003Ṽ\003ṽ\003VÌ£\003vÌ£\003WÌ€\003wÌ€\003WÌ\003wÌ\003Ẅ\003ẅ\003Ẇ\003ẇ\003WÌ£\003wÌ£\003Ẋ\003ẋ\003Ẍ\003ẍ\003Ẏ\003ẏ\003ZÌ‚\003zÌ‚\003ZÌ£\003zÌ£\003Ẕ\003ẕ\003ẖ\003ẗ\003wÌŠ\003yÌŠ\004ẛ\003AÌ£\003aÌ£\003Ả\003ả\005AÌ‚Ì\005aÌ‚Ì\005Ầ\005ầ\005Ẩ\005ẩ\005Ẫ\005ẫ\005Ậ\005ậ\005ĂÌ\005ăÌ\005Ằ\005ằ\005Ẳ\005ẳ\005Ẵ\005ẵ\005Ặ\005ặ\003EÌ£\003eÌ£\003Ẻ\003ẻ\003Ẽ\003ẽ\005EÌ‚Ì\005eÌ‚Ì\005Ề\005ề\005Ể\005ể\005Ễ\005ễ\005Ệ\005ệ\003Ỉ\003ỉ\003IÌ£\003iÌ£\003OÌ£\003oÌ£\003Ỏ\003ỏ\005OÌ‚Ì\005oÌ‚Ì\005Ồ\005ồ\005Ổ\005ổ\005Ỗ\005ỗ\005Ộ\005ộ\005OÌ›Ì\005oÌ›Ì\005Ờ\005ờ\005Ở\005ở\005Ỡ\005ỡ\005Ợ\005ợ\003UÌ£\003uÌ£\003Ủ\003ủ\005UÌ›Ì\005uÌ›Ì\005Ừ\005ừ\005Ử\005ử\005Ữ\005ữ\005Ự\005ự\003YÌ€\003yÌ€\003YÌ£\003yÌ£\003Ỷ\003ỷ\003Ỹ\003ỹ\004ἀ\004ἁ\006ἂ\006ἃ\006ἀÌ\006ἁÌ\006ἆ\006ἇ\004Ἀ\004Ἁ\006Ἂ\006Ἃ\006ἈÌ\006ἉÌ\006Ἆ\006Ἇ\004ἐ\004ἑ\006ἒ\006ἓ\006ἐÌ\006ἑÌ\004Ἐ\004Ἑ\006Ἒ\006Ἓ\006ἘÌ\006ἙÌ\004ἠ\004ἡ\006ἢ\006ἣ\006ἠÌ\006ἡÌ\006ἦ\006ἧ\004Ἠ\004Ἡ\006Ἢ\006Ἣ\006ἨÌ\006ἩÌ\006Ἦ\006Ἧ\004ἰ\004ἱ\006ἲ\006ἳ\006ἰÌ\006ἱÌ\006ἶ\006ἷ\004Ἰ\004Ἱ\006Ἲ\006Ἳ\006ἸÌ\006ἹÌ\006Ἶ\006Ἷ\004ὀ\004ὁ\006ὂ\006ὃ\006ὀÌ\006ὁÌ\004Ὀ\004Ὁ\006Ὂ\006Ὃ\006ὈÌ\006ὉÌ\004Ï…Ì“\004Ï…Ì”\006ὒ\006ὓ\006Ï…Ì“Ì\006Ï…Ì”Ì\006ὖ\006ὗ\004Ὑ\006Ὓ\006ὙÌ\006Ὗ\004ὠ\004ὡ\006ὢ\006ὣ\006ὠÌ\006ὡÌ\006ὦ\006ὧ\004Ὠ\004Ὡ\006Ὢ\006Ὣ\006ὨÌ\006ὩÌ\006Ὦ\006Ὧ\004ὰ\004ὲ\004ὴ\004ὶ\004ὸ\004Ï…Ì€\004ὼ\006ᾀ\006ᾁ\008ᾂ\008ᾃ\008ἀÌÍ…\008ἁÌÍ…\008ᾆ\008ᾇ\006ᾈ\006ᾉ\008ᾊ\008ᾋ\008ἈÌÍ…\008ἉÌÍ…\008ᾎ\008ᾏ\006ᾐ\006ᾑ\008ᾒ\008ᾓ\008ἠÌÍ…\008ἡÌÍ…\008ᾖ\008ᾗ\006ᾘ\006ᾙ\008ᾚ\008ᾛ\008ἨÌÍ…\008ἩÌÍ…\008ᾞ\008ᾟ\006ᾠ\006ᾡ\008ᾢ\008ᾣ\008ὠÌÍ…\008ὡÌÍ…\008ᾦ\008ᾧ\006ᾨ\006ᾩ\008ᾪ\008ᾫ\008ὨÌÍ…\008ὩÌÍ…\008ᾮ\008ᾯ\004ᾰ\004ᾱ\006ᾲ\004ᾳ\006αÌÍ…\004ᾶ\006ᾷ\004Ᾰ\004Ᾱ\004Ὰ\004ᾼ\002ι\004῁\006ῂ\004ῃ\006ηÌÍ…\004ῆ\006ῇ\004Ὲ\004Ὴ\004ῌ\005῍\005᾿Ì\005῏\004ῐ\004ῑ\006ῒ\004ῖ\006ῗ\004Ῐ\004Ῑ\004Ὶ\005῝\005῾Ì\005῟\004ῠ\004Ï…Ì„\006ῢ\004ÏÌ“\004ÏÌ”\004Ï…Í‚\006ῧ\004Ῠ\004Ῡ\004Ὺ\004Ῥ\004῭\001`\006ῲ\004ῳ\006ωÌÍ…\004ῶ\006ῷ\004Ὸ\004Ὼ\004ῼ\002´\006ã‹ã‚™\006ãã‚™\006ãã‚™\006ã‘ã‚™\006ã“ã‚™\006ã•ã‚™\006ã—ã‚™\006ã™ã‚™\006ã›ã‚™\006ãã‚™\006ãŸã‚™\006ã¡ã‚™\006ã¤ã‚™\006ã¦ã‚™\006ã¨ã‚™\006ã¯ã‚™\006ã¯ã‚š\006ã²ã‚™\006ã²ã‚š\006ãµã‚™\006ãµã‚š\006ã¸ã‚™\006ã¸ã‚š\006ã»ã‚™\006ã»ã‚š\006ã†ã‚™\006ã‚ã‚™\006ã‚«ã‚™\006ã‚ã‚™\006グ\006ゲ\006ゴ\006ザ\006ã‚·ã‚™\006ズ\006ゼ\006ゾ\006ã‚¿ã‚™\006ãƒã‚™\006ヅ\006デ\006ド\006ãƒã‚™\006ãƒã‚š\006ビ\006ピ\006ブ\006プ\006ベ\006ペ\006ボ\006ポ\006ヴ\006ヷ\006ヸ\006ヹ\006ヺ\006ヾ\001\001\001\001\001\001\001\001\001 \001
\001\001\001
\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\"\001*\001:\001<\001>\001?\001\\\001|\001 \001.\004×™Ö´\004ײַ\004ש×\004שׂ\006שּ×\006שּׂ\004×Ö·\004×Ö¸\004×Ö¼\004בּ\004×’Ö¼\004דּ\004×”Ö¼\004וּ\004×–Ö¼\004טּ\004×™Ö¼\004ךּ\004×›Ö¼\004לּ\004מּ\004× Ö¼\004סּ\004×£Ö¼\004פּ\004צּ\004×§Ö¼\004רּ\004שּ\004תּ\004וֹ\004בֿ\004×›Ö¿\004פֿ"
let decomp_prim =
"\000\000\000\002\003\004\005\006\007\000\000\000\000\008\009\010\011\012\000\013\000\000\000\000\014\000\000\015\000\000\000\000\000\000\000\000\016\017\000\018\019\020\000\000\000\021\022\023\000\024\000\025\000\026\000\027\000\000\000\000\000\028\029\000\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\031\032\033\034\035\036\037\038\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\039\040\041\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\042\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\043\044\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
let decomp_second_high =
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\002\002\002\002\002\002\000\002\002\002\002\002\002\002\002\002\000\002\002\002\002\002\002\000\000\002\002\002\002\002\000\000\002\002\002\002\002\002\000\002\002\002\002\002\002\002\002\002\000\002\002\002\002\002\002\000\000\002\002\002\002\002\000\002\002\002\002\002\002\002\002\002\002\002\002\003\003\003\003\003\000\000\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\000\000\003\003\003\003\003\003\003\003\003\000\000\000\003\003\003\003\000\003\003\003\003\003\003\000\000\000\000\003\003\003\003\003\003\000\000\000\003\003\003\003\003\003\000\000\003\003\003\003\003\003\003\003\004\004\004\004\004\004\004\004\004\004\000\000\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\004\000\000\000\000\000\000\000\000\000\000\000\000\000\004\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\000\004\004\004\004\004\005\000\000\005\005\005\005\005\005\005\005\005\005\005\000\000\000\005\005\000\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\000\000\005\005\000\000\000\000\000\000\005\005\005\005\005\005\005\006\006\006\006\006\006\006\000\000\000\000\000\000\000\000\000\000\000\000\006\006\000\006\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\006\006\006\006\006\006\000\006\000\006\006\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\006\006\006\006\006\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\006\006\006\006\000\000\000\000\006\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\006\000\006\000\000\000\006\000\000\000\000\006\006\006\000\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\006\000\006\000\000\000\006\000\000\000\000\006\006\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\007\000\000\000\000\000\000\000\000\000\007\007\000\000\000\000\000\000\000\000\000\000\000\000\000\007\007\007\007\000\000\007\007\000\000\007\007\007\007\007\007\000\000\007\007\007\007\007\007\000\000\007\007\007\007\007\007\007\007\007\007\007\007\000\000\007\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\007\007\007\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\000\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\000\000\000\000\000\000\000\007\000\000\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\007\008\008\008\008\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\008\000\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\008\008\000\000\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\000\000\000\000\008\008\000\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\008\009\009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\009\000\000\000\000\000\000\000\000\000\009\000\000\000\000\009\000\000\000\000\009\000\000\000\000\009\000\000\000\000\000\000\000\000\000\000\000\000\009\000\000\000\000\000\000\000\000\000\009\000\009\009\000\009\000\000\000\000\000\000\000\000\009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\009\000\000\000\000\000\000\000\000\000\009\000\000\000\000\009\000\000\000\000\009\000\000\000\000\009\000\000\000\000\000\000\000\000\000\000\000\000\009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\000\012\000\000\000\000\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\014\014\014\014\014\014\014\014\000\000\000\000\000\000\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\000\000\014\014\014\014\014\014\000\000\014\014\014\014\014\014\014\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\000\000\015\015\015\015\015\015\000\000\015\015\015\016\016\016\016\016\000\016\000\016\000\016\000\016\016\016\016\016\016\016\016\016\016\016\016\016\016\016\016\016\016\006\016\006\016\006\016\006\016\006\016\006\016\006\000\000\016\016\016\016\016\016\016\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\018\018\018\018\018\018\018\018\018\018\018\018\018\018\018\018\000\018\018\018\018\018\006\018\000\018\000\000\018\018\018\018\000\018\018\018\006\018\006\018\018\018\018\018\018\018\006\000\000\018\018\019\019\019\006\000\019\019\019\019\019\019\006\019\019\019\019\019\019\019\006\019\019\006\019\000\000\019\019\019\000\019\019\019\006\019\006\019\019\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\000\019\000\019\000\019\000\019\000\019\000\019\000\019\000\019\000\019\000\019\000\019\000\000\019\000\019\000\019\000\000\000\000\000\000\020\020\000\020\020\000\020\020\000\020\020\000\020\020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\020\000\000\000\000\000\000\000\000\000\020\000\000\000\000\000\000\000\000\000\000\000\000\000\020\000\020\000\020\000\020\000\020\000\020\000\020\000\020\000\020\000\020\000\020\000\020\000\000\020\000\020\000\020\000\000\000\000\000\000\020\020\000\020\020\000\020\020\000\020\020\000\020\020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\021\000\000\021\021\021\021\000\000\000\021\000\000\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\021\000\021\000\000\000\000\000\000\000\000\000\000\021\021\021\021\021\021\021\021\021\021\021\021\021\000\021\021\021\021\021\000\021\000\021\021\000\021\021\000\022\022\022\022\022\022\022\022\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"
let decomp_second_low =
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\008\012\016\020\000\024\028\032\036\040\044\048\052\056\000\060\064\068\072\076\080\000\000\084\088\092\096\100\000\000\104\108\112\116\120\124\000\128\132\136\140\144\148\152\156\160\000\164\168\172\176\180\184\000\000\188\192\196\200\204\000\208\212\216\220\224\228\232\236\240\244\248\252\000\004\008\012\016\000\000\020\024\028\032\036\040\044\048\052\056\060\064\068\072\076\080\084\088\092\096\000\000\100\104\108\112\116\120\124\128\132\000\000\000\136\140\144\148\000\152\156\160\164\168\172\000\000\000\000\176\180\184\188\192\196\000\000\000\200\204\208\212\216\220\000\000\224\228\232\236\240\244\248\252\000\004\008\012\016\020\024\028\032\036\000\000\040\044\048\052\056\060\064\068\072\076\080\084\088\092\096\100\104\108\112\116\120\124\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\136\000\000\000\000\000\000\000\000\000\000\000\000\000\140\144\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\148\152\156\160\164\168\172\176\180\186\192\198\204\210\216\222\000\228\234\240\246\252\001\000\000\006\010\014\018\022\026\030\036\042\047\052\000\000\000\056\060\000\000\064\068\072\078\084\089\094\099\104\108\112\116\120\124\128\132\136\140\144\148\152\156\160\164\168\172\176\180\184\188\192\196\200\204\208\212\000\000\216\220\000\000\000\000\000\000\224\228\232\236\240\246\252\002\008\012\016\022\028\032\000\000\000\000\000\000\000\000\000\000\000\000\036\039\000\042\045\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\050\000\000\000\000\000\000\000\000\000\053\000\000\000\000\000\000\055\060\065\068\073\078\000\083\000\088\093\098\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\105\110\115\120\125\130\135\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\142\147\152\157\162\000\000\000\000\167\172\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\177\182\000\187\000\000\000\192\000\000\000\000\197\202\207\000\000\000\000\000\000\000\000\000\000\212\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\217\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\222\227\000\232\000\000\000\237\000\000\000\000\242\247\252\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\006\000\000\000\000\000\000\000\000\000\011\016\000\000\000\000\000\000\000\000\000\000\000\000\000\021\026\031\036\000\000\041\046\000\000\051\056\061\066\071\076\000\000\081\086\091\096\101\106\000\000\111\116\121\126\131\136\141\146\151\156\161\166\000\000\171\176\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\181\186\191\196\201\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\206\000\211\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\216\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\221\000\000\000\000\000\000\000\228\000\000\235\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\242\249\000\007\014\021\028\035\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\042\049\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\056\063\000\070\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\077\000\000\084\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\091\098\105\000\000\112\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\119\000\000\126\133\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\140\147\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\161\168\175\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\182\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\189\000\000\000\000\000\000\196\203\000\210\217\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\227\234\241\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\248\000\255\006\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\023\000\000\000\000\000\000\000\000\000\030\000\000\000\000\037\000\000\000\000\044\000\000\000\000\051\000\000\000\000\000\000\000\000\000\000\000\000\058\000\000\000\000\000\000\000\000\000\065\000\072\079\000\086\000\000\000\000\000\000\000\000\093\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\100\000\000\000\000\000\000\000\000\000\107\000\000\000\000\114\000\000\000\000\121\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\135\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\149\153\157\161\165\169\173\177\181\187\193\197\201\205\209\213\217\221\225\229\233\239\245\251\001\005\009\013\017\023\029\033\037\041\045\049\053\057\061\065\069\073\077\081\085\089\093\099\105\109\113\117\121\125\129\133\137\143\149\153\157\161\165\169\173\177\181\185\189\193\197\201\205\209\213\217\221\227\233\239\245\251\001\007\013\017\021\025\029\033\037\041\045\051\057\061\065\069\073\077\081\087\093\099\105\111\117\121\125\129\133\137\141\145\149\153\157\161\165\169\173\179\185\191\197\201\205\209\213\217\221\225\229\233\237\241\245\249\253\001\005\009\013\017\021\025\029\033\037\041\045\049\053\057\000\061\000\000\000\000\066\070\074\078\082\088\094\100\106\112\118\124\130\136\142\148\154\160\166\172\178\184\190\196\202\206\210\214\218\222\226\232\238\244\250\000\006\012\018\024\030\034\038\042\046\050\054\058\062\068\074\080\086\092\098\104\110\116\122\128\134\140\146\152\158\164\170\176\182\186\190\194\198\204\210\216\222\228\234\240\246\252\002\006\010\014\018\022\026\030\000\000\000\000\000\000\034\039\044\051\058\065\072\079\086\091\096\103\110\117\124\131\138\143\148\155\162\169\000\000\176\181\186\193\200\207\000\000\214\219\224\231\238\245\252\003\010\015\020\027\034\041\048\055\062\067\072\079\086\093\100\107\114\119\124\131\138\145\152\159\166\171\176\183\190\197\000\000\204\209\214\221\228\235\000\000\242\247\252\003\010\017\024\031\000\038\000\043\000\050\000\057\064\069\074\081\088\095\102\109\116\121\126\133\140\147\154\161\168\115\173\120\178\125\183\130\188\152\193\157\198\162\000\000\203\210\217\226\235\244\253\006\015\022\029\038\047\056\065\074\083\090\097\106\115\124\133\142\151\158\165\174\183\192\201\210\219\226\233\242\251\004\013\022\031\038\045\054\063\072\081\090\099\104\109\116\121\000\128\133\140\145\150\060\155\000\160\000\000\163\168\175\180\000\187\192\199\068\204\073\209\214\220\226\232\237\242\098\000\000\249\254\005\010\015\078\000\020\026\032\038\043\048\135\055\060\065\070\077\082\087\088\092\097\055\102\000\000\104\111\116\000\123\128\135\083\140\093\145\150\000\000\000\000\000\000\000\000\000\000\000\000\000\000\153\000\160\000\167\000\174\000\181\000\188\000\195\000\202\000\209\000\216\000\223\000\230\000\000\237\000\244\000\251\000\000\000\000\000\000\002\009\000\016\023\000\030\037\000\044\051\000\058\065\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\072\000\000\000\000\000\000\000\000\000\079\000\000\000\000\000\000\000\000\000\000\000\000\000\086\000\093\000\100\000\107\000\114\000\121\000\128\000\135\000\142\000\149\000\156\000\163\000\000\170\000\177\000\184\000\000\000\000\000\000\191\198\000\205\212\000\219\226\000\233\240\000\247\254\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\000\000\012\019\026\033\000\000\000\040\000\000\047\049\051\053\055\057\059\061\063\065\067\069\071\073\075\077\079\081\083\085\087\089\091\093\095\097\099\101\103\105\107\109\111\113\115\117\119\121\123\125\127\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\129\000\134\000\000\000\000\000\000\000\000\000\000\139\144\149\156\163\168\173\178\183\188\193\198\203\000\208\213\218\223\228\000\233\000\238\243\000\248\253\000\002\007\012\017\022\027\032\037\042\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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.48.3/unison.hgr 000644 000766 000000 00000000577 10201555717 016067 0 ustar 00bcpierce wheel 000000 000000 # 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.48.3/update.ml 000644 000766 000000 00000305710 12450317305 015660 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/update.ml *)
(* Copyright 1999-2015, 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"
let ignoreArchives =
Prefs.createBool "ignorearchives" false
"!ignore existing archive files"
("When this preference is set, Unison will ignore any existing "
^ "archive files and behave as though it were being run for the first "
^ "time on these replicas. It is "
^ "not a good idea to set this option in a profile: it is intended for "
^ "command-line use.")
(*****************************************************************************)
(* 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: also change Fileinfo.stamp to drop the info.ctime component, next
time the format is modified *)
(*FIX: also make Jerome's suggested change about file times (see his mesg in
unison-pending email folder). *)
(*FIX: we could also drop the use of 8.3-style filenames on Windows, next
time the format is changed *)
(* FIX: use a special stamp rather than the current hack to leave a flag
in the archive when a file transfer fails so as to turn off fastcheck
for this file on the next sync. *)
(*FIX: consider changing the way case-sensitivity mode is stored in
the archive *)
(*FIX: we should use only one Marshal.from_channel *)
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 | FPCache
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" | FPCache -> "fp"
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 *)
(* Note that we build the current path as a list of names, as this is
much cheaper than using values of type [Path.t] *)
let rec checkArchive
(top: bool) (path: Name.t list) (arch: archive) (h: int): int =
match arch with
ArchiveDir (desc, children) ->
begin match NameMap.validate children with
`Ok ->
()
| `Duplicate nm ->
let path =
List.fold_right (fun n p -> Path.child p n) path Path.empty in
raise
(Util.Fatal (Printf.sprintf
"Corrupted archive: \
the file %s occurs twice in path %s"
(Name.toString nm) (Path.toString path)));
| `Invalid (nm, nm') ->
let path =
List.fold_right (fun n p -> Path.child p n) path Path.empty in
raise
(Util.Fatal (Printf.sprintf
"Corrupted archive: the files %s and %s are not \
correctely ordered in directory %s"
(Name.toString nm) (Name.toString nm')
(Path.toString path)));
end;
NameMap.fold
(fun n a h ->
Uutil.hash2 (Name.hash n)
(checkArchive false (n :: path) a h))
children (Props.hash desc h)
| ArchiveFile (desc, dig, _, ress) ->
Uutil.hash2 (Uutil.hash dig) (Props.hash desc h)
| ArchiveSymlink content ->
Uutil.hash2 (Uutil.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 (),
System.file_exists (Os.fileInUnisonDir name)))
(*****************************************************************************)
(* 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 (thisRoot: string) :
(archive * int * string * Proplist.t) option =
debug (fun() ->
Util.msg "Loading archive from %s\n" (System.fspathToDebugString fspath));
Util.convertUnixErrorsToFatal "loading archive" (fun () ->
if System.file_exists fspath then
let c = System.open_in_bin fspath in
let header = input_line c in
(* Sanity check on archive format *)
if header<>formatString then begin
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
let properties =
try
ignore (input_char c); (* Marker *)
Marshal.from_channel c
with End_of_file ->
Proplist.empty
in
close_in c;
Some (archive, hash, magic, properties)
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"
(System.fspathToDebugString fspath));
None))
(* Inverse to loadArchiveLocal *)
let storeArchiveLocal fspath thisRoot archive hash magic properties =
debug (fun() ->
Util.msg "Saving archive in %s\n" (System.fspathToDebugString fspath));
Util.convertUnixErrorsToFatal "saving archive" (fun () ->
let c =
System.open_out_gen
[Open_wronly; Open_creat; Open_trunc; Open_binary] 0o600 fspath
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.ops())#modeDesc));
Marshal.to_channel c (archive, hash, magic) [Marshal.No_sharing];
output_char c '\000'; (* Marker that indicates that the archive
is followed by a property list *)
Marshal.to_channel c properties [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 fspath = Os.fileInUnisonDir name in
debug (fun() ->
Util.msg "Removing archive %s\n" (System.fspathToDebugString fspath));
Util.convertUnixErrorsToFatal "removing archive" (fun () ->
try System.unlink fspath
with Unix.Unix_error (Unix.ENOENT, _, _) -> ()))
(* [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 = Os.fileInUnisonDir fromname in
let fto = Os.fileInUnisonDir toname in
Util.convertUnixErrorsToFatal
"committing"
(fun () -> System.rename ffrom fto))
(* [commitArchiveOnRoot root v] invokes [commitArchive fspath v] on the
server, where [fspath] is the path to root on the server *)
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 = Os.fileInUnisonDir fromname in
let fto = Os.fileInUnisonDir toname in
debug (fun() ->
Util.msg "Copying archive %s to %s\n"
(System.fspathToDebugString ffrom)
(System.fspathToDebugString fto));
Util.convertUnixErrorsToFatal "copying archive" (fun () ->
begin try
System.unlink fto
with Unix.Unix_error (Unix.ENOENT, _, _) -> () end;
begin try
System.link ffrom fto
with Unix.Unix_error _ ->
let outFd =
System.open_out_gen
[Open_wronly; Open_creat; Open_trunc; Open_binary] 0o600 fto in
System.chmod fto 0o600; (* In case the file already existed *)
let inFd = System.open_in_bin ffrom in
Uutil.readWrite inFd outFd (fun _ -> ());
close_in inFd;
close_out outFd
end;
let arcFspath = Os.fileInUnisonDir toname in
let info = Fileinfo.get' arcFspath 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
(* 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
(* archiveCache: map(rootGlobalName, property list) *)
let archivePropCache = Hashtbl.create 7
(* Retrieve an archive property list from the cache *)
let getArchiveProps (thisRoot: string): Proplist.t =
Hashtbl.find archivePropCache thisRoot
(* Update the property list cache. *)
let setArchivePropsLocal (thisRoot: string) (props: Proplist.t) =
Hashtbl.replace archivePropCache thisRoot props
let fileUnchanged oldInfo newInfo =
oldInfo.Fileinfo.typ = `FILE && newInfo.Fileinfo.typ = `FILE
&&
Props.same_time oldInfo.Fileinfo.desc newInfo.Fileinfo.desc
&&
Props.length oldInfo.Fileinfo.desc = Props.length newInfo.Fileinfo.desc
&&
match Fileinfo.stamp oldInfo, Fileinfo.stamp newInfo with
Fileinfo.InodeStamp in1, Fileinfo.InodeStamp in2 -> in1 = in2
| Fileinfo.CtimeStamp _, Fileinfo.CtimeStamp _ -> true
| _ -> 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"
(System.fspathToDebugString f));
let ch = System.open_out_gen [Open_wronly; Open_creat; Open_trunc] 0o600 f in
let (outfn,flushfn) = Format.get_formatter_output_functions () in
Format.set_formatter_out_channel ch;
Format.printf "Contents of archive for %s\n" root;
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
(*****************************************************************************)
(* ARCHIVE CASE CONVERSION *)
(*****************************************************************************)
(* Stamp for marking unchange directories *)
let dirStampKey : Props.dirChangedStamp Proplist.key =
Proplist.register "unchanged directory stamp"
(* Property containing a description of the archive case sensitivity mode *)
let caseKey : string Proplist.key = Proplist.register "case mode"
(* Turn a case sensitive archive into a case insensitive archive.
Directory children are resorted and duplicates are removed.
*)
let rec makeCaseSensitiveRec arch =
match arch with
ArchiveDir (desc, children) ->
let dups = ref [] in
let children =
NameMap.fold
(fun nm ch chs ->
if Name.badEncoding nm then chs else begin
if NameMap.mem nm chs then dups := nm :: !dups;
NameMap.add nm (makeCaseSensitiveRec ch) chs
end)
children NameMap.empty
in
let children =
List.fold_left (fun chs nm -> NameMap.remove nm chs) children !dups in
ArchiveDir (desc, children)
| ArchiveFile _ | ArchiveSymlink _ | NoArchive ->
arch
let makeCaseSensitive thisRoot =
setArchiveLocal thisRoot (makeCaseSensitiveRec (getArchive thisRoot));
(* We need to recheck all directories, so we mark them possibly changed *)
setArchivePropsLocal thisRoot
(Proplist.add dirStampKey (Props.freshDirStamp ())
(Proplist.add caseKey (Case.ops ())#modeDesc
(getArchiveProps thisRoot)))
let makeCaseSensitiveOnRoot =
Remote.registerRootCmd "makeCaseSensitive"
(fun (fspath, ()) ->
makeCaseSensitive (thisRootsGlobalName fspath);
Lwt.return ())
(*FIX: remove when Unison version > 2.40 *)
let canMakeCaseSensitive () =
Globals.allRootsMap (fun r -> Remote.commandAvailable r "makeCaseSensitive")
>>= fun l ->
Lwt.return (List.for_all (fun x -> x) l)
(****)
(* Get the archive case sensitivity mode from the archive magic. *)
let archiveMode magic =
let currentMode = (Case.ops ())#modeDesc in
if magic = "" then currentMode (* Newly created archive *) else
try
String.sub magic 0 (String.index magic '\000')
with Not_found ->
(* Legacy format. Cannot be Unicode case insensitive. *)
if (Case.ops ())#mode = Case.UnicodeInsensitive then
"some non-Unicode"
else
currentMode
let checkArchiveCaseSensitivity l =
let root = thisRootsGlobalName (snd (Globals.localRoot ())) in
let curMode = (Case.ops ())#modeDesc in
let archMode = Proplist.find caseKey (getArchiveProps root) in
if curMode = archMode then
Lwt.return ()
else begin
begin if archMode = Case.caseSensitiveModeDesc then
canMakeCaseSensitive ()
else
Lwt.return false
end >>= fun convert ->
if convert then
Globals.allRootsIter (fun r -> makeCaseSensitiveOnRoot r ())
else 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 were created in %s mode." archMode ::
"You should either change Unison's setup or delete" ::
"the following archives from the .unison directories:" ::
l @
["(or invoke Unison once with -ignorearchives flag).";
"Then, try again."])))
end
end
(****)
let rec populateCacheFromArchiveRec path arch =
match arch with
ArchiveDir (_, children) ->
NameMap.iter
(fun nm ch -> populateCacheFromArchiveRec (Path.child path nm) ch)
children
| ArchiveFile (desc, dig, stamp, ress) ->
Fpcache.save path (desc, dig, stamp, ress)
| ArchiveSymlink _ | NoArchive ->
()
let populateCacheFromArchive fspath arch =
let (cacheFilename, _) = archiveName fspath FPCache in
let cacheFile = Os.fileInUnisonDir cacheFilename in
Fpcache.init true (Prefs.read ignoreArchives) cacheFile;
populateCacheFromArchiveRec Path.empty arch;
Fpcache.finish ()
(*************************************************************************)
(* Loading archives *)
(*************************************************************************)
let setArchiveData thisRoot fspath (arch, hash, magic, properties) info =
let archMode = archiveMode magic in
let curMode = (Case.ops ())#modeDesc in
let properties = Proplist.add caseKey archMode properties in
setArchiveLocal thisRoot arch;
setArchivePropsLocal thisRoot properties;
Hashtbl.replace archiveInfoCache thisRoot info;
if archMode <> curMode then populateCacheFromArchive fspath arch;
Lwt.return (Some (hash, magic))
let clearArchiveData thisRoot =
setArchiveLocal thisRoot NoArchive;
setArchivePropsLocal thisRoot
(Proplist.add caseKey (Case.ops ())#modeDesc Proplist.empty);
Hashtbl.remove archiveInfoCache thisRoot;
Lwt.return (Some (0, ""))
(* 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 Prefs.read ignoreArchives then begin
foundArchives := false;
clearArchiveData thisRoot
end else 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. *)
System.file_exists (Os.fileInUnisonDir newArcName)
||
let (lockFilename, _) = archiveName fspath Lock in
let lockFile = Os.fileInUnisonDir lockFilename in
Lock.is_locked lockFile
then
Lwt.return None
else
let (arcName,thisRoot) = archiveName fspath MainArch in
let arcFspath = Os.fileInUnisonDir arcName in
let info = Fileinfo.get' arcFspath 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 archData ->
let info' = Fileinfo.get' arcFspath in
if fileUnchanged info info' then
setArchiveData thisRoot fspath archData info
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 archData ->
setArchiveData thisRoot fspath archData (Fileinfo.get' arcFspath)
| None ->
(* No archive found *)
clearArchiveData thisRoot
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) =
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"
^ "It can also happen when one copy of Unison has been compiled with\n"
^ "OCaml version 3 and one with OCaml version 4.\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\n"
^ " 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"
(System.fspathToPrintString 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"));
Lwt.return (identicals, checksums))
(*****************************************************************************)
(* Archive locking *)
(*****************************************************************************)
let lockArchiveLocal fspath =
let (lockFilename, _) = archiveName fspath Lock in
let lockFile = Os.fileInUnisonDir lockFilename in
if Lock.acquire lockFile then
None
else
Some (Printf.sprintf "The file %s on host %s should be deleted"
(System.fspathToPrintString 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
(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 =
System.file_exists (Os.fileInUnisonDir oldname) in
let (newname,_) = archiveName fspath NewArch in
let newexists =
System.file_exists (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";
"or invoke Unison with -ignorearchives flag."]))))
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: 'a Path.path)
(action: archive -> Path.local -> archive):
archive
=
debugverbose
(fun() ->
Printf.eprintf "updatePathInArchive %s %s [%s] [%s]\n"
(archive2string archive) (Fspath.toDebugString fspath)
(Path.toString here) (Path.toString rest));
match Path.deconstruct rest with
None ->
action archive 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 ->
if NameMap.is_empty otherChildren && desc == Props.dummy then
NoArchive
else
ArchiveDir (desc, otherChildren)
| child ->
ArchiveDir (desc, NameMap.add name' child otherChildren)
(*************************************************************************)
(* 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))
(***********************************************************************
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.toPrintString fspath) (Path.toString path)
(Os.myCanonicalHostName ()))))
(Prefs.read mountpoints)
(***********************************************************************
Set of paths
************************************************************************)
type pathTree = PathTreeLeaf
| PathTreeNode of pathTree NameMap.t
let rec addPathToTree path tree =
match Path.deconstruct path, tree with
None, _ | _, Some PathTreeLeaf ->
PathTreeLeaf
| Some (nm, p), None ->
PathTreeNode (NameMap.add nm (addPathToTree p None) NameMap.empty)
| Some (nm, p), Some (PathTreeNode children) ->
let t = try Some (NameMap.find nm children) with Not_found -> None in
PathTreeNode (NameMap.add nm (addPathToTree p t) children)
let rec removePathFromTree path tree =
match Path.deconstruct path, tree with
None, _ ->
None
| Some (nm, p), PathTreeLeaf ->
Some tree
| Some (nm, p), PathTreeNode children ->
try
let t = NameMap.find nm children in
match removePathFromTree p t with
None ->
let newChildren = NameMap.remove nm children in
if NameMap.is_empty children then None else
Some (PathTreeNode newChildren)
| Some t ->
Some (PathTreeNode (NameMap.add nm t children))
with Not_found ->
Some tree
let pathTreeOfList l =
Safelist.fold_left (fun t p -> Some (addPathToTree p t)) None l
let removePathsFromTree l treeOpt =
Safelist.fold_left
(fun t p ->
match t with
None -> None
| Some t -> removePathFromTree p t)
treeOpt l
let rec getSubTree path tree =
match Path.deconstruct path, tree with
None, _ ->
Some tree
| Some (nm, p), PathTreeLeaf ->
Some PathTreeLeaf
| Some (nm, p), PathTreeNode children ->
try
let t = NameMap.find nm children in
getSubTree p t
with Not_found ->
None
(***********************************************************************
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.createBoolWithDefault "fastcheck"
"!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. (This does not \
apply to the very first run, when Unison will always scan \
all files regarless of this switch). 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. \
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 = `True
|| (Prefs.read fastcheck = `Default (*&& 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}.")
type scanInfo =
{ fastCheck : bool;
dirFastCheck : bool;
dirStamp : Props.dirChangedStamp;
archHash : string;
showStatus : bool }
(** 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 scanInfo info =
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)
let showStatus scanInfo path =
fileLength := !fileLength + smallFileLength;
if !fileLength >= bigFileLength then begin
fileLength := 0;
let t = Unix.gettimeofday () in
if t -. !t0 > 0.05 then begin
if scanInfo.showStatus then
Uutil.showUpdateStatus (Path.toString path);
t0 := t
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 the directory immediate children may have changed *)
let rec noChildChange childUpdates =
match childUpdates with
[] ->
true
| (_, Updates (File _, Previous (`FILE, _, _, _))) :: rem
| (_, Updates (Dir _, Previous (`DIRECTORY, _, _, _))) :: rem
| (_, Updates (Symlink _, Previous (`SYMLINK, _, _, _))) :: rem ->
noChildChange rem
| _ ->
false
(* Check whether the directory contents is different from what is in
the archive *)
let directoryCheckContentUnchanged
currfspath path info archDesc childUpdates scanInfo =
if
noChildChange childUpdates
&&
let (info', dataUnchanged, ressUnchanged) =
Fileinfo.unchanged currfspath path info in
dataUnchanged
then begin
let (archDesc, updated) =
let inode =
match Fileinfo.stamp info with Fileinfo.InodeStamp i -> i | _ -> 0 in
Props.setDirChangeFlag archDesc scanInfo.dirStamp inode in
let updated =
updated || not (Props.same_time info.Fileinfo.desc archDesc) in
if updated then
debugverbose (fun()->
Util.msg "Contents of directory %s marked unchanged\n"
(Fspath.toDebugString (Fspath.concat currfspath path)));
(Props.setTime archDesc (Props.time info.Fileinfo.desc), updated)
end else begin
let (archDesc, updated) =
Props.setDirChangeFlag archDesc Props.changedDirStamp 0 in
if updated then
debugverbose (fun()->
Util.msg "Contents of directory %s marked changed\n"
(Fspath.toDebugString (Fspath.concat currfspath path)));
(archDesc, updated)
end
(* Check whether the list of children of a directory is clearly unchanged *)
let dirContentsClearlyUnchanged info archDesc scanInfo =
scanInfo.dirFastCheck
&&
let inode =
match Fileinfo.stamp info with Fileinfo.InodeStamp i -> i | _ -> 0 in
Props.dirMarkedUnchanged archDesc scanInfo.dirStamp inode
&&
Props.same_time info.Fileinfo.desc archDesc
&&
(* Check the date is meaningful: the root directory of a FAT
filesystem does not have modification time, so the time returned
by [stat] is usually way in the past. *)
Props.time archDesc >= 631152000. (* Jan 1, 1990 *)
(* Check whether a file's permissions have not changed *)
let isPropUnchanged desc archiveDesc = Props.similar desc archiveDesc
(* Handle file permission change *)
let checkPropChange desc archive archDesc =
if isPropUnchanged desc archDesc then begin
debugverbose (fun() -> Util.msg " Unchanged file\n");
NoUpdates
end else begin
debug (fun() -> Util.msg " File permissions updated\n");
Updates (File (desc, ContentsSame), oldInfoOf archive)
end
(* Check whether a file has changed has changed, by comparing its digest and
properties against [archDesc], [archFp], 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 archFp archStamp archRess scanInfo
: 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)
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 fastCheck = scanInfo.fastCheck in
let dataClearlyUnchanged =
Fpcache.dataClearlyUnchanged fastCheck path info archDesc archStamp in
let ressClearlyUnchanged =
Fpcache.ressClearlyUnchanged fastCheck info archRess dataClearlyUnchanged
in
if dataClearlyUnchanged && ressClearlyUnchanged then begin
Xferhint.insertEntry currfspath path archFp;
None, checkPropChange info.Fileinfo.desc archive archDesc
end else begin
debugverbose (fun() -> Util.msg " Double-check possibly updated file\n");
showStatusAddLength scanInfo info;
let (newDesc, newFp, newStamp, newRess) =
Fpcache.fingerprint fastCheck currfspath path info
(if dataClearlyUnchanged then Some archFp else None) in
Xferhint.insertEntry currfspath path newFp;
debug (fun() -> Util.msg " archive digest = %s current digest = %s\n"
(Os.fullfingerprint_to_string archFp)
(Os.fullfingerprint_to_string newFp));
if archFp = newFp then begin
let newprops = Props.setTime archDesc (Props.time newDesc) in
let newarch = ArchiveFile (newprops, archFp, newStamp, newRess) in
debugverbose (fun() ->
Util.msg " Contents match: update archive with new time...%f\n"
(Props.time newprops));
Some newarch, checkPropChange newDesc archive archDesc
end else begin
debug (fun() -> Util.msg " Updated file\n");
(* [BCP 5/2011] We might add a sanity check here: if the file contents
have changed but the modtime has not, signal an error. I.e., abort if
Props.same_time info.Fileinfo.desc archDesc
is true at this point.
*)
None,
Updates (File (newDesc, ContentsUpdated (newFp, newStamp, newRess)),
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 checkFilename s =
if Name.badEncoding s then
`BadEnc
else if
(* Don't check unless we are syncing with Windows *)
Prefs.read Globals.someHostIsRunningWindows &&
Name.badFile s
then
`BadName
else
`Ok
let getChildren fspath path =
let children =
(* 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
checkFilename nm
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) unchangedChildren scanInfo
: archive NameMap.t option * (Name.t * Common.updateItem) list *
bool * bool
=
showStatusDir path;
Fswatch.scanDirectory path;
let skip =
Pred.test immutable (Path.toString path) &&
not (Pred.test immutablenot (Path.toString path)) in
if unchangedChildren then begin
if skip then begin
if Prefs.read Xferhint.xferbycopying then
NameMap.iter
(fun nm archive ->
match archive with
ArchiveFile (_, archFp, _, _) ->
Xferhint.insertEntry fspath (Path.child path nm) archFp
| _ ->
())
archChi;
(None, [], false, false)
end else begin
let updates = ref [] in
let archUpdated = ref false in
let handleChild nm archive =
let path' = Path.child path nm in
debugverbose (fun () -> Util.msg
"buildUpdateChildren(handleChild): %s\n" (Path.toString path'));
if Globals.shouldIgnore path' then begin
(* We have to ignore paths which are in the archive but no
longer exists in the filesystem. Note that we cannot
reach this point for files that exists on the filesystem
([hasIgnoredChildren] below would have been true). *)
debugignore (fun()->Util.msg "buildUpdateChildren: ignoring path %s\n"
(Path.toString path'));
archive
end else begin
showStatus scanInfo path';
let (arch,uiChild) =
buildUpdateRec archive fspath path' scanInfo in
if uiChild <> NoUpdates then
updates := (nm, uiChild) :: !updates;
match arch with
None -> archive
| Some arch -> archUpdated := true; arch
end in
let newChi = NameMap.mapi handleChild archChi in
(* The Recon module relies on the updates to be sorted *)
((if !archUpdated then Some newChi else None),
Safelist.rev !updates, false, false)
end
end else
let curChildren = ref (getChildren fspath path) in
let emptied = not (NameMap.is_empty archChi) && !curChildren = [] in
let hasIgnoredChildren = ref false 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
hasIgnoredChildren := !hasIgnoredChildren || (archive <> NoArchive);
debugignore (fun()->Util.msg "buildUpdateChildren: ignoring path %s\n"
(Path.toString path'));
archive
end else begin
showStatus scanInfo path';
match status with
`Ok | `Abs ->
if skip && archive <> NoArchive && status <> `Abs then begin
begin match archive with
ArchiveFile (_, archFp, _, _) ->
Xferhint.insertEntry fspath path' archFp
| _ ->
()
end;
archive
end else begin
let (arch,uiChild) =
buildUpdateRec archive fspath path' scanInfo 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. (File '" ^
Path.toString path' ^ "')")
in
updates := (nm, uiChild) :: !updates;
archive
| `BadEnc ->
let uiChild =
Error ("The file name is not encoded in Unicode. (File '"
^ Path.toString path' ^ "')")
in
updates := (nm, uiChild) :: !updates;
archive
| `BadName ->
let uiChild =
Error ("The name of this Unix file is not allowed under Windows. \
(File '" ^ 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;
(* The Recon module relies on the updates to be sorted *)
((if !archUpdated then Some newChi else None),
Safelist.rev !updates, emptied, !hasIgnoredChildren)
and buildUpdateRec archive currfspath path scanInfo =
try
debug (fun() ->
Util.msg "buildUpdateRec: %s\n"
(Fspath.toDebugString (Fspath.concat 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, archFp, archStamp, archRess)) ->
checkContentsChange
currfspath path info archive
archDesc archFp archStamp archRess scanInfo
| (`FILE, _) ->
debug (fun() -> Util.msg " buildUpdate -> New file\n");
None,
begin
showStatusAddLength scanInfo info;
let (desc, fp, stamp, ress) =
Fpcache.fingerprint ~newfile:true
scanInfo.fastCheck currfspath path info None in
Xferhint.insertEntry currfspath path fp;
Updates (File (desc, ContentsUpdated (fp, stamp, ress)),
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.Fileinfo.desc archDesc then
(PropsSame, archDesc)
else
(PropsUpdated, info.Fileinfo.desc) in
let unchanged =
dirContentsClearlyUnchanged info archDesc scanInfo in
let (newChildren, childUpdates, emptied, hasIgnoredChildren) =
buildUpdateChildren
currfspath path prevChildren unchanged scanInfo in
let (archDesc, updated) =
(* If the archive contain ignored children, we cannot use it to
skip reading the directory contents from the filesystem.
Actually, we could check for ignored children in the archive,
but this has a significant cost. We could mark directories
with ignored children, and only perform the checks for them,
but that does not seem worthwhile, as directories with
ignored children are expected to be rare in the archive.
(These are files or directories which used not to be
ignored and are now ignored.) *)
if hasIgnoredChildren then (archDesc, true) else
directoryCheckContentUnchanged
currfspath path info archDesc childUpdates scanInfo in
(begin match newChildren with
Some ch ->
Some (ArchiveDir (archDesc, ch))
| None ->
if updated then Some (ArchiveDir (archDesc, prevChildren))
else 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 false scanInfo in
(None,
Updates (Dir (info.Fileinfo.desc, childUpdates, PropsUpdated, false),
oldInfoOf archive))
with
Util.Transient(s) -> None, Error(s)
(* Compute the updates for the tree of paths [tree] against archive. *)
let rec buildUpdatePathTree archive fspath here tree scanInfo =
match tree, archive with
PathTreeNode children, ArchiveDir (archDesc, archChildren) ->
let curChildren =
lazy (List.fold_left (fun m (nm, st) -> NameMap.add nm st m)
NameMap.empty (getChildren fspath here))
in
let updates = ref [] in
let archUpdated = ref false in
let newChi = ref archChildren in
let handleChild nm archive status tree' =
let path' = Path.child here nm in
if Os.isTempFile (Name.toString nm) || Globals.shouldIgnore path' then
archive
else begin
match status with
`Ok | `Abs ->
let (arch,uiChild) =
buildUpdatePathTree archive fspath path' tree' scanInfo in
if uiChild <> NoUpdates then
updates := (nm, uiChild) :: !updates;
begin 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. (File '" ^
Path.toString path' ^ "')")
in
updates := (nm, uiChild) :: !updates;
archive
| `BadEnc ->
let uiChild =
Error ("The file name is not encoded in Unicode. (File '"
^ Path.toString path' ^ "')")
in
updates := (nm, uiChild) :: !updates;
archive
| `BadName ->
let uiChild =
Error
("The name of this Unix file is not allowed under Windows. \
(File '" ^ Path.toString path' ^ "')")
in
updates := (nm, uiChild) :: !updates;
archive
end
in
NameMap.iter
(fun nm tree' ->
let inArchive = NameMap.mem nm archChildren in
let arch =
if tree' = PathTreeLeaf || not inArchive then begin
let (nm', st) =
try
NameMap.findi nm (Lazy.force curChildren)
with Not_found -> try
(fst (NameMap.findi nm archChildren), `Abs)
with Not_found ->
(nm, `Abs)
in
let arch =
try NameMap.find nm archChildren with Not_found -> NoArchive
in
handleChild nm' arch st tree'
end else begin
let (nm', arch) = NameMap.findi nm archChildren in
handleChild nm' arch `Ok tree'
end
in
if inArchive then newChi := NameMap.add nm arch !newChi)
children;
(begin if !archUpdated then
Some (ArchiveDir (archDesc, !newChi))
else
None
end,
if !updates <> [] then
(* The Recon module relies on the updates to be sorted *)
Updates (Dir (archDesc, Safelist.rev !updates, PropsSame, false),
oldInfoOf archive)
else
NoUpdates)
| _ ->
showStatus scanInfo here;
Fswatch.startScanning scanInfo.archHash fspath here;
let res = buildUpdateRec archive fspath here scanInfo in
Fswatch.stopScanning ();
res
(* 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). The filenames are also updated to match the filesystem
contents. The directory permissions along the path are also
collected, in case we need to build the directory hierarchy
on one side. *)
let rec buildUpdate archive fspath fullpath here path pathTree scanInfo =
match Path.deconstruct path with
None ->
let (arch, ui) =
buildUpdatePathTree archive fspath here pathTree scanInfo in
(begin match arch with
None -> archive
| Some arch -> arch
end,
ui, here, [])
| Some(name, path') ->
let info = Fileinfo.get true fspath here in
if info.Fileinfo.typ <> `DIRECTORY && info.Fileinfo.typ <> `ABSENT 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
(archive, Error error, translatePathLocal fspath fullpath, [])
else
let (name', status) =
if info.Fileinfo.typ = `ABSENT then
(name, checkFilename name)
else
let children = getChildren fspath here in
try
Safelist.find (fun (name', _) -> Name.eq name name') children
with Not_found ->
(name, checkFilename name)
in
match status with
| `BadEnc ->
let error =
Format.sprintf
"The filename %s in path %s is not encoded in Unicode"
(Name.toString name) (Path.toString fullpath)
in
(archive, Error error, translatePathLocal fspath fullpath, [])
| `BadName ->
let error =
Format.sprintf
"The filename %s in path %s is not allowed under Windows"
(Name.toString name) (Path.toString fullpath)
in
(archive, Error error, translatePathLocal fspath fullpath, [])
| `Dup ->
let error =
Format.sprintf
"The path %s is ambiguous at filename %s (i.e., the name \
of this path is the same, modulo capitalization, as \
another path in a case-sensitive filesystem, and you are \
synchronizing this filesystem with a case-insensitive \
filesystem."
(Path.toString fullpath) (Name.toString name)
in
(archive, Error error, translatePathLocal fspath fullpath, [])
| `Ok ->
match archive with
ArchiveDir (desc, children) ->
let archChild =
try NameMap.find name children with Not_found -> NoArchive in
let otherChildren = NameMap.remove name children in
let (arch, updates, localPath, props) =
buildUpdate
archChild fspath fullpath (Path.child here name')
path' pathTree scanInfo
in
let children =
if arch = NoArchive then otherChildren else
NameMap.add name' arch otherChildren
in
(ArchiveDir (desc, children), updates, localPath,
if info.Fileinfo.typ = `ABSENT then [] else
info.Fileinfo.desc :: props)
| _ ->
let (arch, updates, localPath, props) =
buildUpdate
NoArchive fspath fullpath (Path.child here name')
path' pathTree scanInfo
in
assert (arch = NoArchive);
(archive, updates, localPath,
if info.Fileinfo.typ = `ABSENT then [] else
info.Fileinfo.desc :: props)
(* All the predicates that may change the set of files scanned during
update detection *)
let updatePredicates =
[("immutable", immutable); ("immutablenot", immutablenot);
("ignore", Globals.ignorePred); ("ignorenot", Globals.ignorenotPred);
("follow", Path.followPred)]
let predKey : (string * string list) list Proplist.key =
Proplist.register "update predicates"
let rsrcKey : bool Proplist.key = Proplist.register "rsrc pref"
let checkNoUpdatePredicateChange thisRoot =
let props = getArchiveProps thisRoot in
let oldPreds = try Proplist.find predKey props with Not_found -> [] in
let newPreds =
List.map (fun (nm, p) -> (nm, Pred.extern p)) updatePredicates in
(*
List.iter
(fun (nm, l) ->
Format.eprintf "%s@." nm;
List.iter (fun s -> Format.eprintf " %s@." s) l)
newPreds;
Format.eprintf "==> %b@." (oldPreds = newPreds);
*)
let oldRsrc =
try Some (Proplist.find rsrcKey props) with Not_found -> None in
let newRsrc = Prefs.read Osx.rsrc in
try
if oldPreds <> newPreds || oldRsrc <> Some newRsrc then raise Not_found;
Proplist.find dirStampKey props
with Not_found ->
let stamp = Props.freshDirStamp () in
setArchivePropsLocal thisRoot
(Proplist.add dirStampKey stamp
(Proplist.add predKey newPreds
(Proplist.add rsrcKey newRsrc props)));
stamp
(* This contains the list of synchronized paths and the directory stamps
used by the previous update detection, when a watcher process is used.
This make it possible to know when the state of the watcher process
needs to be reset. *)
let previousFindOptions = Hashtbl.create 7
(* 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 wantWatcher fspath pathList subpaths :
(Path.local * Common.updateItem * Props.t list) list =
debug (fun() -> Util.msg
"findLocal %s (%s)\n" (Fspath.toDebugString fspath)
(String.concat " " (Safelist.map Path.toString pathList)));
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 would allow 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 dirStamp = checkNoUpdatePredicateChange thisRoot in
(*
let t1 = Unix.gettimeofday () in
*)
let scanInfo =
{ fastCheck = useFastChecking ();
(* Directory optimization is disabled under Windows,
as Windows does not update directory modification times
on FAT filesystems. *)
dirFastCheck = useFastChecking () && Util.osType = `Unix;
dirStamp = dirStamp; archHash = archiveHash fspath;
showStatus = not !Trace.runningasserver }
in
let (cacheFilename, _) = archiveName fspath FPCache in
let cacheFile = Os.fileInUnisonDir cacheFilename in
Fpcache.init scanInfo.fastCheck (Prefs.read ignoreArchives) cacheFile;
let unchangedOptions =
try
Hashtbl.find previousFindOptions scanInfo.archHash
= (scanInfo.dirStamp, pathList)
with Not_found ->
false
in
let paths =
match subpaths with
Some (unsynchronizedPaths, blacklistedPaths) when unchangedOptions ->
let (>>) x f = f x in
let paths =
Fswatchold.getChanges scanInfo.archHash
(* We do not really need to filter here (they are filtered also
by [buildUpdatePathTree], but that might reduce greatly and
cheaply number of paths to consider... *)
>> List.filter (fun path -> not (Globals.shouldIgnore path))
in
let filterPaths paths subpaths =
let number_list l =
let i = ref (-1) in
Safelist.map (fun x -> incr i; (!i, x)) l
in
paths >> (* We number paths, to be able to recover their
initial order. *)
number_list
>> (* We put longest paths first, in order to deal
correctly with nested paths (tough that might be
overkill...) *)
List.sort (fun (_, p1) (_, p2) -> Path.compare p2 p1)
>> (* We extract the set of changed paths included in
each synchronized path *)
List.fold_left
(fun (l, tree) (i, p) ->
match tree with
None ->
((i, (p, None)) :: l, None)
| Some tree ->
((i, (p, getSubTree p tree)) :: l,
removePathFromTree p tree))
([], pathTreeOfList subpaths)
>> fst
>> (* Finally, we restaure the initial order *)
List.sort (fun (i1, _) (i2, _) -> compare i1 i2)
>> List.map snd
in
filterPaths pathList (Safelist.append unsynchronizedPaths paths)
| _ ->
if wantWatcher && Fswatchold.start scanInfo.archHash fspath then
Hashtbl.replace previousFindOptions
scanInfo.archHash (scanInfo.dirStamp, pathList)
else
Hashtbl.remove previousFindOptions scanInfo.archHash;
Safelist.map (fun p -> (p, Some PathTreeLeaf)) pathList
in
let (archive, updates) =
Safelist.fold_right
(fun (path, pathTreeOpt) (arch, upd) ->
match pathTreeOpt with
Some pathTree when not (Globals.shouldIgnore path) ->
let (arch', ui, localPath, props) =
buildUpdate arch fspath path Path.empty path pathTree scanInfo
in
(arch', (localPath, ui, props) :: upd)
| _ ->
(arch, (translatePathLocal fspath path, NoUpdates, []) :: upd))
paths (archive, [])
in
Fpcache.finish ();
(*
let t2 = Unix.gettimeofday () in
Format.eprintf "Update detection: %f@." (t2 -. t1);
*)
setArchiveLocal thisRoot archive;
abortIfAnyMountpointsAreMissing fspath;
updates
let findOnRoot =
Remote.registerRootCmd
"find"
(fun (fspath, (wantWatcher, pathList, subpaths)) ->
Lwt.return (findLocal wantWatcher fspath pathList subpaths))
let findUpdatesOnPaths ?wantWatcher pathList subpaths =
Lwt_unix.run
(loadArchives true >>= (fun (ok, checksums) ->
begin if ok then Lwt.return checksums else begin
lockArchives () >>= (fun () ->
Remote.Thread.unwindProtect
(fun () ->
doArchiveCrashRecovery () >>= (fun () ->
loadArchives false))
(fun _ ->
unlockArchives ()) >>= (fun (_, checksums) ->
unlockArchives () >>= fun () ->
Lwt.return checksums))
end end >>= (fun checksums ->
checkArchiveCaseSensitivity checksums >>= fun () ->
begin if Prefs.read dumpArchives then
Globals.allRootsIter (fun r -> dumpArchiveOnRoot r ())
else
Lwt.return ()
end >>= fun () ->
let t = Trace.startTimer "Collecting changes" in
Globals.allRootsMapWithWaitingAction (fun r ->
debug (fun() -> Util.msg "findOnRoot %s\n" (root2string r));
findOnRoot r (wantWatcher <> None, pathList, subpaths))
(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.map
(fun r ->
match r with
[i1; i2] -> (i1, i2)
| _ -> assert false)
(Safelist.transpose updates)
in
Trace.status "";
Lwt.return result))))
let findUpdates ?wantWatcher subpaths =
(* TODO: We should filter the paths to remove duplicates (including prefixes)
and ignored paths *)
findUpdatesOnPaths ?wantWatcher (Prefs.read Globals.paths) subpaths
(*****************************************************************************)
(* 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 [] archive 0 in
let props = getArchiveProps root in
storeArchiveLocal
(Os.fileInUnisonDir newName) root archive archiveHash magic props;
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.ops ())#modeDesc) (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 ->
archive
| Error _ ->
NoArchive
| Updates (uc, _) ->
match uc with
Absent ->
NoArchive
| File (desc, ContentsSame) ->
begin match archive with
ArchiveFile (_, fp, stamp, ress) ->
ArchiveFile (desc, fp, stamp, ress)
| _ ->
assert false
end
| File (desc, ContentsUpdated (fp, stamp, ress)) ->
ArchiveFile (desc, fp, 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, fp, stamp, ress) ->
ArchiveFile (Props.strip desc, fp, stamp, ress)
| ArchiveSymlink _ | NoArchive ->
arch
let updateArchive fspath path ui =
debug (fun() ->
Util.msg "updateArchive %s %s\n"
(Fspath.toDebugString fspath) (Path.toString path));
let root = thisRootsGlobalName fspath in
let archive = getArchive root in
let (_, subArch) = getPathInArchive archive Path.empty path in
updateArchiveRec ui (stripArchive path subArch)
(* (For breaking the dependency loop between update.ml and stasher.ml...) *)
let stashCurrentVersion = ref (fun _ _ -> ())
let setStasherFun f = stashCurrentVersion := f
(* 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.toDebugString fspath) (Path.toString path));
let arch =
updatePathInArchive !archive fspath Path.empty path
(fun archive localPath ->
!stashCurrentVersion fspath localPath;
updateArchiveRec (Updates (uc, New)) archive)
in
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 (nm1, nm2) -> nm1) (fun (uc1,uc2) -> uc1) equals;
Tree.map (fun (nm1, nm2) -> nm2) (fun (uc1,uc2) -> uc2) equals])
end
let replaceArchiveLocal fspath path newArch =
debug (fun() -> Util.msg
"replaceArchiveLocal %s %s\n"
(Fspath.toDebugString fspath)
(Path.toString path)
);
let root = thisRootsGlobalName fspath in
let archive = getArchive root in
let archive =
updatePathInArchive archive fspath Path.empty path (fun _ _ -> newArch) in
setArchiveLocal root archive
let replaceArchiveOnRoot =
Remote.registerRootCmd
"replaceArchive"
(fun (fspath, (pathTo, arch)) ->
replaceArchiveLocal fspath pathTo arch;
Lwt.return ())
let replaceArchive root pathTo archive =
replaceArchiveOnRoot root (pathTo, archive)
(* 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 (_, fp, stamp, ress) ->
ArchiveFile (desc, fp, stamp, ress)
| _ ->
assert false
end
| Updates (File (desc, ContentsUpdated (fp, stamp, ress)), _) ->
ArchiveFile(desc, fp, 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, fp, stamp, ress) ->
ArchiveFile (Props.override desc desc', fp, stamp, ress)
| ArchiveDir (desc, children) ->
ArchiveDir (Props.override desc desc', children)
| _ ->
assert false
end
| None -> newArch
let updateProps fspath path propOpt ui =
debug (fun() ->
Util.msg "updateProps %s %s\n"
(Fspath.toDebugString fspath) (Path.toString path));
let root = thisRootsGlobalName fspath in
let archive = getArchive root in
let archive =
updatePathInArchive archive fspath Path.empty path
(fun arch _ -> doUpdateProps arch propOpt ui) in
setArchiveLocal root archive
(*************************************************************************)
(* Make sure no change has happened *)
(*************************************************************************)
let fastCheckMiss path desc ress oldDesc oldRess =
useFastChecking()
&&
Props.same_time desc oldDesc
&&
Props.length desc = Props.length oldDesc
&&
not (Fpcache.excelFile path)
&&
Osx.ressUnchanged oldRess ress None true
let doMarkPossiblyUpdated arch =
match arch with
ArchiveFile (desc, fp, stamp, ress) ->
(* It would be cleaner to have a special stamp for this *)
ArchiveFile (desc, fp, Fileinfo.InodeStamp (-1), ress)
| _ ->
(* Should not happen, actually. But this is hard to test... *)
arch
let markPossiblyUpdated fspath path =
debug (fun() ->
Util.msg "markPossiblyUpdated %s %s\n"
(Fspath.toDebugString fspath) (Path.toString path));
let root = thisRootsGlobalName fspath in
let archive = getArchive root in
let archive =
updatePathInArchive archive fspath Path.empty path
(fun arch _ -> doMarkPossiblyUpdated arch) in
setArchiveLocal root archive
let rec markPossiblyUpdatedRec fspath path ui =
match ui with
Updates (File (desc, ContentsUpdated (_, _, ress)),
Previous (`FILE, oldDesc, _, oldRess)) ->
if fastCheckMiss path desc ress oldDesc oldRess then
markPossiblyUpdated fspath path
| Updates (Dir (_, uiChildren, _, _), _) ->
List.iter
(fun (nm, uiChild) ->
markPossiblyUpdatedRec fspath (Path.child path nm) uiChild)
uiChildren
| _ ->
()
let reportUpdate warnFastCheck explanation =
let msg =
"Destination updated during synchronization\n" ^ explanation ^
if warnFastCheck then
" (if this happens repeatedly on a file that has not been changed, \n\
\ try running once with 'fastcheck' set to false)"
else
""
in
raise (Util.Transient msg)
let rec explainUpdate path ui =
match ui with
NoUpdates ->
()
| Error err ->
raise (Util.Transient ("Could not check destination:\n" ^ err))
| Updates (Absent, _) ->
reportUpdate false
(Format.sprintf "The file %s has been deleted\n"
(Path.toString path))
| Updates (File (_, ContentsSame), _) ->
reportUpdate false
(Format.sprintf "The properties of file %s have been modified\n"
(Path.toString path))
| Updates (File (desc, ContentsUpdated (_, _, ress)),
Previous (`FILE, oldDesc, oldFp, oldRess)) ->
if not (Os.isPseudoFingerprint oldFp) then
reportUpdate (fastCheckMiss path desc ress oldDesc oldRess)
(Format.sprintf "The contents of file %s have been modified\n"
(Path.toString path))
| Updates (File (_, ContentsUpdated _), _) ->
reportUpdate false
(Format.sprintf "The file %s has been created\n"
(Path.toString path))
| Updates (Symlink _, Previous (`SYMLINK, _, _, _)) ->
reportUpdate false
(Format.sprintf "The symlink %s has been modified\n"
(Path.toString path))
| Updates (Symlink _, _) ->
reportUpdate false
(Format.sprintf "The symlink %s has been created\n"
(Path.toString path))
| Updates (Dir (_, _, PropsUpdated, _), Previous (`DIRECTORY, _, _, _)) ->
reportUpdate false
(Format.sprintf
"The properties of directory %s have been modified\n"
(Path.toString path))
| Updates (Dir (_, _, PropsUpdated, _), _) ->
reportUpdate false
(Format.sprintf "The directory %s has been created\n"
(Path.toString path))
| Updates (Dir (_, uiChildren, PropsSame, _), _) ->
List.iter
(fun (nm, uiChild) -> explainUpdate (Path.child path nm) uiChild)
uiChildren
let checkNoUpdates fspath pathInArchive ui =
debug (fun() ->
Util.msg "checkNoUpdates %s %s\n"
(Fspath.toDebugString 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 scanInfo =
{ fastCheck = false; dirFastCheck = false;
dirStamp = Props.changedDirStamp; archHash = "" (* Not used *);
showStatus = false } in
let (_, uiNew) = buildUpdateRec archive fspath localPath scanInfo in
markPossiblyUpdatedRec fspath pathInArchive uiNew;
explainUpdate pathInArchive uiNew;
archive
(*****************************************************************************)
(* UPDATE SIZE *)
(*****************************************************************************)
let sizeZero = (0, Uutil.Filesize.zero)
let sizeOne = (1, Uutil.Filesize.zero)
let sizeAdd (items, bytes) (items', bytes') =
(items + items', Uutil.Filesize.add bytes bytes')
let fileSize desc ress =
(1, Uutil.Filesize.add (Props.length desc) (Osx.ressLength ress))
let rec archiveSize arch =
match arch with
NoArchive ->
sizeZero
| ArchiveDir (_, arcCh) ->
NameMap.fold
(fun _ ar size -> sizeAdd size (archiveSize ar))
arcCh sizeOne
| ArchiveFile (desc, _, _, ress) ->
fileSize desc ress
| ArchiveSymlink _ ->
sizeOne
let rec updateSizeRec archive ui =
match ui with
NoUpdates ->
archiveSize archive
| Error _ ->
sizeZero
| Updates (uc, _) ->
match uc with
Absent ->
sizeZero
| File (desc, ContentsSame) ->
begin match archive with
ArchiveFile (_, _, _, ress) -> fileSize desc ress
| _ -> assert false
end
| File (desc, ContentsUpdated (_, _, ress)) ->
fileSize desc ress
| Symlink l ->
sizeOne
| Dir (_, children, _, _) ->
match archive with
ArchiveDir (_, arcCh) ->
let ch = NameMap.map (fun ch -> (ch, NoUpdates)) arcCh in
let ch =
List.fold_left
(fun ch (nm, uiChild) ->
let arcChild =
try fst (NameMap.find nm ch)
with Not_found -> NoArchive
in
NameMap.add nm (arcChild, uiChild) ch)
ch children
in
NameMap.fold
(fun _ (ar, ui) size -> sizeAdd size (updateSizeRec ar ui))
ch sizeOne
| _ ->
List.fold_left
(fun size (_, uiChild) ->
sizeAdd size (updateSizeRec NoArchive uiChild))
sizeOne children
let updateSize path ui =
let rootLocal = Globals.localRoot () in
let fspathLocal = snd rootLocal in
let root = thisRootsGlobalName fspathLocal in
let archive = getArchive root in
let (_, subArch) = getPathInArchive archive Path.empty path in
updateSizeRec subArch ui
(*****************************************************************************)
(* MISC *)
(*****************************************************************************)
let rec iterFiles fspath path arch f =
match arch with
ArchiveDir (_, children) ->
NameMap.iter
(fun nm arch -> iterFiles fspath (Path.child path nm) arch f) children
| ArchiveFile (desc, fp, stamp, ress) ->
f fspath path fp
| _ ->
()
(* Hook for filesystem auto-detection (not implemented yet) *)
let inspectFilesystem =
Remote.registerRootCmd
"inspectFilesystem"
(fun _ -> Lwt.return Proplist.empty)
unison-2.48.3/update.mli 000644 000766 000000 00000007243 12450317305 016031 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/update.mli *)
(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
module NameMap : MyMap.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
(* Perform update detection. Optionally, takes as input the list of
paths known not to be synchronized and a list of paths not to
check. Returns structures describing dirty files/dirs (1 per path
given in the -path preference). An option controls whether we
would like to use the external filesytem monitoring process. *)
val findUpdates :
?wantWatcher:unit ->
(Path.t list * Path.t list) option ->
((Path.local * Common.updateItem * Props.t list) *
(Path.local * Common.updateItem * Props.t list)) list
(* Take a tree of equal update contents and update the archive accordingly. *)
val markEqual :
(Name.t * Name.t, Common.updateContent * Common.updateContent) Tree.t -> unit
(* Get and update a part of an archive (the archive remains unchanged) *)
val updateArchive : Fspath.t -> Path.local -> Common.updateItem -> archive
(* Replace a part of an archive by another archive *)
val replaceArchive : Common.root -> Path.t -> archive -> unit Lwt.t
val replaceArchiveLocal : Fspath.t -> Path.local -> archive -> unit
(* Update only some permissions *)
val updateProps :
Fspath.t -> 'a Path.path -> Props.t option -> Common.updateItem -> unit
(* Check that no updates has taken place in a given place of the filesystem *)
(* Returns an archive mirroring the filesystem contents *)
val checkNoUpdates :
Fspath.t -> Path.local -> Common.updateItem -> archive
(* Turn off fastcheck for the given file on the next sync. *)
val markPossiblyUpdated : Fspath.t -> Path.local -> unit
(* 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
(* Compute the size of an update *)
val updateSize : Path.t -> Common.updateItem -> int * Uutil.Filesize.t
(* Iterate on all files in an archive *)
val iterFiles :
Fspath.t -> Path.local -> archive ->
(Fspath.t -> Path.local -> Os.fullfingerprint -> unit) -> unit
(* (For breaking the dependency loop between update.ml and stasher.ml...) *)
val setStasherFun : (Fspath.t -> Path.local -> unit) -> unit
(* 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 *)
val archiveHash : Fspath.t -> string
unison-2.48.3/uutil.ml 000644 000766 000000 00000013021 12450317305 015527 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/uutil.ml *)
(* Copyright 1999-2015, 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
external hash_param : int -> int -> 'a -> int = "caml_hash_univ_param" "noalloc"
let hash x = hash_param 10 100 x
(*****************************************************************************)
(* 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 ofFloat : float -> 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 = 0L
let dummy = -1L
let add = Int64.add
let sub = Int64.sub
let ofFloat = Int64.of_float
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)
(*****************************************************************************)
(* 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 "'" "'\\''" ^ "'"
unison-2.48.3/uutil.mli 000644 000766 000000 00000004131 12450317305 015702 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/uutil.mli *)
(* Copyright 1999-2015, 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
(* Hash function (OCaml 3.x version) *)
val hash : 'a -> int
module type FILESIZE = sig
type t
val zero : t
val dummy : t
val add : t -> t -> t
val sub : t -> t -> t
val ofFloat : float -> 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
(* Escape shell parameters *)
val quotes : string -> string
unison-2.48.3/win32rc/ 000755 000766 000000 00000000000 12467142517 015336 5 ustar 00bcpierce wheel 000000 000000 unison-2.48.3/winmain.c 000644 000766 000000 00000000331 10201555717 015644 0 ustar 00bcpierce wheel 000000 000000 #include
#include
extern char **__argv;
int WINAPI WinMain(HINSTANCE h, HINSTANCE hPrevInstance,
LPSTR lpCmdLine, int nCmdShow) {
caml_main(__argv);
return 0;
}
unison-2.48.3/xferhint.ml 000644 000766 000000 00000004346 12450317305 016226 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/xferhint.ml *)
(* Copyright 1999-2015, 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 FPMap =
Hashtbl.Make
(struct
type t = Os.fullfingerprint
let hash = Os.fullfingerprintHash
let equal = Os.fullfingerprintEqual
end)
type handle = Os.fullfingerprint
(* map(fingerprint, path) *)
let fingerprint2pathMap = FPMap.create 10000
let deleteEntry fp =
debug (fun () ->
Util.msg "deleteEntry: fp=%s\n" (Os.fullfingerprint_to_string fp));
FPMap.remove fingerprint2pathMap fp
let lookup fp =
assert (Prefs.read xferbycopying);
debug (fun () ->
Util.msg "lookup: fp = %s\n" (Os.fullfingerprint_to_string fp));
try
let (fspath, path) = FPMap.find fingerprint2pathMap fp in
Some (fspath, path, fp)
with Not_found ->
None
let insertEntry fspath path fp =
if Prefs.read xferbycopying && not (Os.isPseudoFingerprint fp) then begin
debug (fun () ->
Util.msg "insertEntry: fspath=%s, path=%s, fp=%s\n"
(Fspath.toDebugString fspath)
(Path.toString path) (Os.fullfingerprint_to_string fp));
FPMap.replace fingerprint2pathMap fp (fspath, path)
end
unison-2.48.3/xferhint.mli 000644 000766 000000 00000001435 12450317305 016373 0 ustar 00bcpierce wheel 000000 000000 (* Unison file synchronizer: src/xferhint.mli *)
(* Copyright 1999-2015, Benjamin C. Pierce (see COPYING for details) *)
(* This module maintains a cache that can be used to map
an Os.fullfingerprint 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
type handle
(* Suggest a file that's likely to have a given fingerprint *)
val lookup: Os.fullfingerprint -> (Fspath.t * Path.local * handle) option
(* Add a file *)
val insertEntry: Fspath.t -> Path.local -> Os.fullfingerprint -> unit
(* Delete an entry *)
val deleteEntry: handle -> unit
unison-2.48.3/win32rc/U.ico 000644 000766 000000 00000106000 11200340136 016210 0 ustar 00bcpierce wheel 000000 000000 è v ¨ ^ º; 00 ¨% ÀG ¨ hm ˆ ~ h ˜‡ ( @ € € €€ € € € €€ ÀÀÀ €€€ ÿ ÿ ÿÿ ÿ ÿ ÿ ÿÿ ÿÿÿ »»»»»»° »»»»»»»» »»»»»»»»° »»° »»° »»» »»» »»» »»» »»° »» »»° »» »»° »» »»° »» »»° »» »»° »» »»° »» »»° »» »»° »» »»° »» »»° »» »»° »» »»° »» »»° »» »»° »» »»° »» »»° »» »»° »» »»»»° »»»» »»» »»»° »»° »» » »° ° ÿÿÿÿÿÀÿÿ ÿþ þ ü ?üà?øàøðøðøðøðøðøðøðøðøðøðøðøðøðøðøðøðøððààÀðàøðüø?þ?üÿþÿ( @ € € €€ € € € €€ ÀÀÀ ÀÜÀ ðʦ """ ))) UUU MMM BBB 999 €|ÿ PPÿ “ Ö ÿìÌ ÆÖï Öçç © 3 f ™ Ì 3 33 3f 3™ 3Ì 3ÿ f f3 ff f™ fÌ fÿ ™ ™3 ™f ™™ ™Ì ™ÿ Ì Ì3 Ìf Ì™ ÌÌ Ìÿ ÿf ÿ™ ÿÌ 3 3 3 3 f 3 ™ 3 Ì 3 ÿ 33 333 33f 33™ 33Ì 33ÿ 3f 3f3 3ff 3f™ 3fÌ 3fÿ 3™ 3™3 3™f 3™™ 3™Ì 3™ÿ 3Ì 3Ì3 3Ìf 3Ì™ 3ÌÌ 3Ìÿ 3ÿ3 3ÿf 3ÿ™ 3ÿÌ 3ÿÿ f f 3 f f f ™ f Ì f ÿ f3 f33 f3f f3™ f3Ì f3ÿ ff ff3 fff ff™ ffÌ f™ f™3 f™f f™™ f™Ì f™ÿ fÌ fÌ3 fÌ™ fÌÌ fÌÿ fÿ fÿ3 fÿ™ fÿÌ Ì ÿ ÿ Ì ™™ ™3™ ™ ™ ™ Ì ™ ™33 ™ f ™3Ì ™ ÿ ™f ™f3 ™3f ™f™ ™fÌ ™3ÿ ™™3 ™™f ™™™ ™™Ì ™™ÿ ™Ì ™Ì3 fÌf ™Ì™ ™ÌÌ ™Ìÿ ™ÿ ™ÿ3 ™Ìf ™ÿ™ ™ÿÌ ™ÿÿ Ì ™ 3 Ì f Ì ™ Ì Ì ™3 Ì33 Ì3f Ì3™ Ì3Ì Ì3ÿ Ìf Ìf3 ™ff Ìf™ ÌfÌ ™fÿ Ì™ Ì™3 Ì™f Ì™™ Ì™Ì Ì™ÿ ÌÌ ÌÌ3 ÌÌf ÌÌ™ ÌÌÌ ÌÌÿ Ìÿ Ìÿ3 ™ÿf Ìÿ™ ÌÿÌ Ìÿÿ Ì 3 ÿ f ÿ ™ Ì3 ÿ33 ÿ3f ÿ3™ ÿ3Ì ÿ3ÿ ÿf ÿf3 Ìff ÿf™ ÿfÌ Ìfÿ ÿ™ ÿ™3 ÿ™f ÿ™™ ÿ™Ì ÿ™ÿ ÿÌ ÿÌ3 ÿÌf ÿÌ™ ÿÌÌ ÿÌÿ ÿÿ3 Ìÿf ÿÿ™ ÿÿÌ ffÿ fÿf fÿÿ ÿff ÿfÿ ÿÿf ! ¥ ___ 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
8û8û8
8û8û8
û8û8û
û8û8û
8ûû8û
û8ûû8
ûûûûûûûûû
ûûûûûûûûû
ûûûûûûû
ûûûûûûû
ûûûûû
ûûûûû
ûûû
ûûû
û
û
ÿÿÿÿÿÀÿÿ ÿþ þ ü ?üà?øàøðøðøðøðøðøðøðøðøðøðøðøðøðøðøðøðøððààÀðàøðüø?þ?üÿþÿ‰PNG
IHDR \r¨f ;IDATxÚí]œÔDÇÝÁ½I“¢ (‚ ½÷¢€]9ŠtTýPQì”bA;ÍÞéˆ ôÞ¤J•Þ›ôã¾yɦí&›²If²7ÿKf^fg'yÿÌÌ{“ ™ ´+@ ùˆœ ] ¦)Ÿ‰ÌH iDÞ#R‡ÈÚ•á`‰Ì!Ò‰Èï´+ã'2Ô#ò‘"ˆÔ'rŠv¥8¨¢(‘¥DJ9C¤!‘µ´+å2”%²„HUÚŸDZ¹L»rTƒÈ|"UUiû‰Ô"²—våü@f!€‚ ÿ
x’={"œ;—.å#Òv9|G"‘IDÚàIØ3±ÄÞáiÚ•ô™ °»?Äw~hݦ¼;¢24ª?º(é$òíŠrøŠˆôƃ27ä„Y6€í–Á²¥Ç¥üYDZ¹B»¢^"Þ ¿ßDÀ“*UóÂìy
!GŽ$Xµò4k<_Íú]‰|I»Â¾ ?‘axP @VX°¸1ÜP6'9rÔ;¶ÿ'é&òíÊz‰x'€áDžÁƒ%³ÃÂ%¡hÑ9sÚ”pÿ½KáêÕ<Åq€Û@
æˆ_´%ò‘„””D˜1«>Ô§mÛz֛ǎ]’’^&2˜v¥½B<@"£ð Ožd˜·°Ü\!w„ÒGn‡'ûþ%žq¦`#íÊsx‚º ü¦$'ÿ›ïjÂiÅ#”-<··X /^•’pzðÚ•÷ñJ w™H$199L™^š6+d¨üì3ëaĻۤÓÝDj9HûKp¸
Æé>áçþ¡áéþå•úa/tê¸2„Î!`w %‘y´¿„ÛˆG¨âÂ)=¶tîZ*êø
Ð>mLüu¿”´ŠH#"ÿG<@3ôÈ£×ÇU1½høÐðÒ¤S\%ˆ=ˆÍ´¿Œ›ˆ7ÀÅˈÁ“W–Ä
ΟO‡–ͨG§¹—Hº¥8Xú`·Zµ.¿Nª‰‰ÖýÇz¯Ï?Ý)î±wxˆö—rñD yˆ,"RO:u) cÆU·U€Î(0Ž!ß8à‡pkq(gÎ$ˤ§gÀ½w-†¿É6¿‚Hc"çh9·(Ld‘¦xÒ¤é50õ·z€ïÿv£ÀHÇË£À8‹ðí/Èáò,Pñ©°hiÍ,Uœ={š4œ•Wã¢ûˆ\µ]cˆO¤”¿9·0âŸ7o²ãÂÂFqA~¡ý%9lùàbahî‚FP¡bnÇ…ØêÕ™{ÿ=/%$òí/+â ¸’ŠIæúK–Ês¡?~¿:?(_ ±w±„ö—å°\Þ‹¿Ò–f¬bÃúÓиÁ<8}ZvyŠÈÚ_6 põÞ8<ÀÕ}ÎmU«åuðaC¶ÀË/þ-q h;í/ÍèØƒ>Â,ÐcªA—n¥b+Q…?f†»Ú,‚+W„_ì"â*Ó ´¿´S™ šùH2Žèþ<¡´¹£ˆëÒçÑ5ðÅgò(0.@Ÿ‚c´¿<‡.pçúÑÅ^P²6dãÇ{®’Nñ ˆ³OCP GúqÄGþáýn…Þ•öäƒéqø÷ò(0~.’ÏEç¥rx Í,ЃKÂØñöfì`Ѐðæò’€Ã þ0ì ÝvDPp€§ž.C‡ßâéꌣƒQ{9èC3Ô¸‰8”5«ýY ;èÖe%|ûµTjˆk
Ž;/Ñ 4î½ÿZøþÇZà÷ÀQີçÀ¾½ò(0z“=G»A8Œq<È•Y «¸té*´¹}Ì›{DJÂg—¦w$Ðp¨]'?Ìü³ G—_Ð~”ȧ´&“g€á›³@VqòäeÁ{pó¦3RÒwD„€ôƒD r ‡ÒerÝ
Ìê{%ÂFq™ð]D¦ÓnœL
\ûk@„Y ?æ4€jÕóù^‰Ý»ÎAý:sÔfÞ"ò"íÆ±‚ ®æÂU]š ´0nÌ.xä¡ÕÒéYI®¡ÝH™ø¾ïýâ,Яµ¡ÍE©UfåŠÐ¼‰&ÀÌ#D>§ÝHfȲeË¿ÿÑ@ÀÂFÑ×üK»^™¾ÍÙÁÔÉàûä 3JÝÒ™3Î:X
à@];¯€ï¾‘mýF1˜HÜ’¤\ìsîÂ,Гýʰ·½²ƒQl‡§žÌàÀ@"9/Ñ[°L è»KoÑ—ÞRžy¶\l%ºn}ÛB˜?﨔„{` IfÜà,ÆzÀ˜Â,Ðw?Ô„,Yè?ÆÊ˜_ÿ§×ÃÈÿH§û@ì2fœ~Ëéûø8×/px¸×õ0êcó 4pâÄe!°jx,‘´ë‡ÀéŒò„Ýj¨U[œJMõgHmàú
Ê!¾th·&N̬1Ìø`,@Lh@gx ‘×i×+΀±0Σ0„Á×\“͵Âí¸=!ÀLó°|¹¼ÝàL§°™
3ΚUÅÀtF;ùšv½âšY ù‹CÙröfÜ6𨉡S!ÀLýù°s§`æ"û×læ` puÆl8,iE‹Ùà@S&€¶÷Ë£ÀQÌϥ]¯€½ípéµ04cV¨W?rÈÔÀ%ŸfÃÀ”µuëYhÔh¾:ÀÌKDÞô§éÌÁÈrçÃxÇÀ>¹ú=© 3ޝ2›h×+ @ÜÕI˜úêÛÐ6Ú,ã_qçn%ᢣкõbu€3þÇmg ¬€&€Ãäiu¡YóØ8ÐÂ3ýÖ©GwAœ’ô šY ÁoU€gú[œòÙÀMIö?íƒ.]WªÃŒ· Ñw€*X M ‡ÏGWƒ®ÝÝà@ø
Юí2˜¤Œ¯1Ìx\’ôØÇGãÇááG0Œ÷J®_.ë¸0~@t†¿½
^ ï9ÃD˜qÚ àðÒ+7ÁÀWo¦\%w€£À-š.€åË4aÆï8$é1pÐ×Sà¢*¸íöÂ0abmí,ßnE%ÃZfŸÇþ‚ÑcwK§i{‡‡Ýj<» I š ;•„q_zÀÃŒïÜ!Hä´ëÅ0ðyüžHžT®œfÏi`<Ä ›•sårÜKz‡3gÉ6¿ÄˆBTz‡´ µ1œFÖF¯i3¼à@[·œ†õæ©GŸ&ò.íz1
e¨x*,\ÔŠ1™bÌÀtÔIgÎ^f-ºõòªq\àt?PèÒ"€q
àpSù\¼®haႣЪåBiÿÃu¿Ò®cÀØ
ãAîÜI0gNC¨ˆ³@6Úœç»kà‘‰‘¹û÷_€äqß¾RÒûDžŒ±
mƒÈ
Î&øõ—ºÎ¿ ´ðÃwÿB—N+¤Q`+„î¬Ki׋ ÿÄd"‰II 0yRhÖì†ã9ü°Ìʉ>öh•¬ßpšÝ¶NŸ‘"¼ï¨Âo8dÏž(„ñ¦À†¾µ^yI3Žq¤pž;³‡G'œ–ö}úIèÖµ¤¾¦[¿â>¸½?f{Ú.S‡ÇW‰öšÐ9ü$ 9€zoa ‡;î¢Àz÷Z
£?ß%n‘HÒEhf^x¾`Æ;˜®è+ûj<ú¿uÒ)â àr‹Ÿü" œÛÃa׎#+CŸÇËøôÑláòå«pÏK`ÖLy]ÐB"Í!@$]BžÐw¯ˆ';‡±£«Š9~¸•ϲ¬c‘-Ô½±†¼³M:Å)œÜiPçðƒ 0€²¼°ºç‰§n€áïTòácéÀŠÓÉòÎ×´Ñ|X·N3ŽP $]€f¨aƒ‚0mrmeÈo·¢£›V“”ß½×øþgyñ.Â…B'ÀCxM š ÷ÜWLãÍB §pË«lÿÞóP¿þ