From Jerome.Vouillon at pps.jussieu.fr Thu Jun 4 05:35:30 2009 From: Jerome.Vouillon at pps.jussieu.fr (Jerome Vouillon) Date: Thu, 4 Jun 2009 11:35:30 +0200 Subject: [Unison-hackers] File transfer using an external program Message-ID: <20090604093530.GA23673@pps.jussieu.fr> Hi, Has any benchmark been performed regarding the support for invoking an external file transfer tool? I thought Unison was fairly good at transferring large files. File contents are sent in 64 KiB chunks using a synchronous RPC mechanism. So, over a fast high-latency connection (DSL, for instance), Unison may be somewhat latency bound when synchronizing a single file. But I would expect it to use the full bandwidth when synchronizing two files or more. -- Jerome From alan.schmitt at polytechnique.org Thu Jun 4 07:57:57 2009 From: alan.schmitt at polytechnique.org (Alan Schmitt) Date: Thu, 4 Jun 2009 13:57:57 +0200 Subject: [Unison-hackers] File transfer using an external program In-Reply-To: <20090604093530.GA23673@pps.jussieu.fr> References: <20090604093530.GA23673@pps.jussieu.fr> Message-ID: <36E957E9-996B-4643-BA4E-6EBA2EFA4FD9@polytechnique.org> On 4 juin 09, at 11:35, Jerome Vouillon wrote: > Hi, > > Has any benchmark been performed regarding the support for invoking an > external file transfer tool? > > I thought Unison was fairly good at transferring large files. File > contents are sent in 64 KiB chunks using a synchronous RPC mechanism. > So, over a fast high-latency connection (DSL, for instance), Unison > may be somewhat latency bound when synchronizing a single file. But I > would expect it to use the full bandwidth when synchronizing two files > or more. I haven't done benchmarks, but I have clearly witnessed an improved performance using rsync instead of Unison. Alan -------------- next part -------------- A non-text attachment was scrubbed... Name: PGP.sig Type: application/pgp-signature Size: 195 bytes Desc: This is a digitally signed message part Url : http://lists.seas.upenn.edu/pipermail/unison-hackers/attachments/20090604/be48f796/PGP-0001.sig From bcpierce at cis.upenn.edu Thu Jun 4 09:13:15 2009 From: bcpierce at cis.upenn.edu (Benjamin Pierce) Date: Thu, 4 Jun 2009 09:13:15 -0400 Subject: [Unison-hackers] Help building OSX GUI In-Reply-To: <3AA479FC-1F08-4A38-BF5B-B9B2F5D3BC1B@cis.upenn.edu> References: <3A36B4E3-2A27-435E-9E11-B852AC372A58@cis.upenn.edu> <4DBFC2EC-8355-478D-A199-7D7DB3220A37@polytechnique.org> <3BB79FBC-BB3C-429A-B9ED-433A9C92BDDE@cis.upenn.edu> <87A2B849-D292-461F-9880-DD7670552370@polytechnique.org> <2675D41E-0A57-4707-A0F4-64618C1C4963@cis.upenn.edu> <4615B1A2-3029-4BF7-96C8-2997F3B089A4@kalkwarf.com> <57894FBB-B83F-4CFF-97F8-668A24B2AA5F@cis.upenn.edu> <6BE46969-2D68-4F45-9D28-2B5D720755A7@polytechnique.org> <12DE3A85-A6F2-4D01-81D9-2949F66827BB@cis.upenn.edu> <2E008972-2CB9-42C0-9827-58C66813CDBB@cis.upenn.edu> <1BED0079-7560-4068-A15B-CB861BA33028@polytechnique.org> <28F17C90-F376-4AE0-8026-271BED414177@kalkwarf.com> <3D552623-2BC0-4696-B4C1-17CC84408F0A@cis.upenn.edu> <4A003BA7.5090803@gmx.net> <3AA479FC-1F08-4A38-BF5B-B9B2F5D3BC1B@cis.upenn.edu> Message-ID: Hi again, Has there been any progress on sorting out the makefiles, etc., for Unison-with-GUI compilation on OSX? The new 3.11.1 release candidate apparently fixes the critical bug that was preventing the Unison GUI from working, I'm eager to see if this is really true... At the moment, a simple "make" on my (10.5) system gives me this (indicating that the 10.4 SDK is selected but not available)... ~/current/unison/trunk/src> make UISTYLE = macnew Building for Unix NATIVE = true THREADS = true STATIC = false OSTYPE = OSARCH = osx ocamlopt: uimacbridgenew.ml ---> uimacbridgenew.cmx ocamlopt -I lwt -I ubase -I system -thread -I system/generic -c / Users/bcpierce/current/unison/trunk/src/uimacbridgenew.ml File "/Users/bcpierce/current/unison/trunk/src/uimacbridgenew.ml", line 67, characters 4-26: Warning S: this expression should have type unit. File "/Users/bcpierce/current/unison/trunk/src/uimacbridgenew.ml", line 67, characters 28-50: Warning S: this expression should have type unit. Linking unison-blob.o ocamlopt -output-obj -verbose -I lwt -I ubase -I system -thread -I system/generic -o u-b.o unix.cmxa str.cmxa bigarray.cmxa threads.cmxa ubase/rx.cmx unicode_tables.cmx unicode.cmx bytearray.cmx system/system_generic.cmx system/generic/ system_impl.cmx system.cmx ubase/projectInfo.cmx ubase/myMap.cmx ubase/ safelist.cmx ubase/uprintf.cmx ubase/util.cmx ubase/uarg.cmx ubase/ prefs.cmx ubase/trace.cmx lwt/pqueue.cmx lwt/lwt.cmx lwt/lwt_util.cmx lwt/lwt_unix.cmx case.cmx pred.cmx uutil.cmx fileutil.cmx name.cmx path.cmx fspath.cmx fs.cmx fingerprint.cmx abort.cmx osx.cmx external.cmx props.cmx fileinfo.cmx os.cmx lock.cmx clroot.cmx common.cmx tree.cmx checksum.cmx terminal.cmx transfer.cmx xferhint.cmx remote.cmx globals.cmx copy.cmx stasher.cmx update.cmx files.cmx sortri.cmx recon.cmx transport.cmx strings.cmx uicommon.cmx uitext.cmx test.cmx main.cmx uimacbridgenew.cmx + as -o '/var/folders/W3/W3g-3A4aGOyR3RJpla6Ei++++TI/-Tmp-/ camlstartup99d75a.o' '/var/folders/W3/W3g-3A4aGOyR3RJpla6Ei++++TI/- Tmp-/camlstartup1b1f55.s' + ld -r -o 'u-b.o' '/var/folders/W3/W3g-3A4aGOyR3RJpla6Ei++++TI/-Tmp-/ camlstartup99d75a.o' 'uimacbridgenew.o' 'main.o' 'test.o' 'uitext.o' 'uicommon.o' 'strings.o' 'transport.o' 'recon.o' 'sortri.o' 'files.o' 'update.o' 'stasher.o' 'copy.o' 'globals.o' 'remote.o' 'xferhint.o' 'transfer.o' 'terminal.o' 'checksum.o' 'tree.o' 'common.o' 'clroot.o' 'lock.o' 'os.o' 'fileinfo.o' 'props.o' 'external.o' 'osx.o' 'abort.o' 'fingerprint.o' 'fs.o' 'fspath.o' 'path.o' 'name.o' 'fileutil.o' 'uutil.o' 'pred.o' 'case.o' 'lwt/lwt_unix.o' 'lwt/lwt_util.o' 'lwt/ lwt.o' 'lwt/pqueue.o' 'ubase/trace.o' 'ubase/prefs.o' 'ubase/uarg.o' 'ubase/util.o' 'ubase/uprintf.o' 'ubase/safelist.o' 'ubase/myMap.o' 'ubase/projectInfo.o' 'system.o' 'system/generic/system_impl.o' 'system/system_generic.o' 'bytearray.o' 'unicode.o' 'unicode_tables.o' 'ubase/rx.o' '/usr/local/lib/ocaml/threads/threads.a' '/usr/local/lib/ ocaml/bigarray.a' '/usr/local/lib/ocaml/str.a' '/usr/local/lib/ocaml/ unix.a' '/usr/local/lib/ocaml/stdlib.a' ld -r -o unison-blob.o u-b.o osxsupport.o pty.o bytearray_stubs.o rm -f u-b.o (cd uimacnew; xcodebuild OCAMLLIBDIR="/usr/local/lib/ocaml" SYMROOT=build) === BUILDING AGGREGATE TARGET Create ExternalSettings OF PROJECT uimacnew WITH THE DEFAULT CONFIGURATION (Default) === Checking Dependencies... The file ???ExternalSettings.xcconfig??? does not exist. (/Users/ bcpierce/current/unison/trunk/src/uimacnew/ExternalSettings.xcconfig) PhaseScriptExecution "/Users/bcpierce/current/unison/trunk/src/ uimacnew/build/uimacnew.build/Default/Create ExternalSettings.build/ Script-2A124E7E0DE1C4BE00524237.sh" cd /Users/bcpierce/current/unison/trunk/src/uimacnew setenv ACTION build setenv ALTERNATE_GROUP bcpierce setenv ALTERNATE_MODE u+w,go-w,a+rX setenv ALTERNATE_OWNER bcpierce setenv ALWAYS_SEARCH_USER_PATHS YES setenv APPLE_INTERNAL_DEVELOPER_DIR /AppleInternal/Developer setenv APPLE_INTERNAL_DIR /AppleInternal setenv APPLE_INTERNAL_DOCUMENTATION_DIR /AppleInternal/ Documentation setenv APPLE_INTERNAL_LIBRARY_DIR /AppleInternal/Library setenv APPLE_INTERNAL_TOOLS /AppleInternal/Developer/Tools setenv APPLY_RULES_IN_COPY_FILES NO setenv ARCHS i386 setenv ARCHS_STANDARD_32_64_BIT "i386 x86_64 ppc ppc64" setenv ARCHS_STANDARD_32_BIT "i386 ppc" setenv ARCHS_STANDARD_64_BIT "x86_64 ppc64" setenv BUILD_COMPONENTS "headers build" setenv BUILD_DIR /Users/bcpierce/current/unison/trunk/src/ uimacnew/build setenv BUILD_ROOT /Users/bcpierce/current/unison/trunk/src/ uimacnew/build setenv BUILD_STYLE Default setenv BUILD_VARIANTS normal setenv BUILT_PRODUCTS_DIR /Users/bcpierce/current/unison/trunk/ src/uimacnew/build/Default setenv CACHE_ROOT /var/folders/W3/W3g-3A4aGOyR3RJpla6Ei++++TI/- Caches-/com.apple.Xcode.501 setenv CCHROOT /var/folders/W3/W3g-3A4aGOyR3RJpla6Ei++++TI/- Caches-/com.apple.Xcode.501 setenv CHMOD /bin/chmod setenv CHOWN /usr/sbin/chown setenv CLASS_FILE_DIR "/Users/bcpierce/current/unison/trunk/src/ uimacnew/build/uimacnew.build/Default/Create ExternalSettings.build/ JavaClasses" setenv CLEAN_PRECOMPS YES setenv CLONE_HEADERS NO setenv COMMAND_MODE legacy setenv COMPOSITE_SDK_DIRS /var/folders/W3/W3g-3A4aGOyR3RJpla6Ei+++ +TI/-Caches-/com.apple.Xcode.501/CompositeSDKs setenv CONFIGURATION Default setenv CONFIGURATION_BUILD_DIR /Users/bcpierce/current/unison/ trunk/src/uimacnew/build/Default setenv CONFIGURATION_TEMP_DIR /Users/bcpierce/current/unison/ trunk/src/uimacnew/build/uimacnew.build/Default setenv COPYING_PRESERVES_HFS_DATA NO setenv COPY_PHASE_STRIP YES setenv COPY_RESOURCES_FROM_STATIC_FRAMEWORKS YES setenv CP /bin/cp setenv CURRENT_ARCH i386 setenv CURRENT_VARIANT normal setenv DEAD_CODE_STRIPPING NO setenv DEBUGGING_SYMBOLS YES setenv DEBUG_INFORMATION_FORMAT dwarf setenv DEPLOYMENT_LOCATION NO setenv DEPLOYMENT_POSTPROCESSING NO setenv DERIVED_FILES_DIR "/Users/bcpierce/current/unison/trunk/ src/uimacnew/build/uimacnew.build/Default/Create ExternalSettings.build/DerivedSources" setenv DERIVED_FILE_DIR "/Users/bcpierce/current/unison/trunk/src/ uimacnew/build/uimacnew.build/Default/Create ExternalSettings.build/ DerivedSources" setenv DERIVED_SOURCES_DIR "/Users/bcpierce/current/unison/trunk/ src/uimacnew/build/uimacnew.build/Default/Create ExternalSettings.build/DerivedSources" setenv DEVELOPER_APPLICATIONS_DIR /Developer/Applications setenv DEVELOPER_BIN_DIR /Developer/usr/bin setenv DEVELOPER_DIR /Developer setenv DEVELOPER_FRAMEWORKS_DIR /Developer/Library/Frameworks setenv DEVELOPER_FRAMEWORKS_DIR_QUOTED "\"/Developer/Library/ Frameworks\"" setenv DEVELOPER_LIBRARY_DIR /Developer/Library setenv DEVELOPER_SDK_DIR /Developer/SDKs setenv DEVELOPER_TOOLS_DIR /Developer/Tools setenv DEVELOPER_USR_DIR /Developer/usr setenv DEVELOPMENT_LANGUAGE English setenv DO_HEADER_SCANNING_IN_JAM NO setenv DSTROOT /tmp/uimacnew.dst setenv DWARF_DSYM_FILE_NAME .dSYM setenv DWARF_DSYM_FOLDER_PATH /Users/bcpierce/current/unison/ trunk/src/uimacnew/build/Default setenv ENABLE_HEADER_DEPENDENCIES YES setenv ENABLE_OPENMP_SUPPORT NO setenv EXCLUDED_RECURSIVE_SEARCH_PATH_SUBDIRECTORIES "*.nib *.lproj *.framework *.gch (*) CVS .svn *.xcodeproj *.xcode *.pbproj *.pbxproj" setenv FILE_LIST "/Users/bcpierce/current/unison/trunk/src/ uimacnew/build/uimacnew.build/Default/Create ExternalSettings.build/ Objects/LinkFileList" setenv FIXED_FILES_DIR "/Users/bcpierce/current/unison/trunk/src/ uimacnew/build/uimacnew.build/Default/Create ExternalSettings.build/ FixedFiles" setenv FRAMEWORK_VERSION A setenv GCC3_VERSION 3.3 setenv GCC_PFE_FILE_C_DIALECTS "c objective-c c++ objective-c++" setenv GCC_TREAT_WARNINGS_AS_ERRORS NO setenv GCC_VERSION 4.0 setenv GENERATE_MASTER_OBJECT_FILE NO setenv GENERATE_PKGINFO_FILE NO setenv GENERATE_PROFILING_CODE NO setenv GID 501 setenv GROUP bcpierce setenv HEADERMAP_INCLUDES_FLAT_ENTRIES_FOR_TARGET_BEING_BUILT YES setenv HEADERMAP_INCLUDES_FRAMEWORK_ENTRIES_FOR_ALL_PRODUCT_TYPES YES setenv HEADERMAP_INCLUDES_NONPUBLIC_NONPRIVATE_HEADERS YES setenv HEADERMAP_INCLUDES_PROJECT_HEADERS YES setenv ICONV /usr/bin/iconv setenv INFOPLIST_EXPAND_BUILD_SETTINGS YES setenv INFOPLIST_OUTPUT_FORMAT same-as-input setenv INFOPLIST_PREPROCESS NO setenv INSTALL_DIR /tmp/uimacnew.dst setenv INSTALL_GROUP bcpierce setenv INSTALL_MODE_FLAG u+w,go-w,a+rX setenv INSTALL_OWNER bcpierce setenv INSTALL_ROOT /tmp/uimacnew.dst setenv JAVAC_DEFAULT_FLAGS "-J-Xms64m -J-XX:NewSize=4M -J- Dfile.encoding=UTF8" setenv JAVA_APP_STUB /System/Library/Frameworks/JavaVM.framework/ Resources/MacOS/JavaApplicationStub setenv JAVA_ARCHIVE_CLASSES YES setenv JAVA_ARCHIVE_TYPE JAR setenv JAVA_COMPILER /usr/bin/javac setenv JAVA_FRAMEWORK_RESOURCES_DIRS Resources setenv JAVA_JAR_FLAGS cv setenv JAVA_SOURCE_SUBDIR . setenv JAVA_USE_DEPENDENCIES YES setenv JAVA_ZIP_FLAGS -urg setenv JIKES_DEFAULT_FLAGS "+E +OLDCSO" setenv KEEP_PRIVATE_EXTERNS NO setenv LD_GENERATE_MAP_FILE NO setenv LD_MAP_FILE_PATH "/Users/bcpierce/current/unison/trunk/src/ uimacnew/build/uimacnew.build/Default/Create ExternalSettings.build/ Create ExternalSettings-LinkMap-normal-i386.txt" setenv LD_OPENMP_FLAGS -fopenmp setenv LEX /Developer/usr/bin/lex setenv LINKER_DISPLAYS_MANGLED_NAMES NO setenv LINK_FILE_LIST_normal_i386 setenv LINK_WITH_STANDARD_LIBRARIES YES setenv LOCAL_ADMIN_APPS_DIR /Applications/Utilities setenv LOCAL_APPS_DIR /Applications setenv LOCAL_DEVELOPER_DIR /Library/Developer setenv LOCAL_LIBRARY_DIR /Library setenv MAC_OS_X_VERSION_ACTUAL 1057 setenv MAC_OS_X_VERSION_MAJOR 1050 setenv MAC_OS_X_VERSION_MINOR 0500 setenv NATIVE_ARCH i386 setenv NATIVE_ARCH_32_BIT i386 setenv NATIVE_ARCH_64_BIT x86_64 setenv NATIVE_ARCH_ACTUAL x86_64 setenv NO_COMMON YES setenv OBJECT_FILE_DIR "/Users/bcpierce/current/unison/trunk/src/ uimacnew/build/uimacnew.build/Default/Create ExternalSettings.build/ Objects" setenv OBJECT_FILE_DIR_normal "/Users/bcpierce/current/unison/ trunk/src/uimacnew/build/uimacnew.build/Default/Create ExternalSettings.build/Objects-normal" setenv OBJROOT /Users/bcpierce/current/unison/trunk/src/uimacnew/ build setenv OCAMLLIBDIR /usr/local/lib/ocaml setenv ONLY_ACTIVE_ARCH NO setenv OPTIMIZATION_LEVEL 0 setenv OS MACOS setenv OSAC /usr/bin/osacompile setenv PASCAL_STRINGS YES setenv PATH_PREFIXES_EXCLUDED_FROM_HEADER_DEPENDENCIES "/usr/ include /usr/local/include /System/Library/Frameworks /System/Library/ PrivateFrameworks /Developer/Headers" setenv PKGINFO_FILE_PATH "/Users/bcpierce/current/unison/trunk/ src/uimacnew/build/uimacnew.build/Default/Create ExternalSettings.build/PkgInfo" setenv PLATFORM_DEVELOPER_APPLICATIONS_DIR /Developer/Applications setenv PLATFORM_DEVELOPER_BIN_DIR /Developer/usr/bin setenv PLATFORM_DEVELOPER_LIBRARY_DIR /Developer/Library setenv PLATFORM_DEVELOPER_SDK_DIR /Developer/SDKs setenv PLATFORM_DEVELOPER_TOOLS_DIR /Developer/Tools setenv PLATFORM_DEVELOPER_USR_DIR /Developer/usr setenv PLATFORM_NAME macosx setenv PLIST_FILE_OUTPUT_FORMAT same-as-input setenv PREBINDING YES setenv PRECOMPS_INCLUDE_HEADERS_FROM_BUILT_PRODUCTS_DIR YES setenv PRECOMP_DESTINATION_DIR "/Users/bcpierce/current/unison/ trunk/src/uimacnew/build/uimacnew.build/Default/Create ExternalSettings.build/PrefixHeaders" setenv PRESERVE_DEAD_CODE_INITS_AND_TERMS NO setenv PRODUCT_NAME "Create ExternalSettings" setenv PRODUCT_SETTINGS_PATH setenv PROFILING_CODE NO setenv PROJECT uimacnew setenv PROJECT_DERIVED_FILE_DIR /Users/bcpierce/current/unison/ trunk/src/uimacnew/build/uimacnew.build/DerivedSources setenv PROJECT_DIR /Users/bcpierce/current/unison/trunk/src/ uimacnew setenv PROJECT_FILE_PATH /Users/bcpierce/current/unison/trunk/src/ uimacnew/uimacnew.xcodeproj setenv PROJECT_NAME uimacnew setenv PROJECT_TEMP_DIR /Users/bcpierce/current/unison/trunk/src/ uimacnew/build/uimacnew.build setenv RECURSIVE_SEARCH_PATHS_FOLLOW_SYMLINKS YES setenv REMOVE_CVS_FROM_RESOURCES YES setenv REMOVE_SVN_FROM_RESOURCES YES setenv REZ_COLLECTOR_DIR "/Users/bcpierce/current/unison/trunk/ src/uimacnew/build/uimacnew.build/Default/Create ExternalSettings.build/ResourceManagerResources" setenv REZ_OBJECTS_DIR "/Users/bcpierce/current/unison/trunk/src/ uimacnew/build/uimacnew.build/Default/Create ExternalSettings.build/ ResourceManagerResources/Objects" setenv SCAN_ALL_SOURCE_FILES_FOR_INCLUDES NO setenv SCRIPT_INPUT_FILE_COUNT 0 setenv SCRIPT_OUTPUT_FILE_COUNT 0 setenv SDKROOT /Developer/SDKs/MacOSX10.4u.sdk setenv SED /usr/bin/sed setenv SEPARATE_STRIP NO setenv SEPARATE_SYMBOL_EDIT NO setenv SET_DIR_MODE_OWNER_GROUP YES setenv SET_FILE_MODE_OWNER_GROUP NO setenv SHARED_DERIVED_FILE_DIR /Users/bcpierce/current/unison/ trunk/src/uimacnew/build/Default/DerivedSources setenv SHARED_PRECOMPS_DIR /var/folders/W3/W3g-3A4aGOyR3RJpla6Ei++ ++TI/-Caches-/com.apple.Xcode.501/SharedPrecompiledHeaders setenv SKIP_INSTALL YES setenv SOURCE_ROOT /Users/bcpierce/current/unison/trunk/src/ uimacnew setenv SRCROOT /Users/bcpierce/current/unison/trunk/src/uimacnew setenv STANDARD_C_PLUS_PLUS_LIBRARY_TYPE dynamic setenv STRINGS_FILE_OUTPUT_ENCODING UTF-16 setenv STRIP_INSTALLED_PRODUCT YES setenv STRIP_STYLE all setenv SYMBOL_REPOSITORY_DIR "/Users/bcpierce/current/unison/ trunk/src/uimacnew/build/uimacnew.build/Default/Create ExternalSettings.build/SymbolRepositories" setenv SYMROOT /Users/bcpierce/current/unison/trunk/src/uimacnew/ build setenv SYSTEM_ADMIN_APPS_DIR /Applications/Utilities setenv SYSTEM_APPS_DIR /Applications setenv SYSTEM_CORE_SERVICES_DIR /System/Library/CoreServices setenv SYSTEM_DEMOS_DIR /Applications/Extras setenv SYSTEM_DEVELOPER_APPS_DIR /Developer/Applications setenv SYSTEM_DEVELOPER_BIN_DIR /Developer/usr/bin setenv SYSTEM_DEVELOPER_DEMOS_DIR "/Developer/Applications/ Utilities/Built Examples" setenv SYSTEM_DEVELOPER_DIR /Developer setenv SYSTEM_DEVELOPER_DOC_DIR "/Developer/ADC Reference Library" setenv SYSTEM_DEVELOPER_GRAPHICS_TOOLS_DIR "/Developer/ Applications/Graphics Tools" setenv SYSTEM_DEVELOPER_JAVA_TOOLS_DIR "/Developer/Applications/ Java Tools" setenv SYSTEM_DEVELOPER_PERFORMANCE_TOOLS_DIR "/Developer/ Applications/Performance Tools" setenv SYSTEM_DEVELOPER_RELEASENOTES_DIR "/Developer/ADC Reference Library/releasenotes" setenv SYSTEM_DEVELOPER_TOOLS /Developer/Tools setenv SYSTEM_DEVELOPER_TOOLS_DOC_DIR "/Developer/ADC Reference Library/documentation/DeveloperTools" setenv SYSTEM_DEVELOPER_TOOLS_RELEASENOTES_DIR "/Developer/ADC Reference Library/releasenotes/DeveloperTools" setenv SYSTEM_DEVELOPER_USR_DIR /Developer/usr setenv SYSTEM_DEVELOPER_UTILITIES_DIR /Developer/Applications/ Utilities setenv SYSTEM_DOCUMENTATION_DIR /Library/Documentation setenv SYSTEM_LIBRARY_DIR /System/Library setenv TARGETNAME "Create ExternalSettings" setenv TARGET_BUILD_DIR /Users/bcpierce/current/unison/trunk/src/ uimacnew/build/Default setenv TARGET_NAME "Create ExternalSettings" setenv TARGET_TEMP_DIR "/Users/bcpierce/current/unison/trunk/src/ uimacnew/build/uimacnew.build/Default/Create ExternalSettings.build" setenv TEMP_DIR "/Users/bcpierce/current/unison/trunk/src/ uimacnew/build/uimacnew.build/Default/Create ExternalSettings.build" setenv TEMP_FILES_DIR "/Users/bcpierce/current/unison/trunk/src/ uimacnew/build/uimacnew.build/Default/Create ExternalSettings.build" setenv TEMP_FILE_DIR "/Users/bcpierce/current/unison/trunk/src/ uimacnew/build/uimacnew.build/Default/Create ExternalSettings.build" setenv TEMP_ROOT /Users/bcpierce/current/unison/trunk/src/ uimacnew/build setenv UID 501 setenv UNSTRIPPED_PRODUCT NO setenv USER bcpierce setenv USER_APPS_DIR /Users/bcpierce/Applications setenv USER_HEADER_SEARCH_PATHS /usr/local/lib/ocaml setenv USER_LIBRARY_DIR /Users/bcpierce/Library setenv USE_DYNAMIC_NO_PIC YES setenv USE_HEADERMAP YES setenv USE_HEADER_SYMLINKS NO setenv VALID_ARCHS "i386 ppc ppc64 ppc7400 ppc970 x86_64" setenv VERBOSE_PBXCP NO setenv VERSION_INFO_BUILDER bcpierce setenv VERSION_INFO_FILE "Create ExternalSettings_vers.c" setenv VERSION_INFO_STRING "\"@(#)PROGRAM:Create ExternalSettings PROJECT:uimacnew-\"" setenv XCODE_APP_SUPPORT_DIR /Developer/Library/Xcode setenv XCODE_VERSION_ACTUAL 0310 setenv XCODE_VERSION_MAJOR 0300 setenv YACC /Developer/usr/bin/yacc /bin/sh -c "\"/Users/bcpierce/current/unison/trunk/src/uimacnew/ build/uimacnew.build/Default/Create ExternalSettings.build/ Script-2A124E7E0DE1C4BE00524237.sh\"" === BUILDING NATIVE TARGET uimac OF PROJECT uimacnew WITH THE DEFAULT CONFIGURATION (Default) === Checking Dependencies... The file ???ExternalSettings.xcconfig??? does not exist. (/Users/ bcpierce/current/unison/trunk/src/uimacnew/ExternalSettings.xcconfig) error: There is no SDK with specified name or path '/Developer/SDKs/ MacOSX10.4u.sdk' ** BUILD FAILED ** make: *** [macexecutable] Error 1 - Benjamin On May 5, 2009, at 9:26 AM, Benjamin Pierce wrote: > I'm not an expert on compiling on OSX, so I'll leave it to you and > Alan to sort out what's the best way to fix the makefiles. I'll be > glad to apply whatever patch you both agree on. > > - B > > > > On May 5, 2009, at 9:14 AM, Martin von Gagern wrote: > >> Hi! >> >> I'm on using ocaml as built with fink, and rebuilding ocaml just to >> allow developing unison doesn't sound too attractive. Without >> modifications, I get this error: >> >> Undefined symbols: >> "_chmod$UNIX2003", referenced from: >> _setFileInfos in unison-blob.o >> _setFileInfos in unison-blob.o >> >> The reference to that symbol is present in osxsupport.o as well, so >> it's >> the C compiler invoked by ocamlopt that's introducing this reference. >> The symbol is part of the OS X 10.5 SDK, but not the 10.4 SDK. >> >> Alan Schmitt wrote: >>> Right now, everything is set to compile for both 10.4 and 10.5, but >>> requires a specially built ocaml (which is simply a line to add in a >>> configuration file in godi). The reason for this is that I don't >>> have >>> access to Tiger machines anymore and I want to provide a single >>> binary >>> for our users. >> >> You shouldn't have to rebuild ocaml just to get a certain command >> line >> argument passed on to the C compiler. The -ccopt flag does that. It >> might be that code compiled from ocaml source files does introduce >> additional dependencies if you don't rebuild ocaml, but as this >> hasn't >> been a problem for me, I'll not worry about it here. >> >>> We could try to do some tweaking to allow different compilation >>> options, >>> but I would first need to find out how to change the target SDK >>> from the >>> command line (right now I only know how to do it in XCode). >> >> On my system there is a -sdk command line flag to xcodebuild. >> Specifying >> a value like macos10.5 for it will select the corresponding SDK, >> falling >> back to the project configured SDK if the selected one isn't >> available. >> >> The attached patch takes care of both these approaches: specifying >> the >> SDK to xcodebuild and passing -mmacosx-version-min to the C compiler. >> Both are controlled using the single MINOSXVERSION variable in the >> makefile. So in theory "make MINOSXVERSION=10.4" should give you a >> binary ready to run anywhere, while "make MINOSXVERSION=10.5" will >> give >> you a version making use of all the latest features, or whatever. >> >> Both of these builds compile for me, while the unmodified build >> failed >> with the unresolved reference quoted in the beginning. I would like >> to >> see the patch included. >> >> Greetings, >> Martin von Gagern >> === modified file 'src/Makefile.OCaml' >> --- src/Makefile.OCaml 2009-05-05 08:28:15 +0000 >> +++ src/Makefile.OCaml 2009-05-05 12:54:21 +0000 >> @@ -157,6 +157,10 @@ >> endif >> >> MINOSXVERSION=10.5 >> +XCODEFLAGS=-sdk macosx$(MINOSXVERSION) >> +ifeq ($(OSARCH),osx) >> + CAMLFLAGS+=-ccopt -mmacosx-version-min=$(MINOSXVERSION) >> +endif >> >> # NOTE: the OCAMLLIBDIR is not getting passed correctly? >> # The two cases for cltool are needed because Xcode 2.1+ >> @@ -164,7 +168,7 @@ >> .PHONY: macexecutable >> macexecutable: $(NAME)-blob.o >> # sed -e's/@@VERSION@@/$(VERSION)/' $(UIMACDIR)/Info.plist.template >>> $(UIMACDIR)/Info.plist >> - (cd $(UIMACDIR); xcodebuild OCAMLLIBDIR="$(OCAMLLIBDIR)" >> SYMROOT=build) >> + (cd $(UIMACDIR); xcodebuild $(XCODEFLAGS) OCAMLLIBDIR="$ >> (OCAMLLIBDIR)" SYMROOT=build) >> if [ -e $(UIMACDIR)/build/Default ]; then \ >> gcc -mmacosx-version-min=$(MINOSXVERSION) $(UIMACDIR)/cltool.c -o >> $(UIMACDIR)/build/Default/Unison.app/Contents/MacOS/cltool - >> framework Carbon; \ >> else \ >> >> _______________________________________________ >> Unison-hackers mailing list >> Unison-hackers at lists.seas.upenn.edu >> http://lists.seas.upenn.edu/mailman/listinfo/unison-hackers > > _______________________________________________ > Unison-hackers mailing list > Unison-hackers at lists.seas.upenn.edu > http://lists.seas.upenn.edu/mailman/listinfo/unison-hackers From Jerome.Vouillon at pps.jussieu.fr Thu Jun 4 15:32:27 2009 From: Jerome.Vouillon at pps.jussieu.fr (Jerome Vouillon) Date: Thu, 4 Jun 2009 21:32:27 +0200 Subject: [Unison-hackers] Help building OSX GUI In-Reply-To: References: <12DE3A85-A6F2-4D01-81D9-2949F66827BB@cis.upenn.edu> <2E008972-2CB9-42C0-9827-58C66813CDBB@cis.upenn.edu> <1BED0079-7560-4068-A15B-CB861BA33028@polytechnique.org> <28F17C90-F376-4AE0-8026-271BED414177@kalkwarf.com> <3D552623-2BC0-4696-B4C1-17CC84408F0A@cis.upenn.edu> <4A003BA7.5090803@gmx.net> <3AA479FC-1F08-4A38-BF5B-B9B2F5D3BC1B@cis.upenn.edu> Message-ID: <20090604193226.GB28705@pps.jussieu.fr> Hi Benjamin, On Thu, Jun 04, 2009 at 09:13:15AM -0400, Benjamin Pierce wrote: > Has there been any progress on sorting out the makefiles, etc., for > Unison-with-GUI compilation on OSX? The new 3.11.1 release candidate > apparently fixes the critical bug that was preventing the Unison GUI > from working, I'm eager to see if this is really true... If you can't wait for the makefiles to be fixed, you can edit trunk/src/Makefile.OCaml and replace this line: (cd $(UIMACDIR); xcodebuild OCAMLLIBDIR="$(OCAMLLIBDIR)" SYMROOT=build) with: (cd $(UIMACDIR); xcodebuild -configuration Development OCAMLLIBDIR="$(OCAMLLIBDIR)" SYMROOT=build) -- Jerome From bcpierce at cis.upenn.edu Thu Jun 4 20:46:36 2009 From: bcpierce at cis.upenn.edu (Benjamin Pierce) Date: Thu, 4 Jun 2009 20:46:36 -0400 Subject: [Unison-hackers] Unison 2.32.33 -- new beta release Message-ID: <434EE021-0C25-429A-8E8C-0542B78F6DFA@cis.upenn.edu> I've just exported a tarball for a new release of unison version 2.32, incorporating several useful improvements by Jerome Vouillon. - Benjamin From Jerome.Vouillon at pps.jussieu.fr Mon Jun 8 10:21:24 2009 From: Jerome.Vouillon at pps.jussieu.fr (Jerome Vouillon) Date: Mon, 8 Jun 2009 16:21:24 +0200 Subject: [Unison-hackers] Stasher code... Message-ID: <20090608142123.GA13392@pps.jussieu.fr> Hi, I'm trying to understand the stasher code, but I'm a bit puzzled. In files.ml, we have the following piece of code: let deleteLocal (fspath, (workingDirOpt, path)) = [...] Stasher.backup fspath path `AndRemove [...] If "path" contains a followed link, this will backup and delete the *link*, not the link target as expected. Stasher.backup should call Fspath.findWorkingDir to get the right file to rename or delete. Again in file.ml, we have the following: let make_backup = (* Perform (asynchronously) a backup of the destination files *) Update.updateArchive rootTo pathTo uiTo id The function Update.updateArchive calls the function Stasher.stashCurrentVersion, but only after the destination has been updated (the call is in the archive commit action)... Still, the destination files are backed-up by the call to Stasher.backup in Files.renameLocal. There is also a call to Stasher.stashCurrentVersion in Update.replaceArchive, which is supposed to perform backups using the temporary files before they replace the destination files, but perform backups afterwards. So it does nothing (this is somewhat coherent with the implementation of stashCurrentVersion which does not support recursive traversal of a temporary directory). Stasher.stashCurrentVersion is also called from transport.ml, on both replicas, after updates. As a summary, as far as I can see, Stasher.stashCurrentVersion is called twice on the source files: once from Update.updateArchive (called from File.copy) and then once from Transport.doAction. It is also called twice on the destination files once modified, from the same functions. It is called once on an empty location from Update.replaceArchive. Finally, destination files are backed-up before modification through the call to Stasher.backup in Files.rename. If this analysis is correct, I suspect we can safely remove all calls to Stasher.stashCurrentVersion from file update.ml. -- Jerome From vouillon at seas.upenn.edu Tue Jun 9 04:54:03 2009 From: vouillon at seas.upenn.edu (vouillon@seas.upenn.edu) Date: Tue, 9 Jun 2009 04:54:03 -0400 Subject: [Unison-hackers] [unison-svn] r349 - in trunk/src: . lwt ubase Message-ID: <200906090854.n598s3Jv015657@yaws.seas.upenn.edu> Author: vouillon Date: 2009-06-09 04:53:55 -0400 (Tue, 09 Jun 2009) New Revision: 349 Modified: trunk/src/RECENTNEWS trunk/src/copy.ml trunk/src/fileinfo.ml trunk/src/fileinfo.mli trunk/src/files.ml trunk/src/fspath.ml trunk/src/lwt/lwt_unix.ml trunk/src/mkProjectInfo.ml trunk/src/osx.ml trunk/src/remote.ml trunk/src/remote.mli trunk/src/stasher.ml trunk/src/terminal.ml trunk/src/ubase/uprintf.ml trunk/src/uigtk2.ml trunk/src/update.ml Log: * Improvement to the code for resuming directory transfers: - make sure file information (permissions, ...) has been properly set when using a previously transferred temp file - make sure previously transferred directories are writable * Some cleanup in file transfer implementation * Got rid of all occurrences of "try ... with _ -> ..." * Removed ctime field from Fileinfo.t * Fixed bug in Lwt_unix.run which could make it fail with a Not_found exception Modified: trunk/src/RECENTNEWS =================================================================== --- trunk/src/RECENTNEWS 2009-05-29 17:14:48 UTC (rev 348) +++ trunk/src/RECENTNEWS 2009-06-09 08:53:55 UTC (rev 349) @@ -1,5 +1,18 @@ CHANGES FROM VERSION 2.34.0 +* Improvement to the code for resuming directory transfers: + - make sure file information (permissions, ...) has been properly set + when using a previously transferred temp file + - make sure previously transferred directories are writable +* Some cleanup in file transfer implementation +* Got rid of all occurrences of "try ... with _ -> ..." +* Removed ctime field from Fileinfo.t +* Fixed bug in Lwt_unix.run which could make it fail with a Not_found + exception + +------------------------------- +CHANGES FROM VERSION 2.34.0 + * Fix to the Mac GUI: the bigarray library is now required ------------------------------- CHANGES FROM VERSION 2.34.0 Modified: trunk/src/copy.ml =================================================================== --- trunk/src/copy.ml 2009-05-29 17:14:48 UTC (rev 348) +++ trunk/src/copy.ml 2009-06-09 08:53:55 UTC (rev 349) @@ -22,14 +22,54 @@ (****) +let protect f g = + try + f () + with Sys_error _ | Unix.Unix_error _ | Util.Transient _ as e -> + begin try g () with Sys_error _ | Unix.Unix_error _ -> () end; + raise e + +let lwt_protect f g = + Lwt.catch f + (fun e -> + begin match e with + Sys_error _ | Unix.Unix_error _ | Util.Transient _ -> + begin try g () with Sys_error _ | Unix.Unix_error _ -> () end + | _ -> + () + end; + Lwt.fail e) + +(****) + +let 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) + +(****) + +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) - | `RESS _ -> Osx.openRessIn fspath path + `DATA -> Fs.open_in_bin (Fspath.concat fspath path) + | `RESS -> Osx.openRessIn fspath path -let openFileOut fspath path kind = +let openFileOut fspath path kind len = match kind with - `DATA -> + `DATA -> let fullpath = Fspath.concat fspath path in let flags = [Unix.O_WRONLY;Unix.O_CREAT] in let perm = 0o600 in @@ -50,29 +90,34 @@ in Unix.out_channel_of_descr fd end - | `RESS len -> + | `RESS -> Osx.openRessOut fspath path len -let protect f g = - try - f () - with Sys_error _ | Unix.Unix_error _ | Util.Transient _ as e -> - begin try g () with Sys_error _ | Unix.Unix_error _ -> () end; - raise e +let 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 lwt_protect f g = - Lwt.catch f - (fun e -> - begin match e with - Sys_error _ | Unix.Unix_error _ | Util.Transient _ -> - begin try g () with Sys_error _ | Unix.Unix_error _ -> () end - | _ -> - () - end; - Lwt.fail e) - (****) +let 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 -> + Abort.check id; + Uutil.showProgress id (Uutil.Filesize.ofInt l) "l")); + close_in inFd; + close_out outFd) + (fun () -> close_out_noerr outFd)) + (fun () -> close_in_noerr inFd) + let localFile fspathFrom pathFrom fspathTo pathTo realPathTo update desc ressLength ido = let use_id f = match ido with Some id -> f id | None -> () in @@ -84,43 +129,92 @@ Util.msg "Copy.localFile %s / %s to %s / %s\n" (Fspath.toDebugString fspathFrom) (Path.toString pathFrom) (Fspath.toDebugString fspathTo) (Path.toString pathTo)); - let inFd = openFileIn fspathFrom pathFrom `DATA in - protect (fun () -> - Os.delete fspathTo pathTo; - let outFd = openFileOut fspathTo pathTo `DATA in - protect (fun () -> - Uutil.readWrite inFd outFd - (fun l -> - use_id ( fun id -> - Abort.check id; - Uutil.showProgress id (Uutil.Filesize.ofInt l) "l")); - close_in inFd; - close_out outFd) - (fun () -> close_out_noerr outFd)) - (fun () -> close_in_noerr inFd); - if ressLength > Uutil.Filesize.zero then begin - let inFd = openFileIn fspathFrom pathFrom (`RESS ressLength) in - protect (fun () -> - let outFd = openFileOut fspathTo pathTo (`RESS ressLength) in - protect (fun () -> - Uutil.readWriteBounded inFd outFd ressLength - (fun l -> - use_id (fun id -> - Abort.check id; - Uutil.showProgress id (Uutil.Filesize.ofInt l) "l")); - close_in inFd; - close_out outFd) - (fun () -> close_out_noerr outFd)) - (fun () -> close_in_noerr inFd); - end; - match update with - `Update _ -> - Fileinfo.set fspathTo pathTo (`Copy realPathTo) desc - | `Copy -> - Fileinfo.set fspathTo pathTo (`Set Props.fileDefault) desc) + 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) (****) +(* BCP '06: This is a hack to work around a bug on the Windows platform + that causes lightweight threads on the server to hang. I conjecture that + the problem has to do with the RPC mechanism, which was used here to + make a call *back* from the server to the client inside Trace.log so that + the log message would be appended to the log file on the client. *) +(* BCP '08: Jerome thinks that printing these messages using Util.msg + may be causing the dreaded "assertion failure in remote.ml," which + happens only on windows and seems correlated with the xferbycopying + switch. The conjecture is that some windows ssh servers may combine + the stdout and stderr streams, which would result in these messages + getting interleaved with Unison's RPC protocol stream. *) +let loggit s = + if Prefs.read Globals.someHostIsRunningWindows + then () (* Util.msg "%s" *) + else Trace.log s + +let tryCopyMovedFile fspathTo pathTo realPathTo update desc fp ress id = + Prefs.read Xferhint.xferbycopying + && + Util.convertUnixErrorsToTransient "tryCopyMovedFile" (fun() -> + debug (fun () -> Util.msg "tryCopyMovedFile: -> %s /%s/\n" + (Path.toString pathTo) (Os.fullfingerprint_to_string fp)); + match Xferhint.lookup fp with + None -> + false + | Some (candidateFspath, candidatePath) -> + loggit (Printf.sprintf + "Shortcut: copying %s from local file %s\n" + (Path.toString realPathTo) + (Path.toString candidatePath)); + debug (fun () -> + Util.msg + "tryCopyMovedFile: found match at %s,%s. Try local copying\n" + (Fspath.toDebugString candidateFspath) + (Path.toString candidatePath)); + try + if Os.exists candidateFspath candidatePath then begin + localFile + candidateFspath candidatePath fspathTo pathTo realPathTo + update desc (Osx.ressLength ress) (Some id); + let (info, isTransferred) = + fileIsTransferred fspathTo pathTo desc fp ress in + if isTransferred then begin + debug (fun () -> Util.msg "tryCopyMoveFile: success.\n"); + Xferhint.insertEntry (fspathTo, pathTo) fp; + true + end else begin + debug (fun () -> + Util.msg "tryCopyMoveFile: candidate file modified!"); + Xferhint.deleteEntry (candidateFspath, candidatePath); + Os.delete fspathTo pathTo; + loggit (Printf.sprintf + "Shortcut didn't work because %s was modified\n" + (Path.toString candidatePath)); + false + end + end else begin + loggit (Printf.sprintf + "Shortcut didn't work because %s disappeared!\n" + (Path.toString candidatePath)); + Xferhint.deleteEntry (candidateFspath, candidatePath); + false + end + with + Util.Transient s -> + debug (fun () -> + Util.msg "tryCopyMovedFile: local copy didn't work [%s]" s); + Xferhint.deleteEntry (candidateFspath, candidatePath); + Os.delete fspathTo pathTo; + loggit (Printf.sprintf + "Local copy of %s failed\n" + (Path.toString candidatePath)); + false) + +(****) + (* 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 @@ -136,70 +230,8 @@ ^ "repeated 'rsync failure' errors, setting it to " ^ "false should permit you to synchronize the offending files.") -(* Lazy creation of the destination file *) -let destinationFd fspath path kind outfd = - match !outfd with - None -> - let fd = openFileOut fspath path kind in - outfd := Some fd; - fd - | Some fd -> - fd - let decompressor = ref Remote.MsgIdMap.empty -let startReceivingFile - fspath path realPath fileKind update srcFileSize id file_id = - (* We delay the opening of the file so that there are not too many - temporary files remaining after a crash *) - let outfd = ref None in - let showProgress count = - Abort.check id; - Uutil.showProgress id (Uutil.Filesize.ofInt count) "r" in - (* Install a simple generic decompressor *) - decompressor := - Remote.MsgIdMap.add file_id - (fun ti -> - let fd = destinationFd fspath path fileKind outfd in - Transfer.receive fd showProgress ti) - !decompressor; - if Prefs.read rsyncActivated then begin - match update with - `Update (destFileDataSize, destFileRessSize) - when let destFileSize = - match fileKind with - `DATA -> destFileDataSize - | `RESS _ -> destFileRessSize - in - Transfer.Rsync.aboveRsyncThreshold destFileSize - && Transfer.Rsync.aboveRsyncThreshold srcFileSize -> - Util.convertUnixErrorsToTransient - "preprocessing file" - (fun () -> - let infd = openFileIn fspath realPath fileKind in - (* Now that we've successfully opened the original version - of the file, install a more interesting decompressor *) - decompressor := - Remote.MsgIdMap.add file_id - (fun ti -> - let fd = destinationFd fspath path fileKind outfd in - Transfer.Rsync.rsyncDecompress infd fd showProgress ti) - !decompressor; - let bi = - protect (fun () -> Transfer.Rsync.rsyncPreprocess infd) - (fun () -> close_in_noerr infd) - in - let (firstBi, remBi) = - match bi with - [] -> assert false - | firstBi :: remBi -> (firstBi, remBi) - in - Lwt.return (outfd, ref (Some infd), Some firstBi, remBi)) - | _ -> - Lwt.return (outfd, ref None, None, []) - end else - Lwt.return (outfd, ref None, None, []) - let processTransferInstruction conn (file_id, ti) = Util.convertUnixErrorsToTransient "processing a transfer instruction" @@ -209,10 +241,11 @@ let marshalTransferInstruction = (fun (file_id, (data, pos, len)) rem -> - ((Remote.encodeInt file_id, 0, 4) :: (data, pos, len) :: rem, len + 4)), + (Remote.encodeInt file_id :: (data, pos, len) :: rem, + len + Remote.intSize)), (fun buf pos -> - let len = Bytearray.length buf - pos - 4 in - (Remote.decodeInt buf pos, (buf, pos + 4, len))) + let len = Bytearray.length buf - pos - Remote.intSize in + (Remote.decodeInt buf pos, (buf, pos + Remote.intSize, len))) let processTransferInstructionRemotely = Remote.registerSpecialServerCmd @@ -223,38 +256,37 @@ let compress conn (biOpt, fspathFrom, pathFrom, fileKind, sizeFrom, id, file_id) = - Lwt.catch + Util.convertUnixErrorsToTransient "rsync sender" (fun () -> - let infd = openFileIn fspathFrom pathFrom fileKind in - lwt_protect (fun () -> - let showProgress count = - Abort.check id; - Uutil.showProgress id (Uutil.Filesize.ofInt count) "r" in - let compr = - match biOpt with - None -> Transfer.send infd sizeFrom showProgress - | Some bi -> let remBi = - try - Remote.MsgIdMap.find file_id !blockInfos - with Not_found -> - [] - in - let bi = bi :: remBi in - blockInfos := - Remote.MsgIdMap.remove file_id !blockInfos; - Transfer.Rsync.rsyncCompress - bi infd sizeFrom showProgress - in - compr - (fun ti -> processTransferInstructionRemotely conn (file_id, ti)) - >>= (fun () -> - close_in infd; - Lwt.return ())) - (fun () -> - close_in_noerr infd)) - (fun e -> - Util.convertUnixErrorsToTransient - "rsync sender" (fun () -> raise e)) + let infd = openFileIn fspathFrom pathFrom fileKind in + lwt_protect + (fun () -> + let showProgress count = + Abort.check id; + Uutil.showProgress id (Uutil.Filesize.ofInt count) "r" in + let compr = + match biOpt with + None -> Transfer.send infd sizeFrom showProgress + | Some bi -> let remBi = + try + Remote.MsgIdMap.find file_id !blockInfos + with Not_found -> + [] + in + let bi = bi :: remBi in + blockInfos := + Remote.MsgIdMap.remove file_id !blockInfos; + Transfer.Rsync.rsyncCompress + bi infd sizeFrom showProgress + in + compr + (fun ti -> + processTransferInstructionRemotely conn (file_id, ti)) + >>= fun () -> + close_in infd; + Lwt.return ()) + (fun () -> + close_in_noerr infd)) let compressRemotely = Remote.registerServerCmd "compress" compress @@ -275,32 +307,6 @@ | x :: r -> sendRemBi conn file_id r >>= (fun () -> receiveRemBi conn (file_id, x)) -(****) - -let fileSize (fspath, path) = - Util.convertUnixErrorsToTransient - "getting file size" - (fun () -> - Lwt.return - (Props.length (Fileinfo.get false fspath path).Fileinfo.desc)) - -let fileSizeOnHost = - Remote.registerServerCmd "fileSize" (fun _ -> fileSize) - -(****) - -(* We limit the size of the output buffers to about 512 KB - (we cannot go above the limit below plus 64) *) -let transferFileReg = Lwt_util.make_region 440 - -let bufferSize sz = - min 64 ((truncate (Uutil.Filesize.toFloat sz) + 1023) / 1024) - (* Token queue *) - + - 8 (* Read buffer *) - -(****) - let close_all infd outfd = Util.convertUnixErrorsToTransient "closing files" @@ -324,188 +330,147 @@ | None -> () end +(* Lazy creation of the destination file *) +let destinationFd fspath path kind len outfd = + match !outfd with + None -> + let fd = openFileOut fspath path kind len in + outfd := Some fd; + fd + | Some fd -> + fd + +let transferFileContents + connFrom fspathFrom pathFrom fspathTo pathTo realPathTo update + fileKind srcFileSize id = + (* We delay the opening of the file so that there are not too many + temporary files remaining after a crash *) + let outfd = ref None in + let infd = ref None in + let showProgress count = + Abort.check id; + Uutil.showProgress id (Uutil.Filesize.ofInt count) "r" in + let (bi, decompr) = + match update with + `Update (destFileDataSize, destFileRessSize) + when Prefs.read rsyncActivated + && + let destFileSize = + match fileKind with + `DATA -> destFileDataSize + | `RESS -> destFileRessSize + in + Transfer.Rsync.aboveRsyncThreshold destFileSize + && + Transfer.Rsync.aboveRsyncThreshold srcFileSize -> + Util.convertUnixErrorsToTransient + "preprocessing file" + (fun () -> + let ifd = openFileIn fspathTo realPathTo fileKind in + let bi = + protect (fun () -> Transfer.Rsync.rsyncPreprocess ifd) + (fun () -> close_in_noerr ifd) + in + infd := Some ifd; + (bi, + (* Rsync decompressor *) + fun ti -> + let fd = + destinationFd + fspathTo pathTo fileKind srcFileSize outfd in + let eof = + Transfer.Rsync.rsyncDecompress ifd fd showProgress ti + in + if eof then begin close_out fd; outfd := None end)) + | _ -> + ([], + (* Simple generic decompressor *) + fun ti -> + let fd = destinationFd fspathTo pathTo fileKind srcFileSize outfd in + let eof = Transfer.receive fd showProgress ti in + if eof then begin close_out fd; outfd := None end) + in + let file_id = Remote.newMsgId () in + Lwt.catch + (fun () -> + decompressor := Remote.MsgIdMap.add file_id decompr !decompressor; + Uutil.showProgress id Uutil.Filesize.zero "f"; + let (firstBi, remBi) = + match bi with + [] -> (None, []) + | firstBi :: remBi -> (Some firstBi, remBi) + in + sendRemBi connFrom file_id remBi >>= fun () -> + compressRemotely connFrom + (firstBi, fspathFrom, pathFrom, fileKind, srcFileSize, id, file_id) + >>= fun () -> + decompressor := + Remote.MsgIdMap.remove file_id !decompressor; (* For GC *) + close_all infd outfd; + Lwt.return ()) + (fun e -> + decompressor := + Remote.MsgIdMap.remove file_id !decompressor; (* For GC *) + close_all_no_error infd outfd; + Lwt.fail e) + +(****) + +let fileSize (fspath, path) = + Util.convertUnixErrorsToTransient + "getting file size" + (fun () -> + Lwt.return + (Props.length (Fileinfo.get false fspath path).Fileinfo.desc)) + +let fileSizeOnHost = + Remote.registerServerCmd "fileSize" (fun _ -> fileSize) + +(****) + +let transferRessourceForkAndSetFileinfo + 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; + Lwt.return () + (* The ressOnly flag tells reallyTransferFile to skip transferring the data fork (which has already been taken care of by some external utility) and just transfer the resource fork (which external utilities are not necessarily good at). *) let reallyTransferFile - connFrom fspathFrom pathFrom fspathTo pathTo realPathTo - update desc ressLength ressOnly id = + connFrom fspathFrom pathFrom fspathTo pathTo realPathTo + update desc fp ress ressOnly id = debug (fun() -> Util.msg "reallyTransferFile(%s,%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) (if ressOnly then " (ONLY RESOURCE FORK)" else "")); - let srcFileSize = Props.length desc in - let file_id = Remote.newMsgId () in - - (if ressOnly then + (if ressOnly then (* Skip data fork *) Lwt.return () else begin - (* Data fork *) - if Os.exists fspathTo pathTo then begin - debug (fun() -> Util.msg "Removing old temp file %s / %s\n" - (Fspath.toDebugString fspathTo) (Path.toString pathTo)); - Os.delete fspathTo pathTo - end; - startReceivingFile - fspathTo pathTo realPathTo `DATA update srcFileSize id file_id - >>= (fun (outfd, infd, firstBi, remBi) -> - Lwt.catch (fun () -> - Uutil.showProgress id Uutil.Filesize.zero "f"; - sendRemBi connFrom file_id remBi >>= (fun () -> - compressRemotely connFrom - (firstBi, - fspathFrom, pathFrom, `DATA, srcFileSize, id, file_id) - >>= (fun () -> - decompressor := - Remote.MsgIdMap.remove file_id !decompressor; (* For GC *) - close_all infd outfd; - Lwt.return ()))) - (* catch handler *) - (fun e -> - decompressor := - Remote.MsgIdMap.remove file_id !decompressor; (* For GC *) - close_all_no_error infd outfd; - Lwt.fail e) - )end) >>= (fun () -> + removeOldTempFile fspathTo pathTo; + (* Data fork *) + transferFileContents + connFrom fspathFrom pathFrom fspathTo pathTo realPathTo update + `DATA (Props.length desc) id + end) >>= fun () -> + transferRessourceForkAndSetFileinfo + connFrom fspathFrom pathFrom fspathTo pathTo realPathTo + update desc fp ress id - (* Resource fork *) - (if ressLength > Uutil.Filesize.zero then begin - startReceivingFile - fspathTo pathTo realPathTo - (`RESS ressLength) update ressLength id file_id - >>= (fun (outfd, infd, firstBi, remBi) -> - Lwt.catch (fun () -> - Uutil.showProgress id Uutil.Filesize.zero "f"; - sendRemBi connFrom file_id remBi >>= (fun () -> - compressRemotely connFrom - (firstBi, fspathFrom, pathFrom, - `RESS ressLength, ressLength, id, file_id) - >>= (fun () -> - decompressor := - Remote.MsgIdMap.remove file_id !decompressor; (* For GC *) - close_all infd outfd; - Lwt.return ()))) - (fun e -> - decompressor := - Remote.MsgIdMap.remove file_id !decompressor; (* For GC *) - close_all_no_error infd outfd; - Lwt.fail e)) - end else - Lwt.return ()) >>= (fun () -> - begin match update with - `Update _ -> Fileinfo.set fspathTo pathTo (`Copy realPathTo) desc - | `Copy -> Fileinfo.set fspathTo pathTo (`Set Props.fileDefault) desc - end; - Lwt.return ())) - (****) -(* BCP '06: This is a hack to work around a bug on the Windows platform - that causes lightweight threads on the server to hang. I conjecture that - the problem has to do with the RPC mechanism, which was used here to - make a call *back* from the server to the client inside Trace.log so that - the log message would be appended to the log file on the client. *) -(* BCP '08: Jerome thinks that printing these messages using Util.msg - may be causing the dreaded "assertion failure in remote.ml," which - happens only on windows and seems correlated with the xferbycopying - switch. The conjecture is that some windows ssh servers may combine - the stdout and stderr streams, which would result in these messages - getting interleaved with Unison's RPC protocol stream. *) -let loggit s = - if Prefs.read Globals.someHostIsRunningWindows - then () (* Util.msg "%s" *) - else Trace.log s - -let tryCopyMovedFile fspathTo pathTo realPathTo update desc fp ress id = - Prefs.read Xferhint.xferbycopying - && - begin - Util.convertUnixErrorsToTransient "tryCopyMovedFile" (fun() -> - debug (fun () -> Util.msg "tryCopyMovedFile: -> %s /%s/\n" - (Path.toString pathTo) (Os.fullfingerprint_to_string fp)); - match Xferhint.lookup fp with - None -> - false - | Some (candidateFspath, candidatePath) -> - loggit (Printf.sprintf - "Shortcut: copying %s from local file %s\n" - (Path.toString realPathTo) - (Path.toString candidatePath)); - debug (fun () -> - Util.msg - "tryCopyMovedFile: found match at %s,%s. Try local copying\n" - (Fspath.toDebugString candidateFspath) - (Path.toString candidatePath)); - try - if Os.exists candidateFspath candidatePath then begin - localFile - candidateFspath candidatePath fspathTo pathTo realPathTo - update desc (Osx.ressLength ress) (Some id); - let info = Fileinfo.get false fspathTo pathTo in - let fp' = Os.fingerprint fspathTo pathTo info in - if fp' = fp then begin - debug (fun () -> Util.msg "tryCopyMoveFile: success.\n"); - Xferhint.insertEntry (fspathTo, pathTo) fp; - true - end else begin - debug (fun () -> - Util.msg "tryCopyMoveFile: candidate file modified!"); - Xferhint.deleteEntry (candidateFspath, candidatePath); - Os.delete fspathTo pathTo; - loggit (Printf.sprintf - "Shortcut didn't work because %s was modified\n" - (Path.toString candidatePath)); - false - end - end else begin - loggit (Printf.sprintf - "Shortcut didn't work because %s disappeared!\n" - (Path.toString candidatePath)); - Xferhint.deleteEntry (candidateFspath, candidatePath); - false - end - with - Util.Transient s -> - debug (fun () -> - Util.msg "tryCopyMovedFile: local copy didn't work [%s]" s); - Xferhint.deleteEntry (candidateFspath, candidatePath); - Os.delete fspathTo pathTo; - loggit (Printf.sprintf - "Local copy of %s failed\n" - (Path.toString candidatePath)); - false) - end - -let transferFileLocal connFrom - (fspathFrom, pathFrom, fspathTo, pathTo, realPathTo, - update, desc, fp, ress, ressOnly, id) = - if (not ressOnly) - && tryCopyMovedFile fspathTo pathTo realPathTo update desc fp ress id - then Lwt.return () - else reallyTransferFile - connFrom fspathFrom pathFrom fspathTo pathTo realPathTo - update desc (Osx.ressLength ress) ressOnly id - -let transferFileOnRoot = - Remote.registerRootCmdWithConnection "transferFile" transferFileLocal - -let transferFile - rootFrom pathFrom rootTo fspathTo pathTo realPathTo - update desc fp ress ressOnly id = - let bufSz = bufferSize (max (Props.length desc) (Osx.ressLength ress)) in - (* This must be on the client: any lock on the server side may result - in a deadlock under windows *) - Lwt_util.run_in_region transferFileReg bufSz (fun () -> - Abort.check id; - transferFileOnRoot rootTo rootFrom - (snd rootFrom, pathFrom, fspathTo, pathTo, realPathTo, - update, desc, fp, ress, ressOnly, id)) - -(****) - let copyprog = Prefs.createString "copyprog" "rsync --inplace --compress" "!external program for copying large files" @@ -604,6 +569,16 @@ 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 transferFileUsingExternalCopyprog rootFrom pathFrom rootTo fspathTo pathTo realPathTo update desc fp ress id = @@ -655,6 +630,45 @@ Lwt.return ())) end) +(****) + +(* We limit the size of the output buffers to about 512 KB + (we cannot go above the limit below plus 64) *) +let transferFileReg = Lwt_util.make_region 440 + +let bufferSize sz = + min 64 ((truncate (Uutil.Filesize.toFloat sz) + 1023) / 1024) + (* Token queue *) + + + 8 (* Read buffer *) + +let transferFileLocal connFrom + (fspathFrom, pathFrom, fspathTo, pathTo, realPathTo, + update, desc, fp, ress, ressOnly, id) = + if (not ressOnly) + && tryCopyMovedFile fspathTo pathTo realPathTo update desc fp ress id + then Lwt.return () + else reallyTransferFile + connFrom fspathFrom pathFrom fspathTo pathTo realPathTo + update desc fp ress ressOnly id + +let transferFileOnRoot = + Remote.registerRootCmdWithConnection "transferFile" transferFileLocal + +let transferFile + rootFrom pathFrom rootTo fspathTo pathTo realPathTo + update desc fp ress ressOnly id = + let bufSz = bufferSize (max (Props.length desc) (Osx.ressLength ress)) in + (* This must be on the client: any lock on the server side may result + in a deadlock under windows *) + Lwt_util.run_in_region transferFileReg bufSz (fun () -> + Abort.check id; + transferFileOnRoot rootTo rootFrom + (snd rootFrom, pathFrom, fspathTo, pathTo, realPathTo, + update, desc, fp, ress, ressOnly, id)) + +(****) + let file rootFrom pathFrom rootTo fspathTo pathTo realPathTo update desc fp ress id = debug (fun() -> Util.msg "copyRegFile(%s,%s) -> (%s,%s,%s,%s,%s)\n" @@ -678,19 +692,11 @@ Trace.log (Printf.sprintf "%s/%s has already been transferred\n" (Fspath.toDebugString fspathTo) (Path.toString pathTo)); - Lwt.return () + (* Make sure the file information is right *) + setFileinfoOnRoot rootTo rootFrom (fspathTo, pathTo, desc) (* Check whether we should use an external program to copy the file *) - end else if - Prefs.read copyprog <> "" - && Prefs.read copythreshold >= 0 - && Props.length desc >= Uutil.Filesize.ofInt64 (Int64.of_int 1) - && Props.length desc >= - Uutil.Filesize.ofInt64 - (Int64.mul (Int64.of_int 1000) - (Int64.of_int (Prefs.read copythreshold))) - && update = `Copy - then begin + end else if shouldUseExternalCopyprog update desc then begin (* First use the external program to copy the data fork *) transferFileUsingExternalCopyprog rootFrom pathFrom rootTo fspathTo pathTo realPathTo Modified: trunk/src/fileinfo.ml =================================================================== --- trunk/src/fileinfo.ml 2009-05-29 17:14:48 UTC (rev 348) +++ trunk/src/fileinfo.ml 2009-06-09 08:53:55 UTC (rev 349) @@ -26,8 +26,7 @@ | `DIRECTORY -> "dir" | `SYMLINK -> "symlink" -type t = { typ : typ; inode : int; ctime : float; - desc : Props.t; osX : Osx.info} +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 = @@ -71,14 +70,12 @@ inode = (* The inode number is truncated so that it fits in a 31 bit ocaml integer *) stats.Unix.LargeFile.st_ino land 0x3FFFFFFF; - ctime = stats.Unix.LargeFile.st_ctime; desc = Props.get stats osxInfos; osX = osxInfos } with Unix.Unix_error((Unix.ENOENT | Unix.ENOTDIR),_,_) -> { typ = `ABSENT; inode = 0; - ctime = 0.0; desc = Props.dummy; osX = Osx.getFileInfos fspath path `ABSENT }) @@ -175,13 +172,11 @@ let osxInfos = Osx.defaultInfos typ in { typ = typ; inode = stats.Unix.LargeFile.st_ino land 0x3FFFFFFF; - ctime = stats.Unix.LargeFile.st_ctime; desc = Props.get stats osxInfos; osX = osxInfos } with Unix.Unix_error((Unix.ENOENT | Unix.ENOTDIR),_,_) -> { typ = `ABSENT; inode = 0; - ctime = 0.0; desc = Props.dummy; osX = Osx.defaultInfos `ABSENT }) Modified: trunk/src/fileinfo.mli =================================================================== --- trunk/src/fileinfo.mli 2009-05-29 17:14:48 UTC (rev 348) +++ trunk/src/fileinfo.mli 2009-06-09 08:53:55 UTC (rev 349) @@ -4,8 +4,7 @@ type typ = [`ABSENT | `FILE | `DIRECTORY | `SYMLINK] val type2string : typ -> string -type t = { typ : typ; inode : int; ctime : float; - desc : Props.t; osX : Osx.info} +type t = { typ : typ; inode : int; desc : Props.t; osX : Osx.info} val get : bool -> Fspath.t -> Path.local -> t val set : Fspath.t -> Path.local -> Modified: trunk/src/files.ml =================================================================== --- trunk/src/files.ml 2009-05-29 17:14:48 UTC (rev 348) +++ trunk/src/files.ml 2009-06-09 08:53:55 UTC (rev 349) @@ -139,23 +139,28 @@ setPropRemote2 toRoot (toLocalPath, `Update oldDesc, newDesc)))) (* ------------------------------------------------------------ *) - + let mkdirRemote = Remote.registerRootCmd "mkdir" (fun (fspath,(workingDir,path)) -> - let createIt() = Os.createDir workingDir path Props.dirDefault in - if Os.exists workingDir path then - if (Fileinfo.get false workingDir path).Fileinfo.typ <> `DIRECTORY then begin + 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 info.Fileinfo.desc + end else begin + if info.Fileinfo.typ <> `ABSENT then Os.delete workingDir path; - createIt() - end else () - else - createIt(); - Lwt.return (Fileinfo.get false workingDir path).Fileinfo.desc) - + Os.createDir workingDir path Props.dirDefault; + Lwt.return (Fileinfo.get false workingDir path).Fileinfo.desc + end) + let mkdir onRoot workingDir path = mkdirRemote onRoot (workingDir,path) - + (* ------------------------------------------------------------ *) let renameLocal (root, (localTargetPath, fspath, pathFrom, pathTo)) = @@ -362,7 +367,7 @@ (root2string rootTo) (Path.toString pathTo)); (* Calculate target paths *) setupTargetPaths rootTo pathTo - >>= (fun (workingDir, realPathTo, tempPathTo, localPathTo) -> + >>= fun (workingDir, realPathTo, tempPathTo, localPathTo) -> (* Inner loop for recursive copy... *) let rec copyRec pFrom (* Path to copy from *) pTo (* (Temp) path to copy to *) @@ -449,19 +454,17 @@ the changes yet) and return the part of the new archive corresponding to this path *) Update.updateArchive rootFrom pathFrom uiFrom id - >>= (fun (localPathFrom, archFrom) -> + >>= fun (localPathFrom, archFrom) -> let make_backup = (* Perform (asynchronously) a backup of the destination files *) Update.updateArchive rootTo pathTo uiTo id in - copyRec localPathFrom tempPathTo realPathTo archFrom >>= (fun () -> - make_backup >>= (fun _ -> + copyRec localPathFrom tempPathTo realPathTo archFrom >>= fun () -> + make_backup >>= fun _ -> Update.replaceArchive rootTo pathTo (Some (workingDir, tempPathTo)) - archFrom id true true >>= (fun _ -> - rename rootTo pathTo localPathTo workingDir tempPathTo realPathTo uiTo >>= (fun() -> - debug (fun() -> Util.msg "Removing temp files\n"); - performDelete rootTo (Some workingDir, tempPathTo) ))))))) + archFrom id true true >>= fun _ -> + rename rootTo pathTo localPathTo workingDir tempPathTo realPathTo uiTo) (* ------------------------------------------------------------ *) Modified: trunk/src/fspath.ml =================================================================== --- trunk/src/fspath.ml 2009-05-29 17:14:48 UTC (rev 348) +++ trunk/src/fspath.ml 2009-06-09 08:53:55 UTC (rev 349) @@ -76,7 +76,7 @@ try let n' = String.rindex_from f (len-n) '/' in String.sub f (n'+1) (len-n'-1) - with _ -> f in + with Not_found -> f in let s1 = suffix f1 len1 in let s2 = suffix f2 len2 in (s1,s2) Modified: trunk/src/lwt/lwt_unix.ml =================================================================== --- trunk/src/lwt/lwt_unix.ml 2009-05-29 17:14:48 UTC (rev 348) +++ trunk/src/lwt/lwt_unix.ml 2009-06-09 08:53:55 UTC (rev 349) @@ -141,33 +141,39 @@ restart_threads !event_counter now; List.iter (fun fd -> - match List.assoc fd !inputs with - `Read (buf, pos, len, res) -> - wrap_syscall inputs fd res - (fun () -> Unix.read fd buf pos len) - | `Accept res -> - wrap_syscall inputs fd res - (fun () -> - let (s, _) as v = Unix.accept fd in - if not windows_hack then Unix.set_nonblock s; - v) - | `Wait res -> - wrap_syscall inputs fd res (fun () -> ())) + try + match List.assoc fd !inputs with + `Read (buf, pos, len, res) -> + wrap_syscall inputs fd res + (fun () -> Unix.read fd buf pos len) + | `Accept res -> + wrap_syscall inputs fd res + (fun () -> + let (s, _) as v = Unix.accept fd in + if not windows_hack then Unix.set_nonblock s; + v) + | `Wait res -> + wrap_syscall inputs fd res (fun () -> ()) + with Not_found -> + ()) readers; List.iter (fun fd -> - match List.assoc fd !outputs with - `Write (buf, pos, len, res) -> - wrap_syscall outputs fd res - (fun () -> Unix.write fd buf pos len) - | `CheckSocket res -> - wrap_syscall outputs fd res - (fun () -> - try ignore (Unix.getpeername fd) with - Unix.Unix_error (Unix.ENOTCONN, _, _) -> - ignore (Unix.read fd " " 0 1)) - | `Wait res -> - wrap_syscall inputs fd res (fun () -> ())) + try + match List.assoc fd !outputs with + `Write (buf, pos, len, res) -> + wrap_syscall outputs fd res + (fun () -> Unix.write fd buf pos len) + | `CheckSocket res -> + wrap_syscall outputs fd res + (fun () -> + try ignore (Unix.getpeername fd) with + Unix.Unix_error (Unix.ENOTCONN, _, _) -> + ignore (Unix.read fd " " 0 1)) + | `Wait res -> + wrap_syscall inputs fd res (fun () -> ()) + with Not_found -> + ()) writers; if !child_exited then begin child_exited := false; @@ -208,6 +214,8 @@ let write ch buf pos len = try + if windows_hack && recent_ocaml then + raise (Unix.Unix_error (Unix.EAGAIN, "", "")); Lwt.return (Unix.write ch buf pos len) with Unix.Unix_error ((Unix.EAGAIN | Unix.EWOULDBLOCK), _, _) -> @@ -284,11 +292,7 @@ let system cmd = match Unix.fork () with - 0 -> begin try - Unix.execv "/bin/sh" [| "/bin/sh"; "-c"; cmd |] - with _ -> - exit 127 - end + 0 -> Unix.execv "/bin/sh" [| "/bin/sh"; "-c"; cmd |] | id -> Lwt.bind (waitpid [] id) (fun (pid, status) -> Lwt.return status) (****) Modified: trunk/src/mkProjectInfo.ml =================================================================== --- trunk/src/mkProjectInfo.ml 2009-05-29 17:14:48 UTC (rev 348) +++ trunk/src/mkProjectInfo.ml 2009-06-09 08:53:55 UTC (rev 349) @@ -158,3 +158,4 @@ + Modified: trunk/src/osx.ml =================================================================== --- trunk/src/osx.ml 2009-05-29 17:14:48 UTC (rev 348) +++ trunk/src/osx.ml 2009-06-09 08:53:55 UTC (rev 349) @@ -110,6 +110,7 @@ raise e let openDouble fspath path = + let (fspath, path) = Fspath.findWorkingDir fspath path in let path = Fspath.appleDouble (Fspath.concat fspath path) in let inch = try Fs.open_in_bin path with Sys_error _ -> raise Not_found in protect (fun () -> @@ -212,7 +213,6 @@ with Unix.Unix_error ((Unix.EOPNOTSUPP | Unix.ENOSYS), _, _) -> (* Not a HFS volume. Look for an AppleDouble file *) try - let (fspath, path) = Fspath.findWorkingDir fspath path in let (doublePath, inch, entries) = openDouble fspath path in let (rsrcOffset, rsrcLength) = try Safelist.assoc `RSRC entries with Not_found -> @@ -281,7 +281,6 @@ setFileInfosInternal p (insertInfo fullFinfo finfo) with Unix.Unix_error ((Unix.EOPNOTSUPP | Unix.ENOSYS), _, _) -> (* Not an HFS volume. Look for an AppleDouble file *) - let (fspath, path) = Fspath.findWorkingDir fspath path in begin try let (doublePath, inch, entries) = openDouble fspath path in begin try Modified: trunk/src/remote.ml =================================================================== --- trunk/src/remote.ml 2009-05-29 17:14:48 UTC (rev 348) +++ trunk/src/remote.ml 2009-06-09 08:53:55 UTC (rev 349) @@ -18,7 +18,7 @@ let (>>=) = Lwt.bind let debug = Trace.debug "remote" -let debugV = Trace.debug "remote+" +let debugV = Trace.debug "remote_emit+" let debugE = Trace.debug "remote+" let debugT = Trace.debug "remote+" @@ -29,16 +29,21 @@ *) let windowsHack = Sys.os_type <> "Unix" +let recent_ocaml = + Scanf.sscanf Sys.ocaml_version "%d.%d" + (fun maj min -> (maj = 3 && min >= 11) || maj > 3) (****) +let intSize = 4 + let encodeInt m = - let int_buf = Bytearray.create 4 in + 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 + (int_buf, 0, intSize) let decodeInt int_buf i = let b0 = Char.code (int_buf.{i + 0}) in @@ -198,7 +203,7 @@ conn.canWrite <- false; debugE (fun() -> Util.msg "Sending write token\n"); (* Special message allowing the other side to write *) - fill_buffer conn [(encodeInt 0, 0, 4)] >>= (fun () -> + fill_buffer conn [encodeInt 0] >>= (fun () -> flush_buffer conn) >>= (fun () -> if windowsHack then begin debugE (fun() -> Util.msg "Restarting reader\n"); @@ -218,11 +223,6 @@ Lwt.return () end -let rec msg_length l = - match l with - [] -> 0 - | (s, p, l)::r -> l + msg_length r - (* Send all pending messages *) let rec dump_rec conn = try @@ -350,22 +350,8 @@ else Bytearray.sub s p len -(* An integer just a little smaller than the maximum representable in 30 bits *) -let hugeint = 1000000000 - let safeMarshal marshalPayload tag data rem = let (rem', length) = marshalPayload data rem in - if length > hugeint then begin - let start = first_chars (min length 10) rem' in - let start = if length > 10 then start ^ "..." else start in - let start = String.escaped start in - Util.msg "Fatal error in safeMarshal: sending too many (%d) bytes with tag %s and contents [%s]\n" length (Bytearray.to_string tag) start; - raise (Util.Fatal ((Printf.sprintf - "Message payload too large (%d, %s, [%s]). \n" - length (Bytearray.to_string tag) start) - ^ "This is a bug in Unison; if it happens to you in a repeatable way, \n" - ^ "please post a report on the unison-users mailing list.")) - end; let l = Bytearray.length tag in debugE (fun() -> let start = first_chars (min length 10) rem' in @@ -373,7 +359,7 @@ let start = String.escaped start in Util.msg "send [%s] '%s' %d bytes\n" (Bytearray.to_string tag) start length); - ((encodeInt (l + length), 0, 4) :: (tag, 0, l) :: rem') + (encodeInt (l + length) :: (tag, 0, l) :: rem') let safeUnmarshal unmarshalPayload tag buf = let taglength = Bytearray.length tag in @@ -526,8 +512,8 @@ let receivePacket conn = (* Get the length of the packet *) - let int_buf = Bytearray.create 4 in - grab conn int_buf 4 >>= (fun () -> + let int_buf = Bytearray.create intSize in + grab conn int_buf intSize >>= (fun () -> let length = decodeInt int_buf 0 in assert (length >= 0); (* Get packet *) @@ -563,22 +549,25 @@ Lwt.try_bind (fun () -> cmd conn buf) (fun marshal -> debugE (fun () -> Util.msg "Sending result (id: %d)\n" (decodeInt id 0)); - dump conn ((id, 0, 4) :: marshalHeader NormalResult (marshal []))) + 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, 4) :: marshalHeader (TransientExn s) []) + 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, 4) :: marshalHeader (FatalExn s) []) + dump conn ((id, 0, intSize) :: marshalHeader (FatalExn s) []) | e -> Lwt.fail e) (* 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 @@ -593,7 +582,7 @@ (* Receiving thread: read a message and dispatch it to the right thread or create a new thread to process requests. *) let rec receive conn = - (if windowsHack && conn.canWrite then + (if windowsHack && conn.canWrite && not recent_ocaml then let wait = Lwt.wait () in assert (conn.reader = None); conn.reader <- Some wait; @@ -602,8 +591,8 @@ Lwt.return ()) >>= (fun () -> debugE (fun () -> Util.msg "Waiting for next message\n"); (* Get the message ID *) - let id = Bytearray.create 4 in - grab conn id 4 >>= (fun () -> + let id = Bytearray.create intSize in + grab conn 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"); @@ -679,7 +668,7 @@ let id = newMsgId () in (* Message ID *) assert (id >= 0); (* tracking down an assert failure in receivePacket... *) let request = - (encodeInt id, 0, 4) :: + encodeInt id :: marshalHeader (Request cmdName) (marshalArgs serverArgs []) in let reply = wait_for_reply id in @@ -1113,12 +1102,13 @@ Lwt.return ()) let openConnectionCancel (i1,i2,o1,o2,s,fdopt,clroot,pid) = - try Unix.kill pid Sys.sigkill with _ -> (); - try Unix.close i1 with _ -> (); - try Unix.close i2 with _ -> (); - try Unix.close o1 with _ -> (); - try Unix.close o2 with _ -> (); - match fdopt with None -> () | Some fd -> (try Unix.close fd with _ -> ()) + try Unix.kill pid Sys.sigkill with Unix.Unix_error _ -> (); + try Unix.close i1 with Unix.Unix_error _ -> (); + try Unix.close i2 with Unix.Unix_error _ -> (); + try Unix.close o1 with Unix.Unix_error _ -> (); + try Unix.close o2 with Unix.Unix_error _ -> (); + match fdopt with + None -> () | Some fd -> (try Unix.close fd with Unix.Unix_error _ -> ()) (****************************************************************************) (* SERVER-MODE COMMAND PROCESSING LOOP *) Modified: trunk/src/remote.mli =================================================================== --- trunk/src/remote.mli 2009-05-29 17:14:48 UTC (rev 348) +++ trunk/src/remote.mli 2009-06-09 08:53:55 UTC (rev 349) @@ -94,7 +94,8 @@ ('a -> (Bytearray.t * int * int) list -> (Bytearray.t * int * int) list * int) * (Bytearray.t -> int -> 'b) -val encodeInt : int -> Bytearray.t +val intSize : int +val encodeInt : int -> Bytearray.t * int * int val decodeInt : Bytearray.t -> int -> int val registerRootCmdWithConnection : string (* command name *) Modified: trunk/src/stasher.ml =================================================================== --- trunk/src/stasher.ml 2009-05-29 17:14:48 UTC (rev 348) +++ trunk/src/stasher.ml 2009-06-09 08:53:55 UTC (rev 349) @@ -329,7 +329,7 @@ let path0 = makeBackupName path 0 in let sourceTyp = (Fileinfo.get true fspath path).Fileinfo.typ in - let path0Typ = (Fileinfo.get true sFspath path0).Fileinfo.typ in + let path0Typ = (Fileinfo.get false sFspath path0).Fileinfo.typ in if ( sourceTyp = `FILE && path0Typ = `FILE && (Fingerprint.file fspath path) = (Fingerprint.file sFspath path0)) @@ -408,13 +408,13 @@ debug (fun () -> Util.msg " Finished copying; deleting %s / %s\n" (Fspath.toDebugString fspath) (Path.toString path)); disposeIfNeeded() in - try - if finalDisposition = `AndRemove then + if finalDisposition = `AndRemove then + try Os.rename "backup" fspath path backRoot backPath - else + with Util.Transient _ -> + debug (fun () -> Util.msg "Rename failed -- copying instead\n"); byCopying() - with _ -> - debug (fun () -> Util.msg "Rename failed -- copying instead\n"); + else byCopying() end else begin debug (fun () -> Util.msg "Path %s / %s does not need to be backed up\n" Modified: trunk/src/terminal.ml =================================================================== --- trunk/src/terminal.ml 2009-05-29 17:14:48 UTC (rev 348) +++ trunk/src/terminal.ml 2009-06-09 08:53:55 UTC (rev 349) @@ -77,7 +77,7 @@ x.[9] <- a2.(j); let fdOpt = try Some(Unix.openfile x [Unix.O_RDWR] 0) - with _ -> None in + with Unix.Unix_error _ -> None in match fdOpt with None -> () | Some fdMaster -> x.[5] <- 't'; @@ -92,7 +92,7 @@ | Some(fdMaster,ttySlave) -> let slave = try Some (Unix.openfile ttySlave [Unix.O_RDWR] 0o600) - with _ -> None in + with Unix.Unix_error _ -> None in (try Unix.close fdMaster with Unix.Unix_error(_,_,_) -> ()); slave @@ -202,7 +202,7 @@ Unix.tcsetattr slaveFd Unix.TCSANOW tio; perform_redirections new_stdin new_stdout new_stderr; Unix.execvp cmd args (* never returns *) - with _ -> + with Unix.Unix_error _ -> Printf.eprintf "Some error in create_session child\n"; flush stderr; exit 127 Modified: trunk/src/ubase/uprintf.ml =================================================================== --- trunk/src/ubase/uprintf.ml 2009-05-29 17:14:48 UTC (rev 348) +++ trunk/src/ubase/uprintf.ml 2009-06-09 08:53:55 UTC (rev 349) @@ -37,7 +37,7 @@ let p = try int_of_string (String.sub format (i+1) (j-i-1)) - with _ -> + with Failure _ -> invalid_arg "fprintf: bad %s format" in if p > 0 && String.length s < p then begin output_string outchan Modified: trunk/src/uigtk2.ml =================================================================== --- trunk/src/uigtk2.ml 2009-05-29 17:14:48 UTC (rev 348) +++ trunk/src/uigtk2.ml 2009-06-09 08:53:55 UTC (rev 349) @@ -1976,6 +1976,7 @@ let detectCmdName = "Restart" in let detectCmd () = getLock detectUpdatesAndReconcile; + updateDetails (); if Prefs.read Globals.batch then begin Prefs.set Globals.batch false; synchronize() end Modified: trunk/src/update.ml =================================================================== --- trunk/src/update.ml 2009-05-29 17:14:48 UTC (rev 348) +++ trunk/src/update.ml 2009-06-09 08:53:55 UTC (rev 349) @@ -626,7 +626,7 @@ (* commitActions(thisRoot, id) <- action *) let setCommitAction (thisRoot: string) (id: int) (action: unit -> unit): unit = let key = (thisRoot, id) in - Hashtbl.add commitActions key action + Hashtbl.replace commitActions key action (* perform and remove the action associated with (thisRoot, id) *) let softCommitLocal (thisRoot: string) (id: int) = @@ -1165,8 +1165,7 @@ (Util.msg "archStamp is inode (%d)" inode; Util.msg " / info.inode (%d)" info.Fileinfo.inode) | Fileinfo.CtimeStamp stamp -> - (Util.msg "archStamp is ctime (%f)" stamp; - Util.msg " / info.ctime (%f)" info.Fileinfo.ctime) + (Util.msg "archStamp is ctime (%f)" stamp) end; Util.msg " / times: %f = %f... %b" (Props.time archDesc) (Props.time info.Fileinfo.desc) @@ -1627,10 +1626,6 @@ let findUpdates () : Common.updateItem list Common.oneperpath = (* TODO: We should filter the paths to remove duplicates (including prefixes) and ignored paths *) -(* FIX: The following line can be deleted -- it's just for debugging *) -debug (fun() -> Util.msg "Running bogus external program\n"); -let _ = External.runExternalProgram "dir" in -debug (fun() -> Util.msg "Finished running bogus external program\n"); findUpdatesOnPaths (Prefs.read Globals.paths) From vouillon at seas.upenn.edu Tue Jun 9 11:41:38 2009 From: vouillon at seas.upenn.edu (vouillon@seas.upenn.edu) Date: Tue, 9 Jun 2009 11:41:38 -0400 Subject: [Unison-hackers] [unison-svn] r350 - trunk/src Message-ID: <200906091541.n59FfchV002156@yaws.seas.upenn.edu> Author: vouillon Date: 2009-06-09 11:41:29 -0400 (Tue, 09 Jun 2009) New Revision: 350 Modified: trunk/src/.depend trunk/src/RECENTNEWS trunk/src/abort.ml trunk/src/abort.mli trunk/src/copy.ml trunk/src/copy.mli trunk/src/files.ml trunk/src/mkProjectInfo.ml trunk/src/remote.ml trunk/src/remote.mli trunk/src/transfer.ml trunk/src/transfer.mli trunk/src/transport.ml trunk/src/update.ml trunk/src/update.mli Log: * Bumped minor version: many incompatible protocol changes * Message lengths are checksummed to guard against protocol corruption (no more [Invalid_argument "String.create"]) * 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) * 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) * More file transfer implementation cleanup. In particular, the "paranoid check" (checking whether the file has been correctly transferred) is moved to copy.ml. This way, one can avoid computing a file fingerprint twice when a file is already transferred, and when using the "transfer by copying" optimization. The check of the source file is also moved to copy.ml, so if the paranoid check fails, we can tell whether this is due to the source file being modified. Modified: trunk/src/.depend =================================================================== --- trunk/src/.depend 2009-06-09 08:53:55 UTC (rev 349) +++ trunk/src/.depend 2009-06-09 15:41:29 UTC (rev 350) @@ -1,4 +1,4 @@ -abort.cmi: uutil.cmi +abort.cmi: uutil.cmi lwt/lwt.cmi bytearray.cmi: case.cmi: ubase/prefs.cmi checksum.cmi: @@ -6,7 +6,7 @@ common.cmi: uutil.cmi props.cmi path.cmi osx.cmi os.cmi name.cmi fspath.cmi \ fileinfo.cmi copy.cmi: uutil.cmi props.cmi path.cmi osx.cmi os.cmi lwt/lwt.cmi fspath.cmi \ - common.cmi + fileinfo.cmi common.cmi external.cmi: fileinfo.cmi: system.cmi props.cmi path.cmi osx.cmi fspath.cmi files.cmi: uutil.cmi system.cmi props.cmi path.cmi lwt/lwt_util.cmi \ @@ -46,9 +46,9 @@ uutil.cmi: xferhint.cmi: ubase/prefs.cmi path.cmi os.cmi fspath.cmi abort.cmo: uutil.cmi ubase/util.cmi ubase/trace.cmi ubase/safelist.cmi \ - abort.cmi + lwt/lwt_util.cmi lwt/lwt.cmi abort.cmi abort.cmx: uutil.cmx ubase/util.cmx ubase/trace.cmx ubase/safelist.cmx \ - abort.cmi + lwt/lwt_util.cmx lwt/lwt.cmx abort.cmi bytearray.cmo: bytearray.cmi bytearray.cmx: bytearray.cmi case.cmo: ubase/util.cmi unicode.cmi ubase/prefs.cmi case.cmi @@ -154,11 +154,13 @@ 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_unix.cmi lwt/lwt.cmi \ - fspath.cmi fs.cmi common.cmi clroot.cmi case.cmi bytearray.cmi remote.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_unix.cmx lwt/lwt.cmx \ - fspath.cmx fs.cmx common.cmx clroot.cmx case.cmx bytearray.cmx remote.cmi + 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 \ @@ -269,14 +271,14 @@ system.cmi stasher.cmi ubase/safelist.cmi remote.cmi props.cmi \ ubase/prefs.cmi pred.cmi path.cmi osx.cmi os.cmi name.cmi ubase/myMap.cmi \ lwt/lwt_unix.cmi lwt/lwt.cmi lock.cmi globals.cmi fspath.cmi fs.cmi \ - fingerprint.cmi fileinfo.cmi external.cmi common.cmi update.cmi + 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 stasher.cmx ubase/safelist.cmx remote.cmx props.cmx \ ubase/prefs.cmx pred.cmx path.cmx osx.cmx os.cmx name.cmx ubase/myMap.cmx \ lwt/lwt_unix.cmx lwt/lwt.cmx lock.cmx globals.cmx fspath.cmx fs.cmx \ - fingerprint.cmx fileinfo.cmx external.cmx common.cmx update.cmi -uutil.cmo: ubase/util.cmi ubase/projectInfo.cmo uutil.cmi -uutil.cmx: ubase/util.cmx ubase/projectInfo.cmx uutil.cmi + fingerprint.cmx fileinfo.cmx common.cmx case.cmx update.cmi +uutil.cmo: ubase/util.cmi ubase/trace.cmi ubase/projectInfo.cmo uutil.cmi +uutil.cmx: ubase/util.cmx ubase/trace.cmx ubase/projectInfo.cmx uutil.cmi xferhint.cmo: ubase/util.cmi ubase/trace.cmi ubase/prefs.cmi path.cmi os.cmi \ fspath.cmi xferhint.cmi xferhint.cmx: ubase/util.cmx ubase/trace.cmx ubase/prefs.cmx path.cmx os.cmx \ Modified: trunk/src/RECENTNEWS =================================================================== --- trunk/src/RECENTNEWS 2009-06-09 08:53:55 UTC (rev 349) +++ trunk/src/RECENTNEWS 2009-06-09 15:41:29 UTC (rev 350) @@ -1,3 +1,43 @@ +CHANGES FROM VERSION 2.35.-17 + +* Bumped minor version: many incompatible protocol changes + +* Message lengths are checksummed to guard against protocol corruption + (no more [Invalid_argument "String.create"]) + +* 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) + +* 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) + +* More file transfer implementation cleanup. In particular, the + "paranoid check" (checking whether the file has been correctly + transferred) is moved to copy.ml. This way, one can avoid computing + a file fingerprint twice when a file is already transferred, and + when using the "transfer by copying" optimization. + The check of the source file is also moved to copy.ml, so if the + paranoid check fails, we can tell whether this is due to the source + file being modified. + +------------------------------- CHANGES FROM VERSION 2.34.0 * Improvement to the code for resuming directory transfers: Modified: trunk/src/abort.ml =================================================================== --- trunk/src/abort.ml 2009-06-09 08:53:55 UTC (rev 349) +++ trunk/src/abort.ml 2009-06-09 15:41:29 UTC (rev 350) @@ -44,3 +44,26 @@ end let testException e = e = Util.Transient "Aborted" + +let (>>=) = Lwt.bind + +let mergeErrors id e runningThreads = + if not (testException e) then file id; + match e with + Util.Transient _ -> + let e = ref e in + Lwt_util.iter + (fun act -> + Lwt.catch + (fun () -> act >>= fun _ -> Lwt.return ()) + (fun e' -> + match e' with + Util.Transient _ -> + if testException !e then e := e'; + Lwt.return () + | _ -> + Lwt.fail e')) + runningThreads >>= fun () -> + Lwt.fail !e + | _ -> + Lwt.fail e Modified: trunk/src/abort.mli =================================================================== --- trunk/src/abort.mli 2009-06-09 08:53:55 UTC (rev 349) +++ trunk/src/abort.mli 2009-06-09 15:41:29 UTC (rev 350) @@ -13,3 +13,8 @@ (* Test whether the exeption is an abort exception. *) val testException : exn -> bool + +(* When one thread has failed (in a non-fatal way), this function will + abort the current transfer and wait for all other threads in the + list to terminate before continuing *) +val mergeErrors : Uutil.File.t -> exn -> 'a Lwt.t list -> 'b Lwt.t Modified: trunk/src/copy.ml =================================================================== --- trunk/src/copy.ml 2009-06-09 08:53:55 UTC (rev 349) +++ trunk/src/copy.ml 2009-06-09 15:41:29 UTC (rev 350) @@ -42,17 +42,102 @@ (****) +(* Check whether the source file has been modified during synchronization *) +let checkContentsChangeLocal + fspathFrom pathFrom archDesc archDig archStamp archRess paranoid = + let info = Fileinfo.get true fspathFrom pathFrom in + let clearlyModified = + info.Fileinfo.typ <> `FILE + || Props.length info.Fileinfo.desc <> Props.length archDesc + || Osx.ressLength info.Fileinfo.osX.Osx.ressInfo <> + Osx.ressLength archRess + in + let dataClearlyUnchanged = + not clearlyModified + && Props.same_time info.Fileinfo.desc archDesc +(*FIX: should export from update.ml? + && not (excelFile path) +*) + && match archStamp with + Some (Fileinfo.InodeStamp inode) -> info.Fileinfo.inode = inode + | Some (Fileinfo.CtimeStamp ctime) -> true + | None -> false + in + let ressClearlyUnchanged = + not clearlyModified + && Osx.ressUnchanged archRess info.Fileinfo.osX.Osx.ressInfo + None dataClearlyUnchanged + in + if dataClearlyUnchanged && ressClearlyUnchanged then begin + if paranoid then begin + let newDig = Os.fingerprint fspathFrom pathFrom info in + if archDig <> newDig then + 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 else if + clearlyModified + || archDig <> Os.fingerprint fspathFrom pathFrom info + then + raise (Util.Transient (Printf.sprintf + "The source file %s\nhas been modified during synchronization. \ + Transfer aborted." + (Fspath.toPrintString (Fspath.concat fspathFrom pathFrom)))) + +let checkContentsChangeOnHost = + Remote.registerRootCmd + "checkContentsChange" + (fun (fspathFrom, + (pathFrom, archDesc, archDig, archStamp, archRess, paranoid)) -> + checkContentsChangeLocal + fspathFrom pathFrom archDesc archDig archStamp archRess paranoid; + Lwt.return ()) + +let checkContentsChange + root pathFrom archDesc archDig archStamp archRess paranoid = + checkContentsChangeOnHost + root (pathFrom, archDesc, archDig, archStamp, archRess, paranoid) + +(****) + let fileIsTransferred fspathTo pathTo desc fp ress = let info = Fileinfo.get false fspathTo pathTo in (info, - info.Fileinfo.typ = `FILE && + info.Fileinfo.typ = `FILE + && Props.length info.Fileinfo.desc = Props.length desc - && Osx.ressLength info.Fileinfo.osX.Osx.ressInfo = - Osx.ressLength ress - && + && + Osx.ressLength info.Fileinfo.osX.Osx.ressInfo = + Osx.ressLength ress + && let fp' = Os.fingerprint fspathTo pathTo info in fp' = fp) +type transferStatus = + Success of Fileinfo.t + | Failure of string + +(* Paranoid check: recompute the transferred file's digest to match it + with the archive's *) +let paranoidCheck fspathTo pathTo desc fp ress = + let info = Fileinfo.get false fspathTo pathTo in + let fp' = Os.fingerprint fspathTo pathTo info in + if fp' <> fp then begin + let savepath = Path.addSuffixToFinalName pathTo "-bad" in + Os.rename "save temp" fspathTo pathTo fspathTo savepath; + Lwt.return (Failure (Printf.sprintf + "The file %s was incorrectly transferred (fingerprint mismatch in %s) \ + -- temp file saved as %s" + (Path.toString pathTo) + (Os.reasonForFingerprintMismatch fp fp') + (Path.toString savepath))) + end else + Lwt.return (Success info) + (****) let removeOldTempFile fspathTo pathTo = @@ -156,14 +241,13 @@ else Trace.log s let tryCopyMovedFile fspathTo pathTo realPathTo update desc fp ress id = - Prefs.read Xferhint.xferbycopying - && + 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 -> - false + None | Some (candidateFspath, candidatePath) -> loggit (Printf.sprintf "Shortcut: copying %s from local file %s\n" @@ -184,7 +268,7 @@ if isTransferred then begin debug (fun () -> Util.msg "tryCopyMoveFile: success.\n"); Xferhint.insertEntry (fspathTo, pathTo) fp; - true + Some info end else begin debug (fun () -> Util.msg "tryCopyMoveFile: candidate file modified!"); @@ -193,14 +277,14 @@ loggit (Printf.sprintf "Shortcut didn't work because %s was modified\n" (Path.toString candidatePath)); - false + None end end else begin loggit (Printf.sprintf "Shortcut didn't work because %s disappeared!\n" (Path.toString candidatePath)); Xferhint.deleteEntry (candidateFspath, candidatePath); - false + None end with Util.Transient s -> @@ -211,7 +295,7 @@ loggit (Printf.sprintf "Local copy of %s failed\n" (Path.toString candidatePath)); - false) + None) (****) @@ -236,8 +320,7 @@ Util.convertUnixErrorsToTransient "processing a transfer instruction" (fun () -> - ignore (Remote.MsgIdMap.find file_id !decompressor ti)); - Lwt.return () + ignore (Remote.MsgIdMap.find file_id !decompressor ti)) let marshalTransferInstruction = (fun (file_id, (data, pos, len)) rem -> @@ -247,17 +330,17 @@ let len = Bytearray.length buf - pos - Remote.intSize in (Remote.decodeInt buf pos, (buf, pos + Remote.intSize, len))) -let processTransferInstructionRemotely = - Remote.registerSpecialServerCmd +let streamTransferInstruction = + Remote.registerStreamCmd "processTransferInstruction" marshalTransferInstruction - Remote.defaultMarshalingFunctions processTransferInstruction + processTransferInstruction -let blockInfos = ref Remote.MsgIdMap.empty - let compress conn (biOpt, fspathFrom, pathFrom, fileKind, sizeFrom, id, file_id) = Util.convertUnixErrorsToTransient "rsync sender" (fun () -> + streamTransferInstruction conn + (fun processTransferInstructionRemotely -> let infd = openFileIn fspathFrom pathFrom fileKind in lwt_protect (fun () -> @@ -266,47 +349,22 @@ Uutil.showProgress id (Uutil.Filesize.ofInt count) "r" in let compr = match biOpt with - None -> Transfer.send infd sizeFrom showProgress - | Some bi -> let remBi = - try - Remote.MsgIdMap.find file_id !blockInfos - with Not_found -> - [] - in - let bi = bi :: remBi in - blockInfos := - Remote.MsgIdMap.remove file_id !blockInfos; - Transfer.Rsync.rsyncCompress - bi infd sizeFrom showProgress + None -> + Transfer.send infd sizeFrom showProgress + | Some bi -> + Transfer.Rsync.rsyncCompress + bi infd sizeFrom showProgress in compr - (fun ti -> - processTransferInstructionRemotely conn (file_id, ti)) + (fun ti -> processTransferInstructionRemotely (file_id, ti)) >>= fun () -> close_in infd; Lwt.return ()) (fun () -> - close_in_noerr infd)) + close_in_noerr infd))) let compressRemotely = Remote.registerServerCmd "compress" compress -let receiveRemBiLocally _ (file_id, bi) = - let bil = - try - Remote.MsgIdMap.find file_id !blockInfos - with Not_found -> - [] - in - blockInfos := Remote.MsgIdMap.add file_id (bi :: bil) !blockInfos; - Lwt.return () - -let receiveRemBi = Remote.registerServerCmd "receiveRemBi" receiveRemBiLocally -let rec sendRemBi conn file_id remBi = - match remBi with - [] -> Lwt.return () - | x :: r -> sendRemBi conn file_id r >>= (fun () -> - receiveRemBi conn (file_id, x)) - let close_all infd outfd = Util.convertUnixErrorsToTransient "closing files" @@ -372,7 +430,7 @@ (fun () -> close_in_noerr ifd) in infd := Some ifd; - (bi, + (Some bi, (* Rsync decompressor *) fun ti -> let fd = @@ -383,7 +441,7 @@ in if eof then begin close_out fd; outfd := None end)) | _ -> - ([], + (None, (* Simple generic decompressor *) fun ti -> let fd = destinationFd fspathTo pathTo fileKind srcFileSize outfd in @@ -395,14 +453,8 @@ (fun () -> decompressor := Remote.MsgIdMap.add file_id decompr !decompressor; Uutil.showProgress id Uutil.Filesize.zero "f"; - let (firstBi, remBi) = - match bi with - [] -> (None, []) - | firstBi :: remBi -> (Some firstBi, remBi) - in - sendRemBi connFrom file_id remBi >>= fun () -> compressRemotely connFrom - (firstBi, fspathFrom, pathFrom, fileKind, srcFileSize, id, file_id) + (bi, fspathFrom, pathFrom, fileKind, srcFileSize, id, file_id) >>= fun () -> decompressor := Remote.MsgIdMap.remove file_id !decompressor; (* For GC *) @@ -416,18 +468,6 @@ (****) -let fileSize (fspath, path) = - Util.convertUnixErrorsToTransient - "getting file size" - (fun () -> - Lwt.return - (Props.length (Fileinfo.get false fspath path).Fileinfo.desc)) - -let fileSizeOnHost = - Remote.registerServerCmd "fileSize" (fun _ -> fileSize) - -(****) - let transferRessourceForkAndSetFileinfo connFrom fspathFrom pathFrom fspathTo pathTo realPathTo update desc fp ress id = @@ -441,30 +481,20 @@ Lwt.return () end >>= fun () -> setFileinfo fspathTo pathTo realPathTo update desc; - Lwt.return () + paranoidCheck fspathTo pathTo desc fp ress -(* The ressOnly flag tells reallyTransferFile to skip transferring - the data fork (which has already been taken care of by some external - utility) and just transfer the resource fork (which external utilities - are not necessarily good at). *) let reallyTransferFile connFrom fspathFrom pathFrom fspathTo pathTo realPathTo - update desc fp ress ressOnly id = - debug (fun() -> Util.msg "reallyTransferFile(%s,%s) -> (%s,%s,%s,%s)%s\n" + update desc fp ress id = + 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) - (if ressOnly then " (ONLY RESOURCE FORK)" else "")); - (if ressOnly then - (* Skip data fork *) - Lwt.return () - else begin + (Path.toString realPathTo) (Props.toString desc)); removeOldTempFile fspathTo pathTo; (* Data fork *) transferFileContents connFrom fspathFrom pathFrom fspathTo pathTo realPathTo update - `DATA (Props.length desc) id - end) >>= fun () -> + `DATA (Props.length desc) id >>= fun () -> transferRessourceForkAndSetFileinfo connFrom fspathFrom pathFrom fspathTo pathTo realPathTo update desc fp ress id @@ -514,41 +544,6 @@ ^ "added if the value of {\\tt copyprog} contains the string " ^ "{\\tt rsync}.") -let tryCopyMovedFileLocal connFrom - (fspathTo, pathTo, realPathTo, update, desc, fp, ress, id) = - Lwt.return (tryCopyMovedFile fspathTo pathTo realPathTo update desc fp ress id) -let tryCopyMovedFileOnRoot = - Remote.registerRootCmdWithConnection "tryCopyMovedFile" tryCopyMovedFileLocal - -let setFileinfoLocal connFrom (fspathTo, pathTo, desc) = - Lwt.return (Fileinfo.set fspathTo pathTo (`Set Props.fileDefault) desc) -let setFileinfoOnRoot = - Remote.registerRootCmdWithConnection "setFileinfo" setFileinfoLocal - -let targetExists checkSize fspathTo pathTo = - let info = Fileinfo.get false fspathTo pathTo in - info.Fileinfo.typ = `FILE - && (match checkSize with - `MakeWriteableAndCheckNonempty -> - let perms = Props.perms info.Fileinfo.desc in - let perms' = perms lor 0o600 in - Util.convertUnixErrorsToTransient - "making target writable" - (fun () -> Fs.chmod (Fspath.concat fspathTo pathTo) perms'); - Props.length info.Fileinfo.desc > Uutil.Filesize.zero - | `CheckDataSize desc -> - Props.length info.Fileinfo.desc = Props.length desc - | `CheckSize (desc,ress) -> - Props.length info.Fileinfo.desc = Props.length desc - && Osx.ressLength info.Fileinfo.osX.Osx.ressInfo = - Osx.ressLength ress) - -let targetExistsLocal connFrom (checkSize, fspathTo, pathTo) = - Lwt.return (targetExists checkSize fspathTo pathTo) -let targetExistsOnRoot = - Remote.registerRootCmdWithConnection - "targetExists" targetExistsLocal - let formatConnectionInfo root = match root with Common.Local, _ -> "" @@ -579,59 +574,116 @@ (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))); + transferRessourceForkAndSetFileinfo + connFrom fspathFrom pathFrom fspathTo pathTo realPathTo + update desc fp ress id + +let finishExternalTransferOnRoot = + Remote.registerRootCmdWithConnection + "finishExternalTransfer" finishExternalTransferLocal + let transferFileUsingExternalCopyprog rootFrom pathFrom rootTo fspathTo pathTo realPathTo - update desc fp ress id = - tryCopyMovedFileOnRoot rootTo rootFrom - (fspathTo, pathTo, realPathTo, update, desc, fp, ress, id) - >>= (fun b -> - if b then Lwt.return () - else begin - Uutil.showProgress id Uutil.Filesize.zero "ext"; - targetExistsOnRoot - rootTo rootFrom (`MakeWriteableAndCheckNonempty, fspathTo, pathTo) >>= (fun b -> - let prog = - if b - then Prefs.read copyprogrest - else Prefs.read copyprog in - let extraquotes = Prefs.read copyquoterem = "true" - || ( Prefs.read copyquoterem = "default" - && Util.findsubstring "rsync" prog <> None) in - let addquotes root s = - match root with - | Common.Local, _ -> s - | Common.Remote _, _ -> if extraquotes then 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); - let _,log = External.runExternalProgram cmd in - debug (fun() -> - let l = Util.trimWhitespace log in - Util.msg "transferFileUsingExternalCopyprog %s: returned...\n%s%s" - (Path.toString pathFrom) - l (if l="" then "" else "\n")); - targetExistsOnRoot - rootTo rootFrom (`CheckDataSize desc, fspathTo, pathTo) - >>= (fun b -> - if not b then - raise (Util.Transient (Printf.sprintf - "External copy program did not create target file (or bad length): %s" - (Path.toString pathTo))); - Uutil.showProgress id (Props.length desc) "ext"; - Lwt.return ())) - end) + 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); + let _,log = External.runExternalProgram cmd in + debug (fun() -> + let l = Util.trimWhitespace log in + Util.msg "transferFileUsingExternalCopyprog %s: returned...\n%s%s" + (Path.toString pathFrom) + l (if l="" then "" else "\n")); + 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 (info, 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. *) + Trace.log (Printf.sprintf + "%s/%s has already been transferred\n" + (Fspath.toDebugString fspathTo) (Path.toString pathTo)); + setFileinfo fspathTo pathTo realPathTo update desc; + Lwt.return (`DONE (Success info)) + end else + match + tryCopyMovedFile fspathTo pathTo realPathTo update desc fp ress id + with + Some info -> + (* Transfer was performed by copying *) + Lwt.return (`DONE (Success info)) + | 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 >>= fun status -> + Lwt.return (`DONE status) + 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 @@ -642,35 +694,35 @@ + 8 (* Read buffer *) -let transferFileLocal connFrom - (fspathFrom, pathFrom, fspathTo, pathTo, realPathTo, - update, desc, fp, ress, ressOnly, id) = - if (not ressOnly) - && tryCopyMovedFile fspathTo pathTo realPathTo update desc fp ress id - then Lwt.return () - else reallyTransferFile - connFrom fspathFrom pathFrom fspathTo pathTo realPathTo - update desc fp ress ressOnly id - -let transferFileOnRoot = - Remote.registerRootCmdWithConnection "transferFile" transferFileLocal - let transferFile rootFrom pathFrom rootTo fspathTo pathTo realPathTo - update desc fp ress ressOnly id = - let bufSz = bufferSize (max (Props.length desc) (Osx.ressLength ress)) in - (* This must be on the client: any lock on the server side may result - in a deadlock under windows *) - Lwt_util.run_in_region transferFileReg bufSz (fun () -> + update desc fp ress id = + let f () = Abort.check id; transferFileOnRoot rootTo rootFrom (snd rootFrom, pathFrom, fspathTo, pathTo, realPathTo, - update, desc, fp, ress, ressOnly, id)) + update, desc, fp, ress, id) >>= fun status -> + match status with + `DONE status -> + 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 *) + if Prefs.read Remote.streamingActivated then + f () + else + let bufSz = bufferSize (max (Props.length desc) (Osx.ressLength ress)) in + (* This must be on the client: any lock on the server side may result + in a deadlock under windows *) + Lwt_util.run_in_region transferFileReg bufSz f (****) let file rootFrom pathFrom rootTo fspathTo pathTo realPathTo - update desc fp ress id = + 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) @@ -682,41 +734,21 @@ localFile fspathFrom pathFrom fspathTo pathTo realPathTo update desc (Osx.ressLength ress) (Some id); - Lwt.return () + paranoidCheck fspathTo pathTo desc fp ress | _ -> - (* Check whether we actually need to copy the file (or whether it - already exists from some interrupted previous transfer) *) - targetExistsOnRoot - rootTo rootFrom (`CheckSize (desc,ress), fspathTo, pathTo) >>= (fun b -> - if b then begin - Trace.log (Printf.sprintf - "%s/%s has already been transferred\n" - (Fspath.toDebugString fspathTo) (Path.toString pathTo)); - (* Make sure the file information is right *) - setFileinfoOnRoot rootTo rootFrom (fspathTo, pathTo, desc) - (* Check whether we should use an external program to copy the - file *) - end else if shouldUseExternalCopyprog update desc then begin - (* First use the external program to copy the data fork *) - transferFileUsingExternalCopyprog - rootFrom pathFrom rootTo fspathTo pathTo realPathTo - update desc fp ress id >>= (fun () -> - (* Now use the regular transport mechanism to copy the resource - fork *) - begin if (Osx.ressLength ress) > Uutil.Filesize.zero then begin - transferFile - rootFrom pathFrom rootTo fspathTo pathTo realPathTo - update desc fp ress true id - end else Lwt.return () - end >>= (fun() -> - (* Finally, set the file info *) - setFileinfoOnRoot rootTo rootFrom (fspathTo, pathTo, desc))) - end else - (* Just transfer the file in the usual way with Unison's - built-in facilities *) - transferFile - rootFrom pathFrom rootTo fspathTo pathTo realPathTo - update desc fp ress false id - ) end >>= (fun () -> + transferFile + rootFrom pathFrom rootTo fspathTo pathTo realPathTo + update desc fp ress id + end >>= fun status -> Trace.showTimer timer; - Lwt.return ()) + match status with + Success info -> + checkContentsChange rootFrom pathFrom desc fp stamp ress false + >>= fun () -> + Lwt.return info + | Failure reason -> + (* Maybe we failed because the source file was modified. + We check this before reporting a failure *) + checkContentsChange rootFrom pathFrom desc fp stamp ress true + >>= fun () -> + Lwt.fail (Util.Transient reason) Modified: trunk/src/copy.mli =================================================================== --- trunk/src/copy.mli 2009-06-09 08:53:55 UTC (rev 349) +++ trunk/src/copy.mli 2009-06-09 15:41:29 UTC (rev 350) @@ -10,9 +10,11 @@ -> [`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 (* ressource info of file *) -> Uutil.File.t (* file's index in UI (for progress bars) *) - -> unit Lwt.t + -> Fileinfo.t Lwt.t (* information regarding the transferred file *) val localFile : Fspath.t (* fspath of source *) Modified: trunk/src/files.ml =================================================================== --- trunk/src/files.ml 2009-06-09 08:53:55 UTC (rev 349) +++ trunk/src/files.ml 2009-06-09 15:41:29 UTC (rev 350) @@ -90,13 +90,12 @@ (* FIX: maybe we should rename the destination before making any check ? *) let delete rootFrom pathFrom rootTo pathTo ui = Update.transaction (fun id -> - Update.replaceArchive rootFrom pathFrom None Update.NoArchive id true false + Update.replaceArchive rootFrom pathFrom Update.NoArchive id >>= (fun _ -> (* Unison do the next line cause we want to keep a backup of the file. FIX: We only need this when we are making backups *) Update.updateArchive rootTo pathTo ui id >>= (fun _ -> - Update.replaceArchive - rootTo pathTo None Update.NoArchive id true false + Update.replaceArchive rootTo pathTo Update.NoArchive id >>= (fun localPathTo -> (* Make sure the target is unchanged *) (* (There is an unavoidable race condition here.) *) @@ -151,12 +150,12 @@ Fs.chmod (Fspath.concat workingDir path) (Props.perms info.Fileinfo.desc lor 0o700) with Unix.Unix_error _ -> () end; - Lwt.return info.Fileinfo.desc + 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 (Fileinfo.get false workingDir path).Fileinfo.desc + Lwt.return (false, (Fileinfo.get false workingDir path).Fileinfo.desc) end) let mkdir onRoot workingDir path = mkdirRemote onRoot (workingDir,path) @@ -268,50 +267,6 @@ (* ------------------------------------------------------------ *) -let checkContentsChangeLocal - currfspath path archDesc archDig archStamp archRess = - let info = Fileinfo.get true currfspath path in - if Props.length archDesc <> Props.length info.Fileinfo.desc then - raise (Util.Transient (Printf.sprintf - "The file %s\nhas been modified during synchronization. \ - Transfer aborted." - (Fspath.toPrintString (Fspath.concat currfspath path)))); - match archStamp with - Fileinfo.InodeStamp inode - when info.Fileinfo.inode = inode - && Props.same_time info.Fileinfo.desc archDesc -> - () - | _ -> - (* Note that we fall back to the paranoid check (using a fingerprint) - even if a CtimeStamp was provided, since we do not trust them - completely. *) - let (info, newDig) = Os.safeFingerprint currfspath path info None in - if archDig <> newDig then - raise (Util.Transient (Printf.sprintf - "The file %s\nhas been modified during synchronization. \ - Transfer aborted.%s" - (Fspath.toPrintString (Fspath.concat currfspath path)) - (if Update.useFastChecking () - && Props.same_time info.Fileinfo.desc archDesc - then - " If this happens repeatedly, try running once with the \ - fastcheck option set to 'no'" - else - ""))) - -let checkContentsChangeOnHost = - Remote.registerRootCmd - "checkContentsChange" - (fun (currfspath, (path, archDesc, archDig, archStamp, archRess)) -> - checkContentsChangeLocal - currfspath path archDesc archDig archStamp archRess; - Lwt.return ()) - -let checkContentsChange root path archDesc archDig archStamp archRess = - checkContentsChangeOnHost root (path, archDesc, archDig, archStamp, archRess) - -(* ------------------------------------------------------------ *) - (* Calculate the target working directory and paths for the copy. workingDir is an fspath naming the directory on the target host where the copied file will actually live. @@ -348,6 +303,44 @@ Os.symlink workingDir path l; Lwt.return ()) +(* ------------------------------------------------------------ *) + +let deleteSpuriousChild fspathTo pathTo nm = + 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)) = +List.iter (fun nm -> Format.eprintf "%s at ." (Name.toString nm)) archChildren; + deleteSpuriousChildrenRec + fspathTo pathTo archChildren + (List.sort Name.compare (Os.childrenOf fspathTo pathTo)); + Lwt.return () + +let deleteSpuriousChildren = + Remote.registerRootCmd "deleteSpuriousChildren" deleteSpuriousChildrenLocal + +(* ------------------------------------------------------------ *) + let copyReg = Lwt_util.make_region 50 let copy @@ -383,87 +376,87 @@ Update.ArchiveFile (desc, dig, 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 dig ress id - >>= (fun () -> - checkContentsChange rootFrom pFrom desc dig stamp ress)) + update desc dig stmp ress id + >>= fun info -> + let ress' = Osx.stamp info.Fileinfo.osX in + Lwt.return + (Update.ArchiveFile (Props.override info.Fileinfo.desc desc, + dig, 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)) + 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)); - mkdir rootTo workingDir pTo) >>= (fun initialDesc -> + mkdir rootTo workingDir pTo) >>= fun (alreadyThere, initialDesc) -> Abort.check id; + begin if alreadyThere then + let childNames = + Update.NameMap.fold (fun nm _ l -> nm :: l) children [] in + deleteSpuriousChildren rootTo (workingDir, pTo, childNames) + else + Lwt.return () + end >>= fun () -> + Abort.check id; let runningThreads = ref [] in Lwt.catch (fun () -> - Update.NameMap.iter - (fun name child -> - let thread = - copyRec (Path.child pFrom name) - (Path.child pTo name) - (Path.child realPTo name) - child - in - runningThreads := thread :: !runningThreads) - children; - Lwt_util.join !runningThreads) + let ch = + Update.NameMap.mapi + (fun name child -> + let thread : Update.archive Lwt.t = + copyRec (Path.child pFrom name) + (Path.child pTo name) + (Path.child realPTo name) + child + in + runningThreads := thread :: !runningThreads; + thread) + children + in + Update.NameMap.fold + (fun nm arThr chThr -> + arThr >>= fun ar -> + chThr >>= fun ch -> + Lwt.return (Update.NameMap.add nm ar ch)) + ch + (Lwt.return Update.NameMap.empty)) (fun e -> (* If one thread fails (in a non-fatal way), we wait for all other threads to terminate before continuing *) - if not (Abort.testException e) then Abort.file id; - match e with - Util.Transient _ -> - let e = ref e in - Lwt_util.iter - (fun act -> - Lwt.catch - (fun () -> act) - (fun e' -> - match e' with - Util.Transient _ -> - if Abort.testException !e then e := e'; - Lwt.return () - | _ -> - Lwt.fail e')) - !runningThreads >>= (fun () -> - Lwt.fail !e) - | _ -> - Lwt.fail e) >>= (fun () -> + Abort.mergeErrors id e !runningThreads) + >>= fun newChildren -> Lwt_util.run_in_region copyReg 1 (fun () -> (* We use the actual file permissions so as to preserve inherited bits *) Abort.check id; setPropRemote rootTo - (workingDir, pTo, `Set initialDesc, desc)))) + (workingDir, pTo, `Set initialDesc, desc)) >>= fun () -> + Lwt.return (Update.ArchiveDir (desc, newChildren)) | Update.NoArchive -> assert false in - (* BCP (6/08): We used to have an unwindProtect here that would *always* do the - final performDelete. This was removed so that failed partial transfers can - be restarted. We instead remove individual failing files (not - directories) inside replaceArchive. *) Update.transaction (fun id -> (* Update the archive on the source replica (but don't commit the changes yet) and return the part of the new archive corresponding to this path *) Update.updateArchive rootFrom pathFrom uiFrom id >>= fun (localPathFrom, archFrom) -> - let make_backup = + let make_backup = (* FIX: this call should probably be removed... *) (* Perform (asynchronously) a backup of the destination files *) Update.updateArchive rootTo pathTo uiTo id in - copyRec localPathFrom tempPathTo realPathTo archFrom >>= fun () -> + copyRec localPathFrom tempPathTo realPathTo archFrom >>= fun archTo -> make_backup >>= fun _ -> - Update.replaceArchive - rootTo pathTo (Some (workingDir, tempPathTo)) - archFrom id true true >>= fun _ -> + Update.replaceArchive rootTo pathTo archTo id >>= fun _ -> rename rootTo pathTo localPathTo workingDir tempPathTo realPathTo uiTo) (* ------------------------------------------------------------ *) @@ -531,7 +524,8 @@ (Update.translatePath root2 path2 >>= (fun path2 -> Copy.file root2 path2 root1 workingDir tmppath realPath `Copy (Props.setLength Props.fileSafe (Props.length desc2)) - fp2 ress2 id)); + fp2 None ress2 id) >>= fun info -> + Lwt.return ()); displayDiff (Fspath.concat workingDir realPath) (Fspath.concat workingDir tmppath); @@ -549,7 +543,8 @@ (* Note that we don't need the resource fork *) Copy.file root1 path1 root2 workingDir tmppath realPath `Copy (Props.setLength Props.fileSafe (Props.length desc1)) - fp1 ress1 id)); + fp1 None ress1 id >>= fun info -> + Lwt.return ())); displayDiff (Fspath.concat workingDir tmppath) (Fspath.concat workingDir realPath); @@ -635,9 +630,9 @@ let newprops = Props.setLength propsTo (Props.length info.Fileinfo.desc) in Copy.file (Local, fspathFrom) pathFrom rootTo workingDirForCopy tempPathTo realPathTo - `Copy newprops fp stamp id >>= (fun () -> - rename rootTo pathTo localPathTo workingDirForCopy tempPathTo realPathTo - uiTo )) + `Copy newprops fp None stamp id >>= fun info -> + rename rootTo pathTo localPathTo workingDirForCopy tempPathTo realPathTo + uiTo ) let keeptempfilesaftermerge = Prefs.createBool @@ -700,12 +695,14 @@ Lwt_unix.run (Copy.file root1 localPath1 root1 workingDirForMerge working1 basep - `Copy desc1 fp1 ress1 id); + `Copy desc1 fp1 None ress1 id >>= fun info -> + Lwt.return ()); Lwt_unix.run (Update.translatePath root2 path >>= (fun path -> Copy.file root2 path root1 workingDirForMerge working2 basep - `Copy desc2 fp2 ress2 id)); + `Copy desc2 fp2 None ress2 id) >>= fun info -> + Lwt.return ()); (* retrieve the archive for this file, if any *) let arch = @@ -912,13 +909,11 @@ Osx.stamp infoarch.osX) in Update.transaction (fun transid -> - Update.replaceArchive root1 path - (Some(workingDirForMerge, workingarch)) - new_archive_entry transid false false >>= (fun _ -> - Update.replaceArchive root2 path - (Some(workingDirForMerge, workingarch)) - new_archive_entry transid false false >>= (fun _ -> - Lwt.return ()))) + Update.replaceArchive root1 path new_archive_entry transid + >>= fun _ -> + Update.replaceArchive root2 path new_archive_entry transid + >>= fun _ -> + Lwt.return ()) end else (Lwt.return ()) )))) ) (fun _ -> Modified: trunk/src/mkProjectInfo.ml =================================================================== --- trunk/src/mkProjectInfo.ml 2009-06-09 08:53:55 UTC (rev 349) +++ trunk/src/mkProjectInfo.ml 2009-06-09 15:41:29 UTC (rev 350) @@ -5,8 +5,8 @@ let projectName = "unison" let majorVersion = 2 -let minorVersion = 34 -let pointVersionOrigin = 332 (* Revision that corresponds to point version 0 *) +let minorVersion = 35 +let pointVersionOrigin = 349 (* Revision that corresponds to point version 0 *) (* Documentation: This is a program to construct a version of the form Major.Minor.Point, @@ -159,3 +159,4 @@ + Modified: trunk/src/remote.ml =================================================================== --- trunk/src/remote.ml 2009-06-09 08:53:55 UTC (rev 349) +++ trunk/src/remote.ml 2009-06-09 15:41:29 UTC (rev 350) @@ -35,14 +35,17 @@ (****) -let intSize = 4 +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 = @@ -50,7 +53,13 @@ let b1 = Char.code (int_buf.{i + 1}) in let b2 = Char.code (int_buf.{i + 2}) in let b3 = Char.code (int_buf.{i + 3}) in - ((b3 lsl 24) lor (b2 lsl 16) lor (b1 lsl 8) lor b0) + 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 *) @@ -171,6 +180,8 @@ Lwt.return () end +let bufReg = Lwt_util.make_region 1 + let rec fill_buffer conn l = match l with (s, pos, len) :: rem -> @@ -182,6 +193,29 @@ | [] -> Lwt.return () +let fill_buffer conn l = + Lwt_util.run_in_region bufReg 1 (fun () -> fill_buffer conn l) +let send_output conn = + Lwt_util.run_in_region bufReg 1 (fun () -> send_output conn) + + +let blockedStream = ref None + +let rec streamWaitForWrite conn = + if conn.canWrite then Lwt.return () else begin + debugE (fun() -> Util.msg "Stream: waiting for write token\n"); + let w = Lwt.wait () in + blockedStream := Some w; + w >>= fun () -> + debugE (fun() -> Util.msg "Stream: restarting\n"); + streamWaitForWrite conn + end + +let restartStream () = + match !blockedStream with + Some w -> blockedStream := None; Lwt.wakeup w () + | None -> () + (* Flow-control mechanism (only active under windows). Only one side is allowed to send message at any given time. @@ -196,6 +230,13 @@ *) let needFlowControl = windowsHack +let rec flush_buffer_simpl conn = + if conn.outputLength > 0 then + send_output conn >>= fun () -> + flush_buffer_simpl conn + else + Lwt.return () + (* Loop until the output buffer is empty *) let rec flush_buffer conn = if conn.tokens <= 0 && conn.canWrite then begin @@ -235,23 +276,27 @@ (* We wait a bit before flushing everything, so that other packets send just afterwards can be coalesced *) Lwt_unix.yield () >>= (fun () -> - try - ignore (Queue.peek conn.outputQueue); + if not (Queue.is_empty conn.outputQueue) then dump_rec conn - with Queue.Empty -> - flush_buffer conn) + else begin + flush_buffer conn >>= fun () -> + if not (Queue.is_empty conn.outputQueue) then + signalSomethingToWrite conn; + Lwt.return () + end) (* Start the thread that write all pending messages, if this thread is not running at this time *) -let signalSomethingToWrite conn = +and signalSomethingToWrite conn = if not conn.canWrite && conn.pendingOutput then debugE (fun () -> Util.msg "Something to write, but no write token (%d)\n" conn.tokens); - if conn.pendingOutput = false && conn.canWrite then begin + if not conn.pendingOutput && conn.canWrite then begin conn.pendingOutput <- true; Lwt.ignore_result (dump_rec conn) - end + end; + if conn.canWrite then restartStream () (* Add a message to the output queue and schedule its emission *) (* A message is a list of fragments of messages, represented by triplets @@ -532,11 +577,17 @@ ((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" @@ -562,6 +613,38 @@ | 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 + fill_buffer conn request >>= fun () -> + flush_buffer_simpl conn + 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) @@ -628,6 +711,15 @@ 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 -> + if conn.flowControl then conn.tokens <- conn.tokens - 1; + processStream conn id cmdName buf >>= fun () -> + receive conn + | StreamAbort -> + if conn.flowControl then conn.tokens <- conn.tokens - 1; + streamAbortedSrc := num_id; + receive conn end) end)) @@ -731,7 +823,76 @@ | _ -> 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 = + if !streamAbortedSrc = id then raise (Util.Transient "Streaming aborted"); + streamWaitForWrite conn >>= fun () -> + 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 + fill_buffer 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 () -> + Lwt_unix.yield () >>= fun () -> + sender (fun v -> client conn id v))) + (fun v -> ping conn id >>= fun () -> Lwt.return v) + (fun e -> ping conn id >>= fun () -> Lwt.fail e) + end + (**************************************************************************** BUILDING CONNECTIONS TO THE SERVER ****************************************************************************) Modified: trunk/src/remote.mli =================================================================== --- trunk/src/remote.mli 2009-06-09 08:53:55 UTC (rev 349) +++ trunk/src/remote.mli 2009-06-09 15:41:29 UTC (rev 350) @@ -104,3 +104,13 @@ -> 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 Modified: trunk/src/transfer.ml =================================================================== --- trunk/src/transfer.ml 2009-06-09 08:53:55 UTC (rev 349) +++ trunk/src/transfer.ml 2009-06-09 15:41:29 UTC (rev 350) @@ -342,16 +342,6 @@ in iter 0 arg 0 0 - let rec rev_split_rec accu1 accu2 n l = - if n = 100000 then - rev_split_rec (accu2 :: accu1) [] 0 l - else - match l with - [] -> accu2 :: accu1 - | x :: r -> rev_split_rec accu1 (x :: accu2) (n + 1) r - - let rev_split l = rev_split_rec [] [] 0 l - (* Given a block size, get blocks from the old file and compute a checksum and a fingerprint for each one. *) let rsyncPreprocess infd = @@ -369,7 +359,7 @@ (* Limit the number of block so that there is no overflow in encodeInt3 *) let rev_bi = blockIter infd addBlock [] (256*256*256) in - let bi = rev_split rev_bi in + let bi = Safelist.rev rev_bi in debugLog (fun() -> Util.msg "%d blocks\n" (Safelist.length bi)); Trace.showTimer timer; bi @@ -441,11 +431,6 @@ let hash checksum = checksum - let rec sigLength sigs = - match sigs with - [] -> 0 - | x :: r -> Safelist.length x + sigLength r - (* Compute the hash table length as a function of the number of blocks *) let hashTableLength signatures = let rec upperPowerOfTwo n n2 = @@ -454,23 +439,21 @@ else upperPowerOfTwo n (2 * n2) in - 2 * (upperPowerOfTwo (sigLength signatures) 32) + 2 * (upperPowerOfTwo (Safelist.length signatures) 32) (* Hash the block signatures into the hash table *) let hashSig hashTableLength signatures = let hashTable = Array.make hashTableLength [] in - let rec addList k l l' = - match l, l' with - [], [] -> + let rec addList k l = + match l with + [] -> () - | [], r :: r' -> - addList k r r' - | ((cs, fp) :: r), _ -> + | (cs, fp) :: r -> let h = (hash cs) land (hashTableLength - 1) in hashTable.(h) <- (k, cs, fp)::(hashTable.(h)); - addList (k + 1) r l' + addList (k + 1) r in - addList 0 [] signatures; + addList 0 signatures; hashTable (* Given a key, retrieve the corresponding entry in the table *) Modified: trunk/src/transfer.mli =================================================================== --- trunk/src/transfer.mli 2009-06-09 08:53:55 UTC (rev 349) +++ trunk/src/transfer.mli 2009-06-09 15:41:29 UTC (rev 350) @@ -80,7 +80,7 @@ (* Compute block informations from the old file *) val rsyncPreprocess : in_channel (* old file descriptor *) - -> rsync_block_info list + -> rsync_block_info (* Interpret a transfer instruction *) val rsyncDecompress : @@ -95,7 +95,7 @@ (* Using block informations, parse the new file and send transfer instructions accordingly *) val rsyncCompress : - rsync_block_info list + rsync_block_info (* block info received from the destination *) -> in_channel (* new file descriptor *) -> Uutil.Filesize.t (* source file length *) Modified: trunk/src/transport.ml =================================================================== --- trunk/src/transport.ml 2009-06-09 08:53:55 UTC (rev 349) +++ trunk/src/transport.ml 2009-06-09 15:41:29 UTC (rev 350) @@ -87,7 +87,12 @@ let doAction (fromRoot,toRoot) path fromContents toContents id = Lwt_util.resize_region actionReg (Prefs.read maxthreads); - Lwt_util.resize_region Files.copyReg (Prefs.read maxthreads); + (* When streaming, we can transfer many file simultaneously: + as the contents of only one file is transferred in one direction + at any time, little ressource is consumed this way. *) + Lwt_util.resize_region Files.copyReg + (if Prefs.read Remote.streamingActivated then 4000 else + Prefs.read maxthreads); Lwt_util.run_in_region actionReg 1 (fun () -> if not !Trace.sendLogMsgsToStderr then Trace.statusDetail (Path.toString path); Modified: trunk/src/update.ml =================================================================== --- trunk/src/update.ml 2009-06-09 08:53:55 UTC (rev 349) +++ trunk/src/update.ml 2009-06-09 15:41:29 UTC (rev 350) @@ -1830,46 +1830,7 @@ Tree.map (fun n -> n) (fun (uc1,uc2) -> uc2) equals]) end -let rec replaceArchiveRec fspath path arch paranoid deleteBadTempFiles = - match arch with - ArchiveDir (desc, children) -> - ArchiveDir (desc, - NameMap.mapi - (fun nm a -> - replaceArchiveRec - fspath (Path.child path nm) a paranoid deleteBadTempFiles) - children) - | ArchiveFile (desc, dig, stamp, ress) -> - if paranoid then begin - (* Paranoid check: recompute the file's digest to match it with - the archive's *) - let info = Fileinfo.get false fspath path in - let dig' = Os.fingerprint fspath path info in - let ress' = Osx.stamp info.Fileinfo.osX in - if dig' <> dig then begin - let savepath = Path.addSuffixToFinalName path "-bad" in - (* if deleteBadTempFiles then Os.delete fspath path; *) - if deleteBadTempFiles then - Os.rename "save temp" fspath path fspath savepath; - raise (Util.Transient (Printf.sprintf - "The file %s was incorrectly transferred (fingerprint mismatch in %s)%s" - (Path.toString path) - (Os.reasonForFingerprintMismatch dig dig') - (if deleteBadTempFiles - then " -- temp file saved as" ^ Path.toString savepath - else ""))); - end; - ArchiveFile (Props.override info.Fileinfo.desc desc, - dig, Fileinfo.stamp info, ress') - end else begin - ArchiveFile (desc, dig, stamp, ress) - end - | ArchiveSymlink l -> - ArchiveSymlink l - | NoArchive -> - arch - -let replaceArchiveLocal fspath pathTo location arch id paranoid deleteBadTempFiles = +let replaceArchiveLocal fspath pathTo arch id = debug (fun() -> Util.msg "replaceArchiveLocal %s %s\n" (Fspath.toDebugString fspath) @@ -1877,20 +1838,12 @@ ); let root = thisRootsGlobalName fspath in let localPath = translatePathLocal fspath pathTo in - let (workingDir, tempPathTo) = - match location with - None -> (fspath, localPath) - | Some loc -> loc - in - let newArch = - replaceArchiveRec workingDir tempPathTo arch paranoid deleteBadTempFiles in let commit () = debug (fun() -> Util.msg "replaceArchiveLocal: committing\n"); - let _ = Stasher.stashCurrentVersion fspath localPath (Some tempPathTo) in let archive = getArchive root in let archive, () = updatePathInArchive archive fspath Path.empty pathTo - (fun _ _ _ -> newArch, ()) + (fun _ _ _ -> arch, ()) in setArchiveLocal root archive in @@ -1900,13 +1853,11 @@ let replaceArchiveOnRoot = Remote.registerRootCmd "replaceArchive" - (fun (fspath, (pathTo, location, arch, id, paranoid, deleteBadTempFiles)) -> - Lwt.return (replaceArchiveLocal fspath pathTo location arch - id paranoid deleteBadTempFiles)) + (fun (fspath, (pathTo, arch, id)) -> + Lwt.return (replaceArchiveLocal fspath pathTo arch id)) -let replaceArchive root pathTo location archive id paranoid deleteBadTempFiles = - replaceArchiveOnRoot root - (pathTo, location, archive, id, paranoid, deleteBadTempFiles) +let replaceArchive root pathTo archive id = + replaceArchiveOnRoot root (pathTo, archive, id) (* Update the archive to reflect - the last observed state of the file on disk (ui) Modified: trunk/src/update.mli =================================================================== --- trunk/src/update.mli 2009-06-09 08:53:55 UTC (rev 349) +++ trunk/src/update.mli 2009-06-09 15:41:29 UTC (rev 350) @@ -41,8 +41,7 @@ (Path.local * archive) Lwt.t (* Replace a part of an archive by another archive *) val replaceArchive : - Common.root -> Path.t -> (Fspath.t * Path.local) option -> - archive -> transaction -> bool -> bool -> Path.local Lwt.t + Common.root -> Path.t -> archive -> transaction -> Path.local Lwt.t (* Update only some permissions *) val updateProps : Common.root -> Path.t -> Props.t option -> Common.updateItem -> From vouillon at seas.upenn.edu Tue Jun 9 11:46:44 2009 From: vouillon at seas.upenn.edu (vouillon@seas.upenn.edu) Date: Tue, 9 Jun 2009 11:46:44 -0400 Subject: [Unison-hackers] [unison-svn] r351 - in branches/2.32/src: . lwt uimacnew/uimacnew.xcodeproj Message-ID: <200906091546.n59FkiEm002446@yaws.seas.upenn.edu> Author: vouillon Date: 2009-06-09 11:46:38 -0400 (Tue, 09 Jun 2009) New Revision: 351 Modified: branches/2.32/src/RECENTNEWS branches/2.32/src/copy.ml branches/2.32/src/files.ml branches/2.32/src/lwt/lwt_unix.ml branches/2.32/src/mkProjectInfo.ml branches/2.32/src/uimacnew/uimacnew.xcodeproj/project.pbxproj Log: * Fix to the Mac GUI: the bigarray library is now required * Improvement to the code for resuming directory transfers: - make sure file information (permissions, ...) has been properly set when using a previously transferred temp file - make sure previously transferred directories are writable (other changes made in the developer version of Unison require a protocol change) * Fixed bug in Lwt_unix.run which could make it fail with a Not_found exception (see [Not_found raised in tryCopyMovedFile] errors) Modified: branches/2.32/src/RECENTNEWS =================================================================== --- branches/2.32/src/RECENTNEWS 2009-06-09 15:41:29 UTC (rev 350) +++ branches/2.32/src/RECENTNEWS 2009-06-09 15:46:38 UTC (rev 351) @@ -1,3 +1,16 @@ +CHANGES FROM VERSION 2.32.33 + +* Fix to the Mac GUI: the bigarray library is now required +* Improvement to the code for resuming directory transfers: + - make sure file information (permissions, ...) has been properly set + when using a previously transferred temp file + - make sure previously transferred directories are writable + (other changes made in the developer version of Unison require a + protocol change) +* Fixed bug in Lwt_unix.run which could make it fail with a Not_found + exception (see [Not_found raised in tryCopyMovedFile] errors) + +------------------------------- CHANGES FROM VERSION 2.32.32 * Got rid of the 16MiB marshalling limit by marshalling to a bigarray Modified: branches/2.32/src/copy.ml =================================================================== --- branches/2.32/src/copy.ml 2009-06-09 15:41:29 UTC (rev 350) +++ branches/2.32/src/copy.ml 2009-06-09 15:46:38 UTC (rev 351) @@ -74,6 +74,11 @@ (****) +let setFileinfo fspathTo pathTo realPathTo update desc = + match update with + `Update _ -> Fileinfo.set fspathTo pathTo (`Copy realPathTo) desc + | `Copy -> Fileinfo.set fspathTo pathTo (`Set Props.fileDefault) desc + let localFile fspathFrom pathFrom fspathTo pathTo realPathTo update desc ressLength ido = let use_id f = match ido with Some id -> f id | None -> () in @@ -114,11 +119,7 @@ (fun () -> close_out_noerr outFd)) (fun () -> close_in_noerr inFd); end; - match update with - `Update _ -> - Fileinfo.set fspathTo pathTo (`Copy realPathTo) desc - | `Copy -> - Fileinfo.set fspathTo pathTo (`Set Props.fileDefault) desc) + setFileinfo fspathTo pathTo realPathTo update desc) (****) @@ -396,10 +397,7 @@ Lwt.fail e)) end else Lwt.return ()) >>= (fun () -> - begin match update with - `Update _ -> Fileinfo.set fspathTo pathTo (`Copy realPathTo) desc - | `Copy -> Fileinfo.set fspathTo pathTo (`Set Props.fileDefault) desc - end; + setFileinfo fspathTo pathTo realPathTo update desc; Lwt.return ())) (****) @@ -557,7 +555,10 @@ Remote.registerRootCmdWithConnection "tryCopyMovedFile" tryCopyMovedFileLocal let setFileinfoLocal connFrom (fspathTo, pathTo, desc) = - Lwt.return (Fileinfo.set fspathTo pathTo (`Set Props.fileDefault) desc) + setFileinfo fspathTo pathTo + pathTo `Copy (*FIX: should be realPathTo and update *) + desc; + Lwt.return () let setFileinfoOnRoot = Remote.registerRootCmdWithConnection "setFileinfo" setFileinfoLocal @@ -678,7 +679,8 @@ Trace.log (Printf.sprintf "%s/%s has already been transferred\n" (Fspath.toString fspathTo) (Path.toString pathTo)); - Lwt.return () + (* Make sure the file information is right *) + setFileinfoOnRoot rootTo rootFrom (fspathTo, pathTo, desc) (* Check whether we should use an external program to copy the file *) end else if Modified: branches/2.32/src/files.ml =================================================================== --- branches/2.32/src/files.ml 2009-06-09 15:41:29 UTC (rev 350) +++ branches/2.32/src/files.ml 2009-06-09 15:46:38 UTC (rev 351) @@ -139,23 +139,28 @@ setPropRemote2 toRoot (toLocalPath, `Update oldDesc, newDesc)))) (* ------------------------------------------------------------ *) - + let mkdirRemote = Remote.registerRootCmd "mkdir" (fun (fspath,(workingDir,path)) -> - let createIt() = Os.createDir workingDir path Props.dirDefault in - if Os.exists workingDir path then - if (Fileinfo.get false workingDir path).Fileinfo.typ <> `DIRECTORY then begin + let info = Fileinfo.get false workingDir path in + if info.Fileinfo.typ = `DIRECTORY then begin + begin try + (* Make sure the directory is writable *) + Unix.chmod (Fspath.concatToString workingDir path) + (Props.perms info.Fileinfo.desc lor 0o700) + with Unix.Unix_error _ -> () end; + Lwt.return info.Fileinfo.desc + end else begin + if info.Fileinfo.typ <> `ABSENT then Os.delete workingDir path; - createIt() - end else () - else - createIt(); - Lwt.return (Fileinfo.get false workingDir path).Fileinfo.desc) - + Os.createDir workingDir path Props.dirDefault; + Lwt.return (Fileinfo.get false workingDir path).Fileinfo.desc + end) + let mkdir onRoot workingDir path = mkdirRemote onRoot (workingDir,path) - + (* ------------------------------------------------------------ *) let renameLocal (root, (localTargetPath, fspath, pathFrom, pathTo)) = @@ -457,9 +462,7 @@ Update.replaceArchive rootTo pathTo (Some (workingDir, tempPathTo)) archFrom id true true >>= (fun _ -> - rename rootTo pathTo localPathTo workingDir tempPathTo realPathTo uiTo >>= (fun() -> - debug (fun() -> Util.msg "Removing temp files\n"); - performDelete rootTo (Some workingDir, tempPathTo) ))))))) + rename rootTo pathTo localPathTo workingDir tempPathTo realPathTo uiTo)))))) (* ------------------------------------------------------------ *) Modified: branches/2.32/src/lwt/lwt_unix.ml =================================================================== --- branches/2.32/src/lwt/lwt_unix.ml 2009-06-09 15:41:29 UTC (rev 350) +++ branches/2.32/src/lwt/lwt_unix.ml 2009-06-09 15:46:38 UTC (rev 351) @@ -141,33 +141,39 @@ restart_threads !event_counter now; List.iter (fun fd -> - match List.assoc fd !inputs with - `Read (buf, pos, len, res) -> - wrap_syscall inputs fd res - (fun () -> Unix.read fd buf pos len) - | `Accept res -> - wrap_syscall inputs fd res - (fun () -> - let (s, _) as v = Unix.accept fd in - if not windows_hack then Unix.set_nonblock s; - v) - | `Wait res -> - wrap_syscall inputs fd res (fun () -> ())) + try + match List.assoc fd !inputs with + `Read (buf, pos, len, res) -> + wrap_syscall inputs fd res + (fun () -> Unix.read fd buf pos len) + | `Accept res -> + wrap_syscall inputs fd res + (fun () -> + let (s, _) as v = Unix.accept fd in + if not windows_hack then Unix.set_nonblock s; + v) + | `Wait res -> + wrap_syscall inputs fd res (fun () -> ()) + with Not_found -> + ()) readers; List.iter (fun fd -> - match List.assoc fd !outputs with - `Write (buf, pos, len, res) -> - wrap_syscall outputs fd res - (fun () -> Unix.write fd buf pos len) - | `CheckSocket res -> - wrap_syscall outputs fd res - (fun () -> - try ignore (Unix.getpeername fd) with - Unix.Unix_error (Unix.ENOTCONN, _, _) -> - ignore (Unix.read fd " " 0 1)) - | `Wait res -> - wrap_syscall inputs fd res (fun () -> ())) + try + match List.assoc fd !outputs with + `Write (buf, pos, len, res) -> + wrap_syscall outputs fd res + (fun () -> Unix.write fd buf pos len) + | `CheckSocket res -> + wrap_syscall outputs fd res + (fun () -> + try ignore (Unix.getpeername fd) with + Unix.Unix_error (Unix.ENOTCONN, _, _) -> + ignore (Unix.read fd " " 0 1)) + | `Wait res -> + wrap_syscall inputs fd res (fun () -> ()) + with Not_found -> + ()) writers; if !child_exited then begin child_exited := false; Modified: branches/2.32/src/mkProjectInfo.ml =================================================================== --- branches/2.32/src/mkProjectInfo.ml 2009-06-09 15:41:29 UTC (rev 350) +++ branches/2.32/src/mkProjectInfo.ml 2009-06-09 15:46:38 UTC (rev 351) @@ -116,3 +116,4 @@ + Modified: branches/2.32/src/uimacnew/uimacnew.xcodeproj/project.pbxproj =================================================================== --- branches/2.32/src/uimacnew/uimacnew.xcodeproj/project.pbxproj 2009-06-09 15:41:29 UTC (rev 350) +++ branches/2.32/src/uimacnew/uimacnew.xcodeproj/project.pbxproj 2009-06-09 15:46:38 UTC (rev 351) @@ -581,6 +581,7 @@ "-lunix", "-lthreadsnat", "-lstr", + "-lbigarray", "-lasmrun", ); PREBINDING = NO; @@ -617,6 +618,7 @@ "-lunix", "-lthreadsnat", "-lstr", + "-lbigarray", "-lasmrun", ); PREBINDING = NO; @@ -650,6 +652,7 @@ "-lunix", "-lthreadsnat", "-lstr", + "-lbigarray", "-lasmrun", ); PREBINDING = NO; From vouillon at seas.upenn.edu Wed Jun 10 04:22:55 2009 From: vouillon at seas.upenn.edu (vouillon@seas.upenn.edu) Date: Wed, 10 Jun 2009 04:22:55 -0400 Subject: [Unison-hackers] [unison-svn] r352 - trunk/src Message-ID: <200906100822.n5A8MtfB017097@yaws.seas.upenn.edu> Author: vouillon Date: 2009-06-10 04:22:52 -0400 (Wed, 10 Jun 2009) New Revision: 352 Modified: trunk/src/RECENTNEWS trunk/src/mkProjectInfo.ml trunk/src/transfer.ml Log: * Fixed bug resulting in slow performances when transferring a file using our rsync implementation from a 64-bit architecture to a 32-bit architecture. Modified: trunk/src/RECENTNEWS =================================================================== --- trunk/src/RECENTNEWS 2009-06-09 15:46:38 UTC (rev 351) +++ trunk/src/RECENTNEWS 2009-06-10 08:22:52 UTC (rev 352) @@ -1,5 +1,12 @@ CHANGES FROM VERSION 2.35.-17 +* Fixed bug resulting in slow performances when transferring a file + using our rsync implementation from a 64-bit architecture to a + 32-bit architecture. + +------------------------------- +CHANGES FROM VERSION 2.35.-17 + * Bumped minor version: many incompatible protocol changes * Message lengths are checksummed to guard against protocol corruption Modified: trunk/src/mkProjectInfo.ml =================================================================== --- trunk/src/mkProjectInfo.ml 2009-06-09 15:46:38 UTC (rev 351) +++ trunk/src/mkProjectInfo.ml 2009-06-10 08:22:52 UTC (rev 352) @@ -160,3 +160,4 @@ + Modified: trunk/src/transfer.ml =================================================================== --- trunk/src/transfer.ml 2009-06-09 15:46:38 UTC (rev 351) +++ trunk/src/transfer.ml 2009-06-10 08:22:52 UTC (rev 352) @@ -449,6 +449,10 @@ [] -> () | (cs, fp) :: r -> + (* Negative 31-bits integers are sign-extended when + unmarshalled on a 64-bit architecture, so we + truncate them back to 31 bits. *) + let cs = cs land 0x7fffffff in let h = (hash cs) land (hashTableLength - 1) in hashTable.(h) <- (k, cs, fp)::(hashTable.(h)); addList (k + 1) r From bcpierce at cis.upenn.edu Wed Jun 10 21:53:28 2009 From: bcpierce at cis.upenn.edu (Benjamin Pierce) Date: Wed, 10 Jun 2009 21:53:28 -0400 Subject: [Unison-hackers] Stasher code... In-Reply-To: <20090608142123.GA13392@pps.jussieu.fr> References: <20090608142123.GA13392@pps.jussieu.fr> Message-ID: <7A2FC481-6B15-4965-8635-6303ECBCFFD8@cis.upenn.edu> Hi Jerome, > I'm trying to understand the stasher code, but I'm a bit puzzled. I've never been completely satisfied with the stasher stuff. It would be great to get it cleaned up. > In files.ml, we have the following piece of code: > > let deleteLocal (fspath, (workingDirOpt, path)) = > [...] > Stasher.backup fspath path `AndRemove > [...] > > If "path" contains a followed link, this will backup and delete the > *link*, not the link target as expected. Stasher.backup should call > Fspath.findWorkingDir to get the right file to rename or delete. Right. > Again in file.ml, we have the following: > > let make_backup = > (* Perform (asynchronously) a backup of the destination files *) > Update.updateArchive rootTo pathTo uiTo id > > The function Update.updateArchive calls the function > Stasher.stashCurrentVersion, but only after the destination has been > updated (the call is in the archive commit action)... > > > Still, the destination files are backed-up by the call to > Stasher.backup in Files.renameLocal. This seems right. > There is also a call to Stasher.stashCurrentVersion in > Update.replaceArchive, which is supposed to perform backups using the > temporary files before they replace the destination files, but perform > backups afterwards. So it does nothing (this is somewhat coherent > with the implementation of stashCurrentVersion which does not support > recursive traversal of a temporary directory). > > Stasher.stashCurrentVersion is also called from transport.ml, on both > replicas, after updates. > > As a summary, as far as I can see, Stasher.stashCurrentVersion is > called twice on the source files: once from Update.updateArchive > (called from File.copy) and then once from Transport.doAction. It is > also called twice on the destination files once modified, from the > same functions. It is called once on an empty location from > Update.replaceArchive. Finally, destination files are backed-up > before modification through the call to Stasher.backup in > Files.rename. > > If this analysis is correct, I suspect we can safely remove all calls > to Stasher.stashCurrentVersion from file update.ml. I'm not completely confident that I've correctly re-understood how all this is supposed to work, but in any case failing to stash the current version is less serious than failing to back up the old version -- it will only result in late merge Best, - Benjamin > > -- Jerome > _______________________________________________ > Unison-hackers mailing list > Unison-hackers at lists.seas.upenn.edu > http://lists.seas.upenn.edu/mailman/listinfo/unison-hackers From bcpierce at cis.upenn.edu Wed Jun 10 23:04:29 2009 From: bcpierce at cis.upenn.edu (Benjamin Pierce) Date: Wed, 10 Jun 2009 23:04:29 -0400 Subject: [Unison-hackers] Help building OSX GUI In-Reply-To: <20090604193226.GB28705@pps.jussieu.fr> References: <12DE3A85-A6F2-4D01-81D9-2949F66827BB@cis.upenn.edu> <2E008972-2CB9-42C0-9827-58C66813CDBB@cis.upenn.edu> <1BED0079-7560-4068-A15B-CB861BA33028@polytechnique.org> <28F17C90-F376-4AE0-8026-271BED414177@kalkwarf.com> <3D552623-2BC0-4696-B4C1-17CC84408F0A@cis.upenn.edu> <4A003BA7.5090803@gmx.net> <3AA479FC-1F08-4A38-BF5B-B9B2F5D3BC1B@cis.upenn.edu> <20090604193226.GB28705@pps.jussieu.fr> Message-ID: Hi Jerome, > If you can't wait for the makefiles to be fixed, you can edit > trunk/src/Makefile.OCaml and replace this line: > (cd $(UIMACDIR); xcodebuild OCAMLLIBDIR="$(OCAMLLIBDIR)" > SYMROOT=build) > with: > (cd $(UIMACDIR); xcodebuild -configuration Development > OCAMLLIBDIR="$(OCAMLLIBDIR)" SYMROOT=build) Doesn't quite work... is my OCaml compiled wrong, perhaps? - B CompileC build/uimacnew.build/Development/uimac.build/Objects-normal/ i386/ProgressCell.o /Users/bcpierce/current/unison/trunk/src/uimacnew/ ProgressCell.m normal i386 objective-c com.apple.compilers.gcc.4_0 cd /Users/bcpierce/current/unison/trunk/src/uimacnew /Developer/usr/bin/gcc-4.0 -x objective-c -arch i386 -fmessage- length=0 -pipe -Wno-trigraphs -fpascal-strings -fasm-blocks -O0 - isysroot /Developer/SDKs/MacOSX10.5.sdk -mfix-and-continue -mmacosx- version-min=10.5 -gdwarf-2 -I/Users/bcpierce/current/unison/trunk/src/ uimacnew/build/uimacnew.build/Development/uimac.build/Unison.hmap - Wmost -Wno-four-char-constants -Wno-unknown-pragmas -F/Users/bcpierce/ current/unison/trunk/src/uimacnew/build/Development -F/Users/bcpierce/ current/unison/trunk/src/uimacnew -I/usr/local/lib/ocaml -I/Users/ bcpierce/current/unison/trunk/src/uimacnew/build/Development/include - I/Users/bcpierce/current/unison/trunk/src/uimacnew/build/ uimacnew.build/Development/uimac.build/DerivedSources -c /Users/ bcpierce/current/unison/trunk/src/uimacnew/ProgressCell.m -o /Users/ bcpierce/current/unison/trunk/src/uimacnew/build/uimacnew.build/ Development/uimac.build/Objects-normal/i386/ProgressCell.o Ld /Users/bcpierce/current/unison/trunk/src/uimacnew/build/Development/ Unison.app/Contents/MacOS/Unison normal i386 mkdir /Users/bcpierce/current/unison/trunk/src/uimacnew/build/ Development/Unison.app/Contents/MacOS cd /Users/bcpierce/current/unison/trunk/src/uimacnew setenv MACOSX_DEPLOYMENT_TARGET 10.5 /Developer/usr/bin/gcc-4.0 -arch i386 -isysroot /Developer/SDKs/ MacOSX10.5.sdk -L/Users/bcpierce/current/unison/trunk/src/uimacnew/ build/Development -F/Users/bcpierce/current/unison/trunk/src/uimacnew/ build/Development -F/Users/bcpierce/current/unison/trunk/src/uimacnew - filelist /Users/bcpierce/current/unison/trunk/src/uimacnew/build/ uimacnew.build/Development/uimac.build/Objects-normal/i386/ Unison.LinkFileList -mmacosx-version-min=10.5 -L/usr/local/lib/ocaml - lunix -lthreadsnat -lstr -lbigarray -lasmrun -framework Cocoa - framework Security -framework Growl -framework ExceptionHandling / Users/bcpierce/current/unison/trunk/src/uimacnew/../unison-blob.o -o / Users/bcpierce/current/unison/trunk/src/uimacnew/build/Development/ Unison.app/Contents/MacOS/Unison Undefined symbols: "_caml_apply2", referenced from: _caml_callback2_exn in libasmrun.a(i386.o) "_caml_apply3", referenced from: _caml_callback3_exn in libasmrun.a(i386.o) ld: symbol(s) not found collect2: ld returned 1 exit status PBXCp build/Development/Unison.app/Contents/Frameworks/Growl.framework Growl.framework mkdir /Users/bcpierce/current/unison/trunk/src/uimacnew/build/ Development/Unison.app/Contents/Frameworks cd /Users/bcpierce/current/unison/trunk/src/uimacnew /Developer/Library/PrivateFrameworks/DevToolsCore.framework/ Resources/pbxcp -exclude .DS_Store -exclude CVS -exclude .svn -resolve- src-symlinks /Users/bcpierce/current/unison/trunk/src/uimacnew/ Growl.framework /Users/bcpierce/current/unison/trunk/src/uimacnew/ build/Development/Unison.app/Contents/Frameworks ** BUILD FAILED ** The following build commands failed: uimac: Ld /Users/bcpierce/current/unison/trunk/src/uimacnew/build/ Development/Unison.app/Contents/MacOS/Unison normal i386 From Jerome.Vouillon at pps.jussieu.fr Thu Jun 11 13:08:33 2009 From: Jerome.Vouillon at pps.jussieu.fr (Jerome Vouillon) Date: Thu, 11 Jun 2009 19:08:33 +0200 Subject: [Unison-hackers] Help building OSX GUI In-Reply-To: References: <1BED0079-7560-4068-A15B-CB861BA33028@polytechnique.org> <28F17C90-F376-4AE0-8026-271BED414177@kalkwarf.com> <3D552623-2BC0-4696-B4C1-17CC84408F0A@cis.upenn.edu> <4A003BA7.5090803@gmx.net> <3AA479FC-1F08-4A38-BF5B-B9B2F5D3BC1B@cis.upenn.edu> <20090604193226.GB28705@pps.jussieu.fr> Message-ID: <20090611170833.GA3203@pps.jussieu.fr> Hi Benjamin, On Wed, Jun 10, 2009 at 11:04:29PM -0400, Benjamin Pierce wrote: > > If you can't wait for the makefiles to be fixed, you can edit > > trunk/src/Makefile.OCaml and replace this line: > > (cd $(UIMACDIR); xcodebuild OCAMLLIBDIR="$(OCAMLLIBDIR)" > > SYMROOT=build) > > with: > > (cd $(UIMACDIR); xcodebuild -configuration Development > > OCAMLLIBDIR="$(OCAMLLIBDIR)" SYMROOT=build) > > Doesn't quite work... is my OCaml compiled wrong, perhaps? That may well be due to the following option in file uimacnew/uimacnew.xcodeproj/project.pbxproj : ZERO_LINK = YES Maybe the simplest thing to do is to revert the change in the Makefile and replace all occurences of: SDKROOT = /Developer/SDKs/MacOSX10.4u.sdk by: SDKROOT = /Developer/SDKs/MacOSX10.5.sdk in file uimacnew/uimacnew.xcodeproj/project.pbxproj There may also be a way to change the SDKROOT in the Makefile (see some previous mails in the thread). -- Jerome From bcpierce at cis.upenn.edu Fri Jun 12 08:47:16 2009 From: bcpierce at cis.upenn.edu (Benjamin Pierce) Date: Fri, 12 Jun 2009 08:47:16 -0400 Subject: [Unison-hackers] Help building OSX GUI In-Reply-To: <20090611170833.GA3203@pps.jussieu.fr> References: <1BED0079-7560-4068-A15B-CB861BA33028@polytechnique.org> <28F17C90-F376-4AE0-8026-271BED414177@kalkwarf.com> <3D552623-2BC0-4696-B4C1-17CC84408F0A@cis.upenn.edu> <4A003BA7.5090803@gmx.net> <3AA479FC-1F08-4A38-BF5B-B9B2F5D3BC1B@cis.upenn.edu> <20090604193226.GB28705@pps.jussieu.fr> <20090611170833.GA3203@pps.jussieu.fr> Message-ID: <5923FB8B-988A-49E6-B333-76A6DA7259D6@cis.upenn.edu> Hi Jerome, On one of my machines (the same one where your last suggestion was failing), I get the same problem. One another (where I didn't have a chance to test the last suggestion), the new suggestion seems to work. I'm attaching the full 'make' trace from the failing machine... - B -------------- next part -------------- A non-text attachment was scrubbed... Name: make.out Type: application/octet-stream Size: 93615 bytes Desc: not available Url : http://lists.seas.upenn.edu/pipermail/unison-hackers/attachments/20090612/aabd4670/make-0001.bin -------------- next part -------------- On Jun 11, 2009, at 1:08 PM, Jerome Vouillon wrote: > Hi Benjamin, > > On Wed, Jun 10, 2009 at 11:04:29PM -0400, Benjamin Pierce wrote: >>> If you can't wait for the makefiles to be fixed, you can edit >>> trunk/src/Makefile.OCaml and replace this line: >>> (cd $(UIMACDIR); xcodebuild OCAMLLIBDIR="$(OCAMLLIBDIR)" >>> SYMROOT=build) >>> with: >>> (cd $(UIMACDIR); xcodebuild -configuration Development >>> OCAMLLIBDIR="$(OCAMLLIBDIR)" SYMROOT=build) >> >> Doesn't quite work... is my OCaml compiled wrong, perhaps? > > That may well be due to the following option in file > uimacnew/uimacnew.xcodeproj/project.pbxproj : > > ZERO_LINK = YES > > Maybe the simplest thing to do is to revert the change in the Makefile > and replace all occurences of: > SDKROOT = /Developer/SDKs/MacOSX10.4u.sdk > by: > SDKROOT = /Developer/SDKs/MacOSX10.5.sdk > in file uimacnew/uimacnew.xcodeproj/project.pbxproj > > There may also be a way to change the SDKROOT in the Makefile > (see some previous mails in the thread). > > -- Jerome > _______________________________________________ > Unison-hackers mailing list > Unison-hackers at lists.seas.upenn.edu > http://lists.seas.upenn.edu/mailman/listinfo/unison-hackers From Jerome.Vouillon at pps.jussieu.fr Fri Jun 12 10:56:47 2009 From: Jerome.Vouillon at pps.jussieu.fr (Jerome Vouillon) Date: Fri, 12 Jun 2009 16:56:47 +0200 Subject: [Unison-hackers] Help building OSX GUI In-Reply-To: <5923FB8B-988A-49E6-B333-76A6DA7259D6@cis.upenn.edu> References: <28F17C90-F376-4AE0-8026-271BED414177@kalkwarf.com> <3D552623-2BC0-4696-B4C1-17CC84408F0A@cis.upenn.edu> <4A003BA7.5090803@gmx.net> <3AA479FC-1F08-4A38-BF5B-B9B2F5D3BC1B@cis.upenn.edu> <20090604193226.GB28705@pps.jussieu.fr> <20090611170833.GA3203@pps.jussieu.fr> <5923FB8B-988A-49E6-B333-76A6DA7259D6@cis.upenn.edu> Message-ID: <20090612145647.GA14545@pps.jussieu.fr> Hi Benjamin, On Fri, Jun 12, 2009 at 08:47:16AM -0400, Benjamin Pierce wrote: > On one of my machines (the same one where your last suggestion was > failing), I get the same problem. One another (where I didn't have a > chance to test the last suggestion), the new suggestion seems to work. > I'm attaching the full 'make' trace from the failing machine... In the project file, the "Default" configuration does not set the variable ZERO_LINK. So, maybe the machines have different defaults... You can try the "Deployment" configuration ("xcodebuild -configuration Deployment ..." in the Makefile), or set the ZERO_LINK variable to false in the project file. -- Jerome From bcpierce at cis.upenn.edu Fri Jun 12 11:07:28 2009 From: bcpierce at cis.upenn.edu (Benjamin Pierce) Date: Fri, 12 Jun 2009 11:07:28 -0400 Subject: [Unison-hackers] Help building OSX GUI In-Reply-To: <20090612145647.GA14545@pps.jussieu.fr> References: <28F17C90-F376-4AE0-8026-271BED414177@kalkwarf.com> <3D552623-2BC0-4696-B4C1-17CC84408F0A@cis.upenn.edu> <4A003BA7.5090803@gmx.net> <3AA479FC-1F08-4A38-BF5B-B9B2F5D3BC1B@cis.upenn.edu> <20090604193226.GB28705@pps.jussieu.fr> <20090611170833.GA3203@pps.jussieu.fr> <5923FB8B-988A-49E6-B333-76A6DA7259D6@cis.upenn.edu> <20090612145647.GA14545@pps.jussieu.fr> Message-ID: There are three instances of ZERO_LINK in the project file -- two already set to NO and one set to YES. Changing the latter to NO doesn't seem to affect the result... :-( (Is it worth trying your other suggestion too? What would go in the "..."?) Thanks! - B On Jun 12, 2009, at 10:56 AM, Jerome Vouillon wrote: > Hi Benjamin, > > On Fri, Jun 12, 2009 at 08:47:16AM -0400, Benjamin Pierce wrote: >> On one of my machines (the same one where your last suggestion was >> failing), I get the same problem. One another (where I didn't have a >> chance to test the last suggestion), the new suggestion seems to >> work. >> I'm attaching the full 'make' trace from the failing machine... > > In the project file, the "Default" configuration does not set the > variable ZERO_LINK. So, maybe the machines have different defaults... > You can try the "Deployment" configuration ("xcodebuild -configuration > Deployment ..." in the Makefile), or set the ZERO_LINK variable to > false in the project file. > > -- Jerome > _______________________________________________ > Unison-hackers mailing list > Unison-hackers at lists.seas.upenn.edu > http://lists.seas.upenn.edu/mailman/listinfo/unison-hackers From Jerome.Vouillon at pps.jussieu.fr Fri Jun 12 12:41:00 2009 From: Jerome.Vouillon at pps.jussieu.fr (Jerome Vouillon) Date: Fri, 12 Jun 2009 18:41:00 +0200 Subject: [Unison-hackers] Help building OSX GUI In-Reply-To: References: <4A003BA7.5090803@gmx.net> <3AA479FC-1F08-4A38-BF5B-B9B2F5D3BC1B@cis.upenn.edu> <20090604193226.GB28705@pps.jussieu.fr> <20090611170833.GA3203@pps.jussieu.fr> <5923FB8B-988A-49E6-B333-76A6DA7259D6@cis.upenn.edu> <20090612145647.GA14545@pps.jussieu.fr> Message-ID: <20090612164100.GA14976@pps.jussieu.fr> On Fri, Jun 12, 2009 at 11:07:28AM -0400, Benjamin Pierce wrote: > There are three instances of ZERO_LINK in the project file -- two > already set to NO and one set to YES. Changing the latter to NO > doesn't seem to affect the result... :-( The project file contains three configurations. With the "Development" configuration, ZERO_LINK is set to YES. With the "Deployment" configuration, ZERO_LINK is set to NO. With the "Default" configuration, ZERO_LINK is not set. > (Is it worth trying your other suggestion too? What would go in the > "..."?) If you modified the file Makefile.OCaml as I suggested initially: (cd $(UIMACDIR); xcodebuild -configuration Development OCAMLLIBDIR=...) and also the project file by changing the variable ZERO_LINK value from YES to NO, then you are building using the "Development" configuration with ZERO_LINK set to NO. In this case, it is not worth trying my suggestion, as the problem must be something else. If the Makefile is unchanged, then you are building using the "Default" configuration, which does not set the ZERO_LINK variable. So, your changes in the project file had no effect and you should definitively try my other suggestion: (cd $(UIMACDIR); xcodebuild -configuration Deployment OCAMLLIBDIR="$(OCAMLLIBDIR)" SYMROOT=build) -- Jerome From vouillon at seas.upenn.edu Sat Jun 13 05:28:04 2009 From: vouillon at seas.upenn.edu (vouillon@seas.upenn.edu) Date: Sat, 13 Jun 2009 05:28:04 -0400 Subject: [Unison-hackers] [unison-svn] r353 - in trunk/src: . ubase Message-ID: <200906130928.n5D9S4ao000655@yaws.seas.upenn.edu> Author: vouillon Date: 2009-06-13 05:28:01 -0400 (Sat, 13 Jun 2009) New Revision: 353 Modified: trunk/src/RECENTNEWS trunk/src/copy.ml trunk/src/files.ml trunk/src/mkProjectInfo.ml trunk/src/osx.ml trunk/src/ubase/myMap.ml trunk/src/ubase/myMap.mli trunk/src/update.ml Log: * Fixed bug introduced during file transfer cleanup that could lead to uncaught exceptions * Simplified function validate in myMap.ml * Mac OS: do not check filler contents in Apple Double files (the spec says it should be all zeroes, but Mac OS sets it to "Mac OS X "...) * Use a hard link rather than a copy when possible for creating the MainArch-files in Update.postCommitArchive * Remove duplicate calls to Stasher.stashCurrentVersion in update.ml (as well as now unnecessary calls to Update.updateArchive in files.ml) Modified: trunk/src/RECENTNEWS =================================================================== --- trunk/src/RECENTNEWS 2009-06-10 08:22:52 UTC (rev 352) +++ trunk/src/RECENTNEWS 2009-06-13 09:28:01 UTC (rev 353) @@ -1,5 +1,19 @@ CHANGES FROM VERSION 2.35.-17 +* Fixed bug introduced during file transfer cleanup that could lead to + uncaught exceptions +* Simplified function validate in myMap.ml +* Mac OS: do not check filler contents in Apple Double files + (the spec says it should be all zeroes, but Mac OS sets it to + "Mac OS X "...) +* Use a hard link rather than a copy when possible for creating the + MainArch-files in Update.postCommitArchive +* Remove duplicate calls to Stasher.stashCurrentVersion in update.ml + (as well as now unnecessary calls to Update.updateArchive in files.ml) + +------------------------------- +CHANGES FROM VERSION 2.35.-17 + * Fixed bug resulting in slow performances when transferring a file using our rsync implementation from a 64-bit architecture to a 32-bit architecture. Modified: trunk/src/copy.ml =================================================================== --- trunk/src/copy.ml 2009-06-10 08:22:52 UTC (rev 352) +++ trunk/src/copy.ml 2009-06-13 09:28:01 UTC (rev 353) @@ -337,7 +337,7 @@ let compress conn (biOpt, fspathFrom, pathFrom, fileKind, sizeFrom, id, file_id) = - Util.convertUnixErrorsToTransient "rsync sender" + Lwt.catch (fun () -> streamTransferInstruction conn (fun processTransferInstructionRemotely -> @@ -362,6 +362,10 @@ 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 "rsync sender" (fun () -> raise e)) let compressRemotely = Remote.registerServerCmd "compress" compress Modified: trunk/src/files.ml =================================================================== --- trunk/src/files.ml 2009-06-10 08:22:52 UTC (rev 352) +++ trunk/src/files.ml 2009-06-13 09:28:01 UTC (rev 353) @@ -92,15 +92,12 @@ Update.transaction (fun id -> Update.replaceArchive rootFrom pathFrom Update.NoArchive id >>= (fun _ -> - (* Unison do the next line cause we want to keep a backup of the file. - FIX: We only need this when we are making backups *) - Update.updateArchive rootTo pathTo ui id >>= (fun _ -> - Update.replaceArchive rootTo pathTo Update.NoArchive id + Update.replaceArchive rootTo pathTo Update.NoArchive id >>= (fun localPathTo -> (* Make sure the target is unchanged *) (* (There is an unavoidable race condition here.) *) Update.checkNoUpdates rootTo pathTo ui >>= (fun () -> - performDelete rootTo (None, localPathTo)))))) + performDelete rootTo (None, localPathTo))))) (* ------------------------------------------------------------ *) @@ -450,12 +447,7 @@ corresponding to this path *) Update.updateArchive rootFrom pathFrom uiFrom id >>= fun (localPathFrom, archFrom) -> - let make_backup = (* FIX: this call should probably be removed... *) - (* Perform (asynchronously) a backup of the destination files *) - Update.updateArchive rootTo pathTo uiTo id - in copyRec localPathFrom tempPathTo realPathTo archFrom >>= fun archTo -> - make_backup >>= fun _ -> Update.replaceArchive rootTo pathTo archTo id >>= fun _ -> rename rootTo pathTo localPathTo workingDir tempPathTo realPathTo uiTo) Modified: trunk/src/mkProjectInfo.ml =================================================================== --- trunk/src/mkProjectInfo.ml 2009-06-10 08:22:52 UTC (rev 352) +++ trunk/src/mkProjectInfo.ml 2009-06-13 09:28:01 UTC (rev 353) @@ -161,3 +161,4 @@ + Modified: trunk/src/osx.ml =================================================================== --- trunk/src/osx.ml 2009-06-10 08:22:52 UTC (rev 352) +++ trunk/src/osx.ml 2009-06-13 09:28:01 UTC (rev 353) @@ -120,8 +120,6 @@ fail path "bad magic number"; if String.sub header 4 4 <> doubleVersion then fail path "bad version"; - if String.sub header 8 16 <> doubleFiller then - fail path "bad filler"; let numEntries = getInt2 header 24 in let entries = ref [] in for i = 1 to numEntries do Modified: trunk/src/ubase/myMap.ml =================================================================== --- trunk/src/ubase/myMap.ml 2009-06-10 08:22:52 UTC (rev 352) +++ trunk/src/ubase/myMap.ml 2009-06-13 09:28:01 UTC (rev 353) @@ -39,7 +39,7 @@ val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool - val validate: 'a t -> [`Ok | `Duplicate of key | `Invalid] + val validate: 'a t -> [`Ok | `Duplicate of key | `Invalid of key * key] end module Make(Ord: OrderedType) = struct @@ -227,43 +227,26 @@ let rec validate_both v m v' = match m with Empty -> - `Ok + let c = Ord.compare v v' in + if c < 0 then `Ok + else if c = 0 then `Duplicate v + else `Invalid (v, v') | Node (l, v'', _, r, _) -> - val_combine - (val_combine - (let c = Ord.compare v'' v' in - if c < 0 then `Ok - else if c = 0 then `Duplicate v'' - else `Invalid) - (let c = Ord.compare v v'' in - if c < 0 then `Ok - else if c = 0 then `Duplicate v'' - else `Invalid)) - (val_combine (validate_both v l v'') (validate_both v'' r v')) + val_combine (validate_both v l v'') (validate_both v'' r v') let rec validate_left m v = match m with Empty -> `Ok | Node (l, v', _, r, _) -> - val_combine - (let c = Ord.compare v' v in - if c < 0 then `Ok - else if c = 0 then `Duplicate v' - else `Invalid) - (val_combine (validate_left l v') (validate_both v' r v)) + val_combine (validate_left l v') (validate_both v' r v) let rec validate_right v m = match m with Empty -> `Ok | Node (l, v', _, r, _) -> - val_combine - (let c = Ord.compare v v' in - if c < 0 then `Ok - else if c = 0 then `Duplicate v' - else `Invalid) - (val_combine (validate_both v l v') (validate_right v' r)) + val_combine (validate_both v l v') (validate_right v' r) let validate m = match m with Modified: trunk/src/ubase/myMap.mli =================================================================== --- trunk/src/ubase/myMap.mli 2009-06-10 08:22:52 UTC (rev 352) +++ trunk/src/ubase/myMap.mli 2009-06-13 09:28:01 UTC (rev 353) @@ -113,11 +113,10 @@ equal data. [cmp] is the equality predicate used to compare the data associated with the keys. *) - val validate: 'a t -> [`Ok | `Duplicate of key | `Invalid] + val validate: 'a t -> [`Ok | `Duplicate of key | `Invalid of key * key] end (** Output signature of the functor {!Map.Make}. *) module Make (Ord : OrderedType) : S with type key = Ord.t (** Functor building an implementation of the map structure given a totally ordered type. *) - Modified: trunk/src/update.ml =================================================================== --- trunk/src/update.ml 2009-06-10 08:22:52 UTC (rev 352) +++ trunk/src/update.ml 2009-06-13 09:28:01 UTC (rev 353) @@ -225,11 +225,12 @@ "Corrupted archive: \ the file %s occurs twice in path %s" (Name.toString nm) (Path.toString path))); - | `Invalid -> + | `Invalid (nm, nm') -> raise (Util.Fatal (Printf.sprintf - "Corrupted archive: the files are not \ + "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 @@ -389,7 +390,8 @@ debug (fun() -> Util.msg "Removing archive %s\n" (System.fspathToDebugString fspath)); Util.convertUnixErrorsToFatal "removing archive" (fun () -> - if System.file_exists fspath then System.unlink fspath)) + 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 *) @@ -429,14 +431,19 @@ (System.fspathToDebugString ffrom) (System.fspathToDebugString fto)); Util.convertUnixErrorsToFatal "copying archive" (fun () -> - 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; + System.unlink fto; + 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)) @@ -1775,7 +1782,6 @@ let (localPath, subArch) = getPathInArchive archive Path.empty path in let newArch = updateArchiveRec ui (stripArchive path subArch) in let commit () = - let _ = Stasher.stashCurrentVersion fspath localPath None in let archive = getArchive root in let archive, () = updatePathInArchive archive fspath Path.empty path From vouillon at seas.upenn.edu Mon Jun 15 10:26:06 2009 From: vouillon at seas.upenn.edu (vouillon@seas.upenn.edu) Date: Mon, 15 Jun 2009 10:26:06 -0400 Subject: [Unison-hackers] [unison-svn] r354 - in trunk/src: . system Message-ID: <200906151426.n5FEQ6lP005675@yaws.seas.upenn.edu> Author: vouillon Date: 2009-06-15 10:26:01 -0400 (Mon, 15 Jun 2009) New Revision: 354 Modified: trunk/src/RECENTNEWS trunk/src/mkProjectInfo.ml trunk/src/os.ml trunk/src/osx.ml trunk/src/system/system_win.ml trunk/src/system/system_win_stubs.c trunk/src/unicode.ml Log: * Properly deals with non-conformant AppleDouble files produced by Mac OS X; for compatibility, produce AppleDouble files with the same structure as the one produced by Mac OS X. * Fixed a bug that resulted in Unison missing ressource fork changes * Windows Unicode API: use hard links when available when commiting the archive to disk Modified: trunk/src/RECENTNEWS =================================================================== --- trunk/src/RECENTNEWS 2009-06-13 09:28:01 UTC (rev 353) +++ trunk/src/RECENTNEWS 2009-06-15 14:26:01 UTC (rev 354) @@ -1,5 +1,15 @@ CHANGES FROM VERSION 2.35.-17 +* Properly deals with non-conformant AppleDouble files produced by Mac + OS X; for compatibility, produce AppleDouble files with the same + structure as the one produced by Mac OS X. +* Fixed a bug that resulted in Unison missing ressource fork changes +* Windows Unicode API: use hard links when available when commiting + the archive to disk + +------------------------------- +CHANGES FROM VERSION 2.35.-17 + * Fixed bug introduced during file transfer cleanup that could lead to uncaught exceptions * Simplified function validate in myMap.ml Modified: trunk/src/mkProjectInfo.ml =================================================================== --- trunk/src/mkProjectInfo.ml 2009-06-13 09:28:01 UTC (rev 353) +++ trunk/src/mkProjectInfo.ml 2009-06-15 14:26:01 UTC (rev 354) @@ -162,3 +162,4 @@ + Modified: trunk/src/os.ml =================================================================== --- trunk/src/os.ml 2009-06-13 09:28:01 UTC (rev 353) +++ trunk/src/os.ml 2009-06-15 14:26:01 UTC (rev 354) @@ -266,7 +266,7 @@ in retryLoop 10 info (* Maximum retries: 10 times *) (match optDig with None -> None | Some (d, _) -> Some d) - (match optDig with None -> None | Some (_, d) -> Some d) + None let fullfingerprint_to_string (fp,rfp) = Printf.sprintf "(%s,%s)" (Fingerprint.toString fp) (Fingerprint.toString rfp) Modified: trunk/src/osx.ml =================================================================== --- trunk/src/osx.ml 2009-06-13 09:28:01 UTC (rev 353) +++ trunk/src/osx.ml 2009-06-15 14:26:01 UTC (rev 354) @@ -15,7 +15,10 @@ along with this program. If not, see . *) +let debug = Trace.debug "osx" +(****) + external isMacOSXPred : unit -> bool = "isMacOSX" let isMacOSX = isMacOSXPred () @@ -51,8 +54,37 @@ let doubleMagic = "\000\005\022\007" let doubleVersion = "\000\002\000\000" let doubleFiller = String.make 16 '\000' +let ressource_fork_empty_tag = "This resource fork intentionally left blank " let finfoLength = 32L let emptyFinderInfo () = String.make 32 '\000' +let empty_ressource_fork = + "\000\000\001\000" ^ + "\000\000\001\000" ^ + "\000\000\000\000" ^ + "\000\000\000\030" ^ + ressource_fork_empty_tag ^ + String.make (66+128) '\000' ^ + "\000\000\001\000" ^ + "\000\000\001\000" ^ + "\000\000\000\000" ^ + "\000\000\000\030" ^ + "\000\000\000\000" ^ + "\000\000\000\000" ^ + "\000\028\000\030" ^ + "\255\255" +let empty_attribute_chunk () = + "\000\000" ^ (* pad *) + "ATTR" ^ (* magic *) + "\000\000\000\000" ^ (* debug tag *) + "\000\000\014\226" ^ (* total size *) + "\000\000\000\156" ^ (* data_start *) + "\000\000\000\000" ^ (* data_length *) + "\000\000\000\000" ^ (* reserved *) + "\000\000\000\000" ^ + "\000\000\000\000" ^ + "\000\000" ^ (* flags *) + "\000\000" ^ (* num_attrs *) + String.make 3690 '\000' let getInt2 buf ofs = (Char.code buf.[ofs]) * 256 + Char.code buf.[ofs + 1] @@ -80,25 +112,28 @@ set 0; set 1; set 2; set 3; s -let fail path msg = +let fail dataFspath dataPath doubleFspath msg = raise (Util.Transient - (Format.sprintf "Malformed AppleDouble file '%s' (%s)" - (Fspath.toPrintString path) msg)) + (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 path inch len = +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 path "truncated" + fail dataFspath dataPath doubleFspath "truncated" end; buf -let readDoubleFromOffset path inch offset len = +let readDoubleFromOffset dataFspath dataPath doubleFspath inch offset len = LargeFile.seek_in inch offset; - readDouble path inch len + readDouble dataFspath dataPath doubleFspath inch len -let writeDoubleFromOffset path outch offset str = +let writeDoubleFromOffset outch offset str = LargeFile.seek_out outch offset; output_string outch str @@ -109,27 +144,27 @@ begin try g () with Sys_error _ | Unix.Unix_error _ -> () end; raise e -let openDouble fspath path = - let (fspath, path) = Fspath.findWorkingDir fspath path in - let path = Fspath.appleDouble (Fspath.concat fspath path) in - let inch = try Fs.open_in_bin path with Sys_error _ -> raise Not_found in +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 path inch 26 in + let header = readDouble dataFspath dataPath doubleFspath inch 26 in if String.sub header 0 4 <> doubleMagic then - fail path "bad magic number"; + fail dataFspath dataPath doubleFspath "bad magic number"; if String.sub header 4 4 <> doubleVersion then - fail path "bad version"; + 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 path inch 12 in + 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; - (path, inch, !entries))) + (doubleFspath, inch, !entries))) (fun () -> close_in_noerr inch) (****) @@ -195,7 +230,7 @@ in trim info -let getFileInfos fspath path typ = +let getFileInfos dataFspath dataPath typ = if not (Prefs.read rsrc) then defaultInfos typ else match typ with (`FILE | `DIRECTORY) as typ -> @@ -203,7 +238,9 @@ try let (fInfo, rsrcLength) = getFileInfosInternal - (Fspath.toSysPath (Fspath.concat fspath path)) (typ = `FILE) in + (Fspath.toSysPath (Fspath.concat dataFspath dataPath)) + (typ = `FILE) + in { ressInfo = if rsrcLength = 0L then NoRess else HfsRess (Uutil.Filesize.ofInt64 rsrcLength); @@ -211,26 +248,51 @@ with Unix.Unix_error ((Unix.EOPNOTSUPP | Unix.ENOSYS), _, _) -> (* Not a HFS volume. Look for an AppleDouble file *) try - let (doublePath, inch, entries) = openDouble fspath path in + let (workingDir, realPath) = + Fspath.findWorkingDir dataFspath dataPath in + let (doubleFspath, inch, entries) = + openDouble workingDir realPath in let (rsrcOffset, rsrcLength) = - try Safelist.assoc `RSRC entries with Not_found -> + try + let (offset, len) = Safelist.assoc `RSRC entries in + (* We need to check that the ressource fork is not a + dummy one included for compatibility reasons *) + if len = 286L && + protect (fun () -> + LargeFile.seek_in inch (Int64.add offset 16L); + let len = String.length ressource_fork_empty_tag in + let buf = String.create len in + really_input inch buf 0 len; + buf = ressource_fork_empty_tag) + (fun () -> close_in_noerr inch) + then + (0L, 0L) + else + (offset, len) + with Not_found -> (0L, 0L) in + debug (fun () -> + Util.msg + "AppleDouble for file %s / %s: ressource fork length: %d\n" + (Fspath.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 doublePath "bad finder info"; - let res = readDoubleFromOffset doublePath inch ofs 32 in - close_in inch; - res + if len < finfoLength then + fail dataFspath dataPath doubleFspath "bad finder info"; + readDoubleFromOffset + dataFspath dataPath doubleFspath inch ofs 32 with Not_found -> "") (fun () -> close_in_noerr inch) in + close_in inch; let stats = Util.convertUnixErrorsToTransient "stating AppleDouble file" - (fun () -> Fs.stat doublePath) in + (fun () -> Fs.stat doubleFspath) in { ressInfo = if rsrcLength = 0L then NoRess else AppleDoubleRess @@ -249,7 +311,7 @@ | `Unix -> 0. end, Uutil.Filesize.ofInt64 rsrcLength, - (doublePath, rsrcOffset)); + (doubleFspath, rsrcOffset)); finfo = extractInfo typ finfo } with Not_found -> defaultInfos typ) @@ -270,34 +332,37 @@ String.blit info (offset + 2) fullInfo 24 2; fullInfo -let setFileInfos fspath path finfo = +let setFileInfos dataFspath dataPath finfo = assert (finfo <> ""); Util.convertUnixErrorsToTransient "setting file informations" (fun () -> try - let p = Fspath.toSysPath (Fspath.concat fspath path) in + 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 (doublePath, inch, entries) = openDouble fspath path in + let (doubleFspath, inch, entries) = openDouble workingDir realPath in begin try let (ofs, len) = Safelist.assoc `FINFO entries in - if len <> finfoLength then fail doublePath "bad finder info"; + if len < finfoLength then + fail dataFspath dataPath doubleFspath "bad finder info"; let fullFinfo = protect (fun () -> - let res = readDoubleFromOffset doublePath inch ofs 32 in + 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 doublePath in + Fs.open_out_gen [Open_wronly; Open_binary] 0o600 doubleFspath in protect (fun () -> - writeDoubleFromOffset doublePath outch ofs - (insertInfo fullFinfo finfo); + writeDoubleFromOffset outch ofs (insertInfo fullFinfo finfo); close_out outch) (fun () -> close_out_noerr outch); @@ -307,25 +372,39 @@ (Format.sprintf "Unable to set the file type and creator: \n\ The AppleDouble file '%s' has no fileinfo entry." - (Fspath.toPrintString doublePath))) + (Fspath.toPrintString doubleFspath))) end with Not_found -> (* No AppleDouble file, create one if needed. *) if finfo <> "F" && finfo <> "D" then begin - let path = Fspath.appleDouble (Fspath.concat fspath path) in + let doubleFspath = + Fspath.appleDouble (Fspath.concat workingDir realPath) in let outch = Fs.open_out_gen - [Open_wronly; Open_creat; Open_excl; Open_binary] 0o600 path + [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 ressource fork... + We also put an empty extended attribute section at the + end of the finder info section, mimicking the Mac OS X + kernel behavior. *) protect (fun () -> output_string outch doubleMagic; output_string outch doubleVersion; output_string outch doubleFiller; - output_string outch "\000\001"; (* One entry *) + output_string outch "\000\002"; (* Two entries *) output_string outch "\000\000\000\009"; (* Finder info *) - output_string outch "\000\000\000\038"; (* offset *) - output_string outch "\000\000\000\032"; (* length *) + output_string outch "\000\000\000\050"; (* offset *) + output_string outch "\000\000\014\176"; (* length *) + output_string outch "\000\000\000\002"; (* Ressource fork *) + output_string outch "\000\000\014\226"; (* offset *) + output_string outch "\000\000\001\030"; (* length *) output_string outch (insertInfo (emptyFinderInfo ()) finfo); + output_string outch (empty_attribute_chunk ()); + (* extended attributes *) + output_string outch empty_ressource_fork; close_out outch) (fun () -> close_out_noerr outch) end @@ -373,6 +452,10 @@ | HfsRess _ -> Fingerprint.file fspath (ressPath path) | AppleDoubleRess (_, _, _, len, (path, offset)) -> + debug (fun () -> + Util.msg "ressource 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 = @@ -423,12 +506,14 @@ output_string outch "\000\002"; (* Two entries *) output_string outch "\000\000\000\009"; (* Finder info *) output_string outch "\000\000\000\050"; (* offset *) - output_string outch "\000\000\000\032"; (* length *) + output_string outch "\000\000\014\176"; (* length *) output_string outch "\000\000\000\002"; (* Resource fork *) - output_string outch "\000\000\000\082"; (* offset *) + output_string outch "\000\000\014\226"; (* offset *) output_string outch (setInt4 (Uutil.Filesize.toInt64 length)); (* length *) output_string outch (emptyFinderInfo ()); + output_string outch (empty_attribute_chunk ()); + (* extended attributes *) flush outch) (fun () -> close_out_noerr outch); outch) Modified: trunk/src/system/system_win.ml =================================================================== --- trunk/src/system/system_win.ml 2009-06-13 09:28:01 UTC (rev 353) +++ trunk/src/system/system_win.ml 2009-06-15 14:26:01 UTC (rev 354) @@ -85,6 +85,7 @@ external mkdir_impl : string -> string -> unit = "win_mkdir" external unlink_impl : string -> string -> unit = "win_unlink" external rename_impl : string -> string -> string -> unit = "win_rename" +external link_impl : string -> string -> string -> unit = "win_link" external chmod_impl : string -> string -> int -> unit = "win_chmod" external utimes_impl : string -> string -> float -> float -> unit = "win_utimes" @@ -105,7 +106,7 @@ let chmod f perm = chmod_impl f (epath f) perm let chown _ _ _ = raise (Unix.Unix_error (Unix.ENOSYS, "chown", "")) let utimes f t1 t2 = utimes_impl f (epath f) t1 t2 -let link _ _ = raise (Unix.Unix_error (Unix.ENOSYS, "link", "")) +let link f1 f2 = link_impl f1 (epath f1) (epath f2) let openfile f flags perm = open_impl f (epath f) flags perm let readlink _ = raise (Unix.Unix_error (Unix.ENOSYS, "readlink", "")) let symlink _ _ = raise (Unix.Unix_error (Unix.ENOSYS, "symlink", "")) Modified: trunk/src/system/system_win_stubs.c =================================================================== --- trunk/src/system/system_win_stubs.c 2009-06-13 09:28:01 UTC (rev 353) +++ trunk/src/system/system_win_stubs.c 2009-06-15 14:26:01 UTC (rev 354) @@ -3,7 +3,7 @@ #include #include -#define _WIN32_WINDOWS 0x0410 +#define WINVER 0x0500 #include #include @@ -124,6 +124,18 @@ CAMLreturn (Val_unit); } +CAMLprim value win_link(value path1, value wpath1, value wpath2) +{ + CAMLparam3(path1, wpath1, wpath2); + + if (!CreateHardLinkW((LPWSTR)String_val(wpath2), (LPWSTR)String_val(wpath1), + NULL)) { + win32_maperr (GetLastError ()); + uerror("rename", path1); + } + CAMLreturn (Val_unit); +} + CAMLprim value win_chmod (value path, value wpath, value perm) { DWORD attr; CAMLparam3(path, wpath, perm); Modified: trunk/src/unicode.ml =================================================================== --- trunk/src/unicode.ml 2009-06-13 09:28:01 UTC (rev 353) +++ trunk/src/unicode.ml 2009-06-15 14:26:01 UTC (rev 354) @@ -836,7 +836,7 @@ i = l || let c = get s i in if c < 0x80 then - scan s (i + 1) l + c <> 0 && scan s (i + 1) l else if c < 0xE0 then begin (* 80 - 7FF *) c >= 0xc2 && i + 1 < l && @@ -850,7 +850,7 @@ let c2 = get s (i + 2) in (c1 lor c2) land 0xc0 = 0x80 && let v = c lsl 12 + c1 lsl 6 + c2 - 0xe2080 in - v >= 0x800 && (v < 0xd800 || v > 0xdfff) && + v >= 0x800 && (v < 0xd800 || (v > 0xdfff && v <> 0xfffe && v <> 0xffff)) && scan s (i + 3) l end else begin (* 10000 - 10FFFF *) From vouillon at seas.upenn.edu Wed Jun 17 10:42:13 2009 From: vouillon at seas.upenn.edu (vouillon@seas.upenn.edu) Date: Wed, 17 Jun 2009 10:42:13 -0400 Subject: [Unison-hackers] [unison-svn] r355 - in trunk/src: . system ubase Message-ID: <200906171442.n5HEgDdl029290@yaws.seas.upenn.edu> Author: vouillon Date: 2009-06-17 10:42:07 -0400 (Wed, 17 Jun 2009) New Revision: 355 Modified: trunk/src/BUGS.txt trunk/src/RECENTNEWS trunk/src/copy.ml trunk/src/mkProjectInfo.ml trunk/src/name.ml trunk/src/stasher.ml trunk/src/system/system_win.ml trunk/src/system/system_win_stubs.c trunk/src/transport.ml trunk/src/ubase/util.ml trunk/src/uicommon.ml trunk/src/uigtk2.ml trunk/src/unicode.ml trunk/src/unicode.mli trunk/src/unicode_tables.ml trunk/src/update.ml trunk/src/uutil.ml Log: * Use a better file name for keeping a copy of an incorrectly transferred file. In particular, this is now a temp filename, and Unison will not try to propagate it next time it is run. * In function Stasher.backup, use Fspath.findWorkingDir to find the right file to rename or delete, possibly following symlinks. * Uigtk2: relabelled "Restart" button to "Rescan" * Uigtk2: performance improvements * 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). * Unicode normalization: put characters in canonical order * Fixed recently introduced bug in Update.postCommitArchive * Uicommon: always reparse the command line when loading a profile (not just the first time) Modified: trunk/src/BUGS.txt =================================================================== --- trunk/src/BUGS.txt 2009-06-15 14:26:01 UTC (rev 354) +++ trunk/src/BUGS.txt 2009-06-17 14:42:07 UTC (rev 355) @@ -15,22 +15,6 @@ SERIOUS ======= -[June 2006, Schmitt and Newton] - Alan said: I realized yesterday that I had xferbycopying set to false, so I - turned it back on. However some automatic unison synchronization - failed last night, with the message: - > Shortcut: copying 1148507176.26619_0.top.inrialpes.fr:2,ST from - > local file Maildir/.Caml/cur/1148507176.26619_0.top.inrialpes.fr:2, - > Uncaught exception Not_found - > Fatal error: Lost connection with the server - Ryan Newton later sent BCP a debug trace showing this happening, but it - did not elucidate the problem. For the moment, I've (BCP) just protected - the tryCopyMovedFile function with a call to convertUnixErrorsToTransient, - which should help if the Not_found is being raised from there. (In the - debug trace, we see "success" printed by this function and then the - crash. An obvious culprit is the call to Xferhint.insert, but my reading - of the code is that this should not fail.) - [June 2006, Jim] By the way, there is a bug if you are doing a merge and are propagating times, the times of the merged file end @@ -39,44 +23,6 @@ the times... ==> Best to make them both equal to the time of merging -[May 2006, Schmitt] - In presence of path that cannot be propagated, Unison may have a fatal - error "archives not identical". - Here is the setting: - replica A: - tmp/ubug/foo - tmp/toto/foo - replica B: - tmp/ - profile: - root = /Users/schmitta/tmp - root = ssh://beauty/tmp - # common options - sshargs = -C - servercmd = bin/unison - path = ubug/foo - path = toto - The run: (* message that there are no archive *) - local beauty.local - error ubug/foo - path ubug/foo is not valid because ubug is not a directory in one of the replicas - dir ----> toto [f] - Proceed with propagating updates? [] y - Propagating updates - UNISON 2.19.2 started propagating changes at 17:40:47 on 30 May 2006 - [ERROR] Skipping ubug/foo - path ubug/foo is not valid because ubug is not a directory in one of the replicas - [BGN] Copying toto - from /Users/schmitta/tmp - to //beauty.local//Users/schmitta/tmp - [END] Copying toto - UNISON 2.19.2 finished propagating changes at 17:40:47 on 30 May 2006 - Saving synchronizer state - Dumping archives to ~/unison.dump on both hosts - Finished dumping archives - Fatal error: Internal error: New archives are not identical. - Retaining original archives. Please run Unison again to bring them up to date. - ===> This one was recently [March 07] fixed by Jerome [July 2002, Findler] I get this message from unison: @@ -104,24 +50,6 @@ ===> We should use some more information to make sure the archive names are unique enough. But what, exactly? -[Aug 2002] OSX native filesystems are case insensitive, like Windows, but -Unison does not currently recognize this. A workaround is to set the -'ignorecase' preference explicitly to true. - -[July 2002] Unison does not understand Windows' non-Latin character set - encodings. For some other character sets (e.g. European characters - such as u-umlaut), only the display is affected. For character sets - that use multi-byte encoding schemes (e.g. Japanese), Unison can - actually get confused and synchronize incorrectly. (One case where - this can happen is if the second byte of a two-byte character is - actually a slash!) - ==> This would be hard to fix, given OCaml's current poor support - for localization. Jacques Garrigue made some suggestions (bcp - has them in a mail message) that might be the basis for looking - at this if someone is really motivated, but they look like real - work. - ==> The right think to do is to use the Windows Unicode API - [APril 2002, Jason Eisner] Recently I found an aliasing problem that may endanger Unison's semantics. -- @@ -138,12 +66,6 @@ separate information for the two names in the archive files. [A long example is in a mailmessage in BCP's files] -[April 2002] File times are reported incorrectly under Win32 after a - switch to/from daylight saving time. Here is a link, to shed some - light on why this might be happening: - http://www.codeproject.com/datetime/dstbugs.asp - FIXED (a difference of exactly one hour is ignored) - starting Unison on two non-existent local directories leads to an assertion failure in path.ml @@ -159,59 +81,6 @@ I use Unison on two XP Professional machines, German versions, with the simple tcp connection. -Andy Starrer [Aug 2002] - After connecting to server and trying to do first original sync - with empty client dir, the server searches a while and then shows a dialog: - -- - Uncaught exception File "/usr/ports/net/unison/work/unison-2.9.1/path.ml, - line 0, characters 1785-1797: Assertion failed - -- - using an awk line & char numbering print, - these char #s in path.ml fall on the "assert false" on line 69 - (first line of file shows char count of 0) - -- - 66 1707 let parent path = - 67 1725 match rtl path with - 68 1747 RTL(_::p) -> RTL(p) - 69 1771 | RTL [] -> assert false - 70 1798 | LTR _ -> assert false - -- - ===> Who is calling parent on an empty path??? - -Another report of the same (?) bug by Ruslan Ermolov: - Attempting to symlink ~/.unison/backup to - another (real) directory results in the following uncaught exception: - -- - : $ ls -ld ~/.unison/*backup - : lrwx------ 1 ru sunbay 10 Aug 6 15:22 /home/ru/.unison/backup -> realbackup - : drwx------ 2 ru sunbay 512 Aug 6 15:22 /home/ru/.unison/realbackup - : $ unison -batch -backup='Name *' /tmp/replica1 /tmp/replica2 - : Contacting server... - : Looking for changes - : Reconciling changes - : - : replica1 replica2 - : deleted ----> a - : replica1 : deleted - : replica2 : unchanged file - : modified at 15:22 on 6 Aug, 2002 size 0 rw------- - : Propagating updates - : - : - : UNISON started propagating changes at 15:26:04 on 06 Aug 2002 - : [BGN] Deleting a - : from /tmp/replica2 - : Uncaught exception File "/usr/ports/net/unison/work/unison-2.9.1/path.ml", line 0, characters 1785-1797: Assertion failed - -- - OTOH, Unison follows ~/.unison if it's symlinked, and I use this feature - when using SSH as a transport. - -Jamey Leifer [July 2002] - * [graphic ui, bug] If one of the files "has unknown type" (i.e. is a - system file), then pressing "f" (i.e. "Retry on unsynchronised items") - results in an error window and unison quiting. To me "Retry" implies - less drastic behaviour. It should just report errors as normal. - BCP [May 2002] The "rescan paths that failed previous sync" function misses some files. E.g., if a directory has failed to transfer because the disk ran out of @@ -237,50 +106,13 @@ remote myfile as usual, handling clock skew as for any other propagation. Other file properties should probably NOT be propagated. -Unison should report a better error message when a modified file slips - through the fast check and is later detected during transport. - -I got this - C:\CygWin\home\kmoerder>unison a ssh://moerder/a - kmoerder at moerder's password: - C:\CygWin\home\kmoerder>Fatal error: Error in grabbing: - Broken pipe [read()] - -This should be caught and reported cleanly: - ~/.unison> unison ~/.unison/mail - Uncaught exception Invalid_argument("Os.string2name('/home/bcpierce/.unison/mail.prf' contains a '/')") - -dworley: - Unison sometimes aborts if one of the files it is synchronizing - changes during the run. Most of the time, it can step over the - file correctly, but sometimes it bails out. This can be a problem - in an environment where you cannot guarantee that the two - filesystems are stable during the Unison run. - ==> More information needed - Karl Moerder: - The statusdepth doesn't seem to change anything (like it is being - ignored). I set it to 2 ("statusdepth = 2" in my .prf file) and got the - same display as the default (setting of 1). I didn't check if the - default really acted like 1, so it could be that I need to set it to a - higher value. I can play with it more later if you need me to. - -Karl Moerder: The synchronization of modification times does not work on directories (WinNT folders) or on read-only files. I found this when I tried to synchronize mod times on an otherwise synchronized tree. It failed gracefully on these. The "[click..." message is a nice touch. ==> [Nothing we can do for read-only files; need to patch ocaml for directories...] - -Bob H. reported an abnormal failure during transport that apparently led to - an immediate, dirty termination instead of a clean failure, trapped and - properly displayed in the user interface: - - on Windows (of course) - - Unison was trying to propagate a file onto a file that was open - in another application; in Windows, this causes an error - - the error was apparently not caught in the usual way, but instead - terminated Unison, leaving a DANGER.README file "After I synchronized two directories I created a new profile, which defaulted to the same directories. I synchronized again (no changes, @@ -298,12 +130,6 @@ The "Diff" window [under Windows] sometimes shows nothing. Does this arise from a missing "Diff" program? We should detect this case! -"Hanrahan, Donald" - Finally, I discovered that a preceeding "/" in a "defaultpath" entry - (e.g., defaultpath=/myshare/myfolder - vs. defaultpath=myshare/myfolder) seems to cause an unhandled - exception (Invalid_argument <"os.string2path">) to occur. - --------------------------------------------------------------------------- COSMETIC ======== Modified: trunk/src/RECENTNEWS =================================================================== --- trunk/src/RECENTNEWS 2009-06-15 14:26:01 UTC (rev 354) +++ trunk/src/RECENTNEWS 2009-06-17 14:42:07 UTC (rev 355) @@ -1,5 +1,24 @@ CHANGES FROM VERSION 2.35.-17 +* Use a better file name for keeping a copy of an incorrectly + transferred file. In particular, this is now a temp filename, and + Unison will not try to propagate it next time it is run. +* In function Stasher.backup, use Fspath.findWorkingDir to find the + right file to rename or delete, possibly following symlinks. +* Uigtk2: relabelled "Restart" button to "Rescan" +* Uigtk2: performance improvements +* 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). +* Unicode normalization: put characters in canonical order +* Fixed recently introduced bug in Update.postCommitArchive +* Uicommon: always reparse the command line when loading a profile + (not just the first time) + +------------------------------- +CHANGES FROM VERSION 2.35.-17 + * Properly deals with non-conformant AppleDouble files produced by Mac OS X; for compatibility, produce AppleDouble files with the same structure as the one produced by Mac OS X. Modified: trunk/src/copy.ml =================================================================== --- trunk/src/copy.ml 2009-06-15 14:26:01 UTC (rev 354) +++ trunk/src/copy.ml 2009-06-17 14:42:07 UTC (rev 355) @@ -123,18 +123,24 @@ (* Paranoid check: recompute the transferred file's digest to match it with the archive's *) -let paranoidCheck fspathTo pathTo desc fp ress = +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 fp' <> fp then begin - let savepath = Path.addSuffixToFinalName pathTo "-bad" in + 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.return (Failure (Printf.sprintf "The file %s was incorrectly transferred (fingerprint mismatch in %s) \ -- temp file saved as %s" (Path.toString pathTo) (Os.reasonForFingerprintMismatch fp fp') - (Path.toString savepath))) + (Fspath.toDebugString (Fspath.concat fspathTo savepath)))) end else Lwt.return (Success info) @@ -205,11 +211,11 @@ let localFile fspathFrom pathFrom fspathTo pathTo realPathTo update desc ressLength ido = - let use_id f = match ido with Some id -> f id | None -> () in +(* let use_id f = match ido with Some id -> f id | None -> () in*) Util.convertUnixErrorsToTransient "copying locally" (fun () -> - use_id (fun id -> Uutil.showProgress id Uutil.Filesize.zero "l"); +(* use_id (fun id -> Uutil.showProgress id Uutil.Filesize.zero "l");*) debug (fun () -> Util.msg "Copy.localFile %s / %s to %s / %s\n" (Fspath.toDebugString fspathFrom) (Path.toString pathFrom) @@ -485,7 +491,7 @@ Lwt.return () end >>= fun () -> setFileinfo fspathTo pathTo realPathTo update desc; - paranoidCheck fspathTo pathTo desc fp ress + paranoidCheck fspathTo pathTo realPathTo desc fp ress let reallyTransferFile connFrom fspathFrom pathFrom fspathTo pathTo realPathTo @@ -738,7 +744,7 @@ localFile fspathFrom pathFrom fspathTo pathTo realPathTo update desc (Osx.ressLength ress) (Some id); - paranoidCheck fspathTo pathTo desc fp ress + paranoidCheck fspathTo pathTo realPathTo desc fp ress | _ -> transferFile rootFrom pathFrom rootTo fspathTo pathTo realPathTo Modified: trunk/src/mkProjectInfo.ml =================================================================== --- trunk/src/mkProjectInfo.ml 2009-06-15 14:26:01 UTC (rev 354) +++ trunk/src/mkProjectInfo.ml 2009-06-17 14:42:07 UTC (rev 355) @@ -163,3 +163,4 @@ + Modified: trunk/src/name.ml =================================================================== --- trunk/src/name.ml 2009-06-15 14:26:01 UTC (rev 354) +++ trunk/src/name.ml 2009-06-17 14:42:07 UTC (rev 355) @@ -49,8 +49,11 @@ Rx.case_insensitive (Rx.rx "(.*[\000-\031<>:\"/\\|?*].*)|\ - ((con|prn|aux|nul|com[1-9]|lpt[1-9])(\\.[^.]*)?)|\ + ((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 Modified: trunk/src/stasher.ml =================================================================== --- trunk/src/stasher.ml 2009-06-15 14:26:01 UTC (rev 354) +++ trunk/src/stasher.ml 2009-06-17 14:42:07 UTC (rev 355) @@ -366,10 +366,11 @@ (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 fspath path in - if not (Os.exists fspath path) 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)) @@ -410,7 +411,7 @@ disposeIfNeeded() in if finalDisposition = `AndRemove then try - Os.rename "backup" fspath path backRoot backPath + Os.rename "backup" workingDir realPath backRoot backPath with Util.Transient _ -> debug (fun () -> Util.msg "Rename failed -- copying instead\n"); byCopying() Modified: trunk/src/system/system_win.ml =================================================================== --- trunk/src/system/system_win.ml 2009-06-15 14:26:01 UTC (rev 354) +++ trunk/src/system/system_win.ml 2009-06-17 14:42:07 UTC (rev 355) @@ -49,10 +49,11 @@ else f -let utf16 s = Unicode.to_utf_16 s -let utf8 s = Unicode.from_utf_16 s -let path16 = utf16 -let epath f = utf16 (extendedPath f) +let utf8 = Unicode.from_utf_16 +let utf16 = Unicode.to_utf_16 +let path8 = Unicode.from_utf_16(*_filename*) +let path16 = Unicode.to_utf_16(*_filename*) +let epath f = path16 (extendedPath f) let sys_error e = match e with @@ -117,7 +118,7 @@ with e -> sys_error e let getcwd () = try - utf8 (getcwd_impl ()) + path8 (getcwd_impl ()) with e -> sys_error e let badFileRx = Rx.rx ".*[?*].*" @@ -137,8 +138,8 @@ let d = du d in match d.entry_read with Dir_empty -> raise End_of_file - | Dir_read name -> d.entry_read <- Dir_toread; utf8 name - | Dir_toread -> utf8 (findnext d.handle) + | Dir_read name -> d.entry_read <- Dir_toread; path8 name + | Dir_toread -> path8 (findnext d.handle) let closedir d = let d = du d in match d.entry_read with Modified: trunk/src/system/system_win_stubs.c =================================================================== --- trunk/src/system/system_win_stubs.c 2009-06-15 14:26:01 UTC (rev 354) +++ trunk/src/system/system_win_stubs.c 2009-06-17 14:42:07 UTC (rev 355) @@ -353,7 +353,7 @@ h = FindFirstFileW((LPCWSTR) String_val(name),&fileinfo); if (h == INVALID_HANDLE_VALUE) { DWORD err = GetLastError(); - if (err == ERROR_NO_MORE_FILES) + if ((err == ERROR_NO_MORE_FILES) || (err == ERROR_FILE_NOT_FOUND)) raise_end_of_file(); else { win32_maperr(err); Modified: trunk/src/transport.ml =================================================================== --- trunk/src/transport.ml 2009-06-15 14:26:01 UTC (rev 354) +++ trunk/src/transport.ml 2009-06-17 14:42:07 UTC (rev 355) @@ -175,24 +175,28 @@ let logStart () = Abort.reset (); - let tm = Util.localtime (Util.time()) in + let t = Unix.gettimeofday () in + let tm = Util.localtime t in let m = Printf.sprintf - "%s%s started propagating changes at %02d:%02d:%02d on %02d %s %04d\n" + "%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 tm = Util.localtime (Util.time()) in + let t = Unix.gettimeofday () in + let tm = Util.localtime t in let m = Printf.sprintf - "%s finished propagating changes at %02d:%02d:%02d on %02d %s %04d\n%s" + "%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 Modified: trunk/src/ubase/util.ml =================================================================== --- trunk/src/ubase/util.ml 2009-06-15 14:26:01 UTC (rev 354) +++ trunk/src/ubase/util.ml 2009-06-17 14:42:07 UTC (rev 355) @@ -428,8 +428,12 @@ (if (osType = `Unix) || isCygwin then safeGetenv "HOME" else if osType = `Win32 then +(*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) try System.getenv "HOME" (* Windows 9x with Cygwin HOME set *) with Not_found -> +*) try System.getenv "USERPROFILE" (* Windows NT/2K standard *) with Not_found -> try System.getenv "UNISON" (* Use UNISON dir if it is set *) Modified: trunk/src/uicommon.ml =================================================================== --- trunk/src/uicommon.ml 2009-06-15 14:26:01 UTC (rev 354) +++ trunk/src/uicommon.ml 2009-06-17 14:42:07 UTC (rev 355) @@ -505,7 +505,8 @@ end; (* Parse the command line. This will override settings from the profile. *) - if !firstTime then begin + (* 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; Modified: trunk/src/uigtk2.ml =================================================================== --- trunk/src/uigtk2.ml 2009-06-15 14:26:01 UTC (rev 354) +++ trunk/src/uigtk2.ml 2009-06-17 14:42:07 UTC (rev 355) @@ -147,13 +147,19 @@ let sync_action = ref None -let gtk_sync () = - begin match !sync_action with - Some f -> f () - | None -> () - end; - while Glib.Main.iteration false do () done +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 ***********************************************************************) @@ -810,7 +816,7 @@ let res = t#run () in let pwd = passwordE#text in t#destroy (); releaseFocus (); - gtk_sync (); + gtk_sync true; begin match res with `DELETE_EVENT | `QUIT -> safeExit (); "" | `OK -> pwd @@ -1211,7 +1217,7 @@ let grAction = ref [] in let grDiff = ref [] in let grGo = ref [] in - let grRestart = ref [] in + let grRescan = 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 @@ -1410,13 +1416,13 @@ let v = float row /. float (mainWindow#rows + 1) *. (upper-.lower) +. lower in - adj#set_value (min v (upper -. adj#page_size)) + adj#set_value (min v (upper -. adj#page_size)); end in let makeFirstUnfinishedVisible pRiInFocus = let im = Array.length !theState in let rec find i = - if i >= im then () else + if i >= im then makeRowVisible im else match pRiInFocus (!theState.(i).ri), !theState.(i).whatHappened with true, None -> makeRowVisible i | _ -> find (i+1) in @@ -1463,7 +1469,7 @@ if !progressBarPulse then progressBar#pulse (); ignore (statusContext#push (transcode m)); (* Force message to be displayed immediately *) - gtk_sync () + gtk_sync false in let formatStatus major minor = (Util.padto 30 (major ^ " ")) ^ minor in @@ -1612,19 +1618,32 @@ if !current = Some i then updateDetails (); updateButtons () in + let fastRedisplay i = + let (r1, action, r2, status, path) = columnsOf i in + displayStatusIcon i status; + if status = "failed" then begin + mainWindow#set_cell + ~text:(transcodeFilename path ^ + " [failed: click on this line for details]") i 4 + end + in + let totalBytesToTransfer = ref Uutil.Filesize.zero in let totalBytesTransferred = ref Uutil.Filesize.zero in + let lastFrac = ref 0. in let displayGlobalProgress v = - progressBar#set_fraction (max 0. (min 1. (v /. 100.))); + 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.5 then progressBar#set_text (Util.percent2string v) else progressBar#set_text ""; *) - (* Force message to be displayed immediately *) - gtk_sync () in + in let showGlobalProgress b = (* Concatenate the new message *) @@ -1660,9 +1679,10 @@ else Util.percent2string (Uutil.Filesize.percentageOfTotalSize b len) in let dbg = if Trace.enabled "progress" then dbg ^ "/" else "" in let newstatus = dbg ^ newstatus in - mainWindow#set_cell ~text:newstatus i 3; + let oldstatus = mainWindow#cell_text i 3 in + if oldstatus <> newstatus then mainWindow#set_cell ~text:newstatus i 3; showGlobalProgress bytes; - gtk_sync (); + gtk_sync false; begin match item.ri.replicas with Different (_, _, dir, _) -> begin match !dir with @@ -1727,7 +1747,7 @@ grSet grAction false; grSet grDiff false; grSet grGo false; - grSet grRestart false; + grSet grRescan false; mainWindow#clear(); detailsWindow#buffer#set_text ""; @@ -1764,7 +1784,7 @@ displayMain(); progressBarPulse := false; sync_action := None; displayGlobalProgress 0.; grSet grGo (Array.length !theState > 0); - grSet grRestart true; + grSet grRescan true; if Prefs.read Globals.confirmBigDeletes then begin if dangerousPaths <> [] then begin Prefs.set Globals.batch false; @@ -1810,7 +1830,7 @@ "Permanently ignore files with this name (in any dir)"); (* - grAdd grRestart + grAdd grRescan (ignoreMenu#add_item ~callback: (fun () -> getLock ignoreDialog) "Edit ignore patterns"); *) @@ -1853,7 +1873,7 @@ grSet grAction false; grSet grDiff false; grSet grGo false; - grSet grRestart false; + grSet grRescan false; Trace.status "Propagating changes"; Transport.logStart (); @@ -1901,9 +1921,13 @@ fail e) >>= (fun res -> theSI.whatHappened <- Some (res, !textDetailed); - redisplay i; - makeFirstUnfinishedVisible pRiThisRound; - gtk_sync (); + fastRedisplay i; + sync_action := + Some + (fun () -> + makeFirstUnfinishedVisible pRiThisRound; + sync_action := None); + gtk_sync false; return ()) | Some _ -> return () (* Already processed this one (e.g. merged it) *) @@ -1922,6 +1946,7 @@ Trace.showTimer t; Trace.status "Updating synchronizer state"; let t = Trace.startTimer "Updating synchronizer state" in + gtk_sync true; Update.commitUpdates(); Trace.showTimer t; @@ -1946,7 +1971,7 @@ failures (if failures=""||skipped="" then "" else ", ") skipped); displayGlobalProgress 0.; - grSet grRestart true + grSet grRescan true end in (********************************************************************* @@ -1971,9 +1996,22 @@ getLock synchronize) ()); (********************************************************************* - Restart button + Rescan button *********************************************************************) - let detectCmdName = "Restart" in + let loadProfile p = + debug (fun()-> Util.msg "Loading profile %s..." p); + Uicommon.initPrefs p displayWaitMessage getFirstRoot getSecondRoot + termInteract; + displayNewProfileLabel p; + setMainWindowColumnHeaders() + in + + let reloadProfile () = + match !Prefs.profileName with + None -> () + | Some(n) -> loadProfile n in + + let detectCmdName = "Rescan" in let detectCmd () = getLock detectUpdatesAndReconcile; updateDetails (); @@ -1982,11 +2020,11 @@ end in (* actionBar#insert_space ();*) - grAdd grRestart + grAdd grRescan (actionBar#insert_button ~text:detectCmdName ~icon:((GMisc.image ~stock:`REFRESH ())#coerce) ~tooltip:"Check for updates" - ~callback: detectCmd ()); + ~callback: (fun () -> reloadProfile(); detectCmd()) ()); (********************************************************************* Buttons for <--, M, -->, Skip @@ -2230,37 +2268,24 @@ Synchronization menu *********************************************************************) - let loadProfile p = - debug (fun()-> Util.msg "Loading profile %s..." p); - Uicommon.initPrefs p displayWaitMessage getFirstRoot getSecondRoot - termInteract; - displayNewProfileLabel p; - setMainWindowColumnHeaders() - in - - let reloadProfile () = - match !Prefs.profileName with - None -> () - | Some(n) -> loadProfile n in - grAdd grGo (fileMenu#add_image_item ~key:GdkKeysyms._g ~image:(GMisc.image ~stock:`EXECUTE ~icon_size:`MENU () :> GObj.widget) ~callback:(fun () -> getLock synchronize) ~label:"Go" ()); - grAdd grRestart + grAdd grRescan (fileMenu#add_image_item ~key:GdkKeysyms._r ~image:(GMisc.image ~stock:`REFRESH ~icon_size:`MENU () :> GObj.widget) ~callback:(fun () -> reloadProfile(); detectCmd()) ~label:detectCmdName ()); - grAdd grRestart + grAdd grRescan (fileMenu#add_item ~key:GdkKeysyms._a ~callback:(fun () -> reloadProfile(); Prefs.set Globals.batch true; detectCmd()) "Detect updates and proceed (without waiting)"); - grAdd grRestart + grAdd grRescan (fileMenu#add_item ~key:GdkKeysyms._f ~callback:( fun () -> @@ -2282,7 +2307,7 @@ let failedindices = loop 0 [] in let failedpaths = Safelist.map (fun i -> !theState.(i).ri.path) failedindices in - debug (fun()-> Util.msg "Restarting with paths = %s\n" + debug (fun()-> Util.msg "Rescaning with paths = %s\n" (String.concat ", " (Safelist.map (fun p -> "'"^(Path.toString p)^"'") failedpaths))); @@ -2294,7 +2319,7 @@ ignore (fileMenu#add_separator ()); - grAdd grRestart + grAdd grRescan (fileMenu#add_image_item ~key:GdkKeysyms._p ~callback:(fun _ -> match getProfile() with @@ -2304,7 +2329,7 @@ ~label:"Select a new profile from the profile dialog..." ()); let fastProf name key = - grAdd grRestart + grAdd grRescan (fileMenu#add_item ~key:key ~callback:(fun _ -> if System.file_exists (Prefs.profilePathname name) then begin @@ -2370,7 +2395,7 @@ grSet grAction false; grSet grDiff false; grSet grGo false; - grSet grRestart false; + grSet grRescan false; ignore (toplevelWindow#event#connect#delete ~callback: (fun _ -> safeExit (); true)); @@ -2399,7 +2424,7 @@ (* Ask the Remote module to call us back at regular intervals during long network operations. *) let rec tick () = - gtk_sync (); + gtk_sync true; Lwt_unix.sleep 0.05 >>= tick in ignore_result (tick ()); Modified: trunk/src/unicode.ml =================================================================== --- trunk/src/unicode.ml 2009-06-15 14:26:01 UTC (rev 354) +++ trunk/src/unicode.ml 2009-06-17 14:42:07 UTC (rev 355) @@ -26,6 +26,809 @@ (****) +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 @@ -128,7 +931,10 @@ let normalize s = let l = String.length s in let s' = String.create (3 * l) in - try norm s 0 l s' 0 with Invalid -> s + try + let s' = norm s 0 l s' 0 in order s'; s' + with Invalid -> + s (****) @@ -152,77 +958,6 @@ (****) -let rec decode_char s i l = - if i = l then fail () else - let c = get s i in - if c < 0x80 then - cont s (i + 1) l c - else if c < 0xE0 then begin - (* 80 - 7FF *) - if c < 0xc2 || i + 1 >= l then fail () else - let c1 = get s (i + 1) in - if c1 land 0xc0 <> 0x80 then fail () else - let v = c lsl 6 + c1 - 0x3080 in - cont s (i + 2) l v - end else if c < 0xF0 then begin - (* 800 - FFFF *) - if i + 2 >= l then fail () else - let c1 = get s (i + 1) in - let c2 = get s (i + 2) in - if (c1 lor c2) land 0xc0 <> 0x80 then fail () else - let v = c lsl 12 + c1 lsl 6 + c2 - 0xe2080 in - if v < 0x800 then fail () else - cont s (i + 3) l v - end else begin - (* 10000 - 10FFFF *) - if i + 3 >= l then fail () else - let c1 = get s (i + 1) in - let c2 = get s (i + 2) in - let c3 = get s (i + 3) in - if (c1 lor c2 lor c3) land 0xc0 <> 0x80 then fail () else - let v = c lsl 18 + c1 lsl 12 + c2 lsl 6 + c3 - 0x03c82080 in - if v < 0x10000 || v > 0x10ffff then fail () else - cont s (i + 4) l v - end - -and cont s i l v = (v, i) - -let encode_char s i l c = - if c < 0x80 then begin - if i >= l then fail () else begin - set s i c; - i + 1 - end - end else if c < 0x800 then begin - if i + 1 >= l then fail () else begin - set s i (c lsr 6 + 0xC0); - set s (i + 1) (c land 0x3f + 0x80); - i + 2 - end - end else if c < 0x10000 then begin - if i + 1 >= l then fail () else begin - set s i (c lsr 12 + 0xE0); - set s (i + 1) ((c lsr 6) land 0x3f + 0x80); - set s (i + 2) (c land 0x3f + 0x80); - i + 3 - end - end else begin - if i + 1 >= l then fail () else begin - set s i (c lsr 18 + 0xF0); - set s (i + 1) ((c lsr 12) land 0x3f + 0x80); - set s (i + 2) ((c lsr 6) land 0x3f + 0x80); - set s (i + 3) (c land 0x3f + 0x80); - i + 4 - end - end - -let rec prev_char s i = - let i = i - 1 in - if i < 0 then fail () else - if (get s i) land 0xc0 <> 0x80 then i else prev_char s i - -(****) - let uniCharPrecompSourceTable = [| 0x00000300; 0x00540000; 0x00000301; 0x00750054; 0x00000302; 0x002000C9; 0x00000303; 0x001C00E9; @@ -772,27 +1507,101 @@ if (c1 lor c2 lor c3) land 0xc0 <> 0x80 then fail () else let v = c lsl 18 + c1 lsl 12 + c2 lsl 6 + c3 - 0x03c82080 in if v < 0x10000 || v > 0x10ffff then fail () else - cont s' j s (i + 4) l v + 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 = - if v < 0x10000 then begin - set_2 s' j v; - scan s' (j + 2) s i l - end else begin - let v = v - 0x10000 in - set_2 s' j (v lsr 10 + 0xD800); - set_2 s' (j + 2) (v land 0x3FF + 0xDC00); - scan s' (j + 4) s i l - end + 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 = @@ -832,6 +1641,66 @@ (****) +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 Modified: trunk/src/unicode.mli =================================================================== --- trunk/src/unicode.mli 2009-06-15 14:26:01 UTC (rev 354) +++ trunk/src/unicode.mli 2009-06-17 14:42:07 UTC (rev 355) @@ -20,6 +20,14 @@ 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 Modified: trunk/src/unicode_tables.ml =================================================================== --- trunk/src/unicode_tables.ml 2009-06-15 14:26:01 UTC (rev 354) +++ trunk/src/unicode_tables.ml 2009-06-17 14:42:07 UTC (rev 355) @@ -1,11 +1,12 @@ (*-*-coding: utf-8;-*-*) let ascii_lower = - "\000\001\002\003\004\005\006\007\008\t\n\011\012\013\014\015\016\017\018\019\020\021\022\023\024\025\026\027\028\029\030\031 !\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\127" + "\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ÌŒ\003oÌ! ¨\005ǭ\004Ê’ÌŒ\003jÌŒ\002dz\003gÌ\003nÌ€\005aÌŠÌ\004æÌ\004øÌ\003aÌ\003aÌ‘\003eÌ\003eÌ‘\003iÌ\003iÌ‘\003oÌ\003oÌ‘\003rÌ\003rÌ‘\003uÌ\003uÌ‘\003ș\003ț\003hÌŒ\003ȧ\003ȩ\005ȫ\005ȭ\003ȯ\005ȱ\003yÌ„\002Ì€\002Ì\002Ì“\004̈Ì\002ʹ\001;\004¨Ì\004αÌ\002·\004εÌ\004ηÌ\004ιÌ\004οÌ\004Ï…Ì\004ωÌ\006ϊÌ\002α\002β\002γ\002δ\002ε\002ζ\002η\002θ\002ι\002κ\002λ\002μ\002ν\002ξ\002ο\002Ï€\002Ï\002σ\002Ï„\002Ï…\002φ\002χ\002ψ\002ω\004ϊ\004ϋ\006ϋÌ\004Ï’Ì\004ϔ\002Ï£\002Ï¥\002ϧ\002Ï©\002Ï«\002Ï­\002ϯ\004ѐ\004ё\002Ñ’\004гÌ\002Ñ”\002Ñ•\002Ñ–\004ї\002ј\002Ñ™\002Ñš\002Ñ›\004кÌ\004ѝ\004ў\002ÑŸ\002а\002б\002в\002г\002д\002е\002ж\002з\002и\004й\002к\002л\002м\002н\002о\002п\002Ñ€\002Ñ\002Ñ‚\002у\002Ñ„\002Ñ…\002ц\002ч\002ш\002щ\002ÑŠ\002Ñ‹\002ÑŒ\002Ñ\002ÑŽ\002Ñ\002Ñ¡\002Ñ£\002Ñ¥\002ѧ\002Ñ©\002Ñ«\002Ñ­\002ѯ\002ѱ\002ѳ\002ѵ\004ѵÌ\002ѹ\002Ñ»\002ѽ\002Ñ¿\002Ò\002Ò! ‘\002Ò“\002Ò•\002Ò—\002Ò™\002Ò›\002Ò\002ÒŸ\002Ò¡\002Ò£\002Ò¥\! 002Ò§\00 2Ò©\002Ò«\002Ò­\002Ò¯\002Ò±\002Ò³\002Òµ\002Ò·\002Ò¹\002Ò»\002Ò½\002Ò¿\004ӂ\002Ó„\002Óˆ\002ÓŒ\004ӑ\004ӓ\002Ó•\004ӗ\002Ó™\004ӛ\004ӝ\004ӟ\002Ó¡\004ӣ\004ӥ\004ӧ\002Ó©\004ӫ\004Ñ̈\004ӯ\004ӱ\004ӳ\004ӵ\004ӹ\002Õ¡\002Õ¢\002Õ£\002Õ¤\002Õ¥\002Õ¦\002Õ§\002Õ¨\002Õ©\002Õª\002Õ«\002Õ¬\002Õ­\002Õ®\002Õ¯\002Õ°\002Õ±\002Õ²\002Õ³\002Õ´\002Õµ\002Õ¶\002Õ·\002Õ¸\002Õ¹\002Õº\002Õ»\002Õ¼\002Õ½\002Õ¾\002Õ¿\002Ö€\002Ö\002Ö‚\002Öƒ\002Ö„\002Ö…\002Ö†\004آ\004أ\004ÙˆÙ”\004إ\004ÙŠÙ”\004Û•Ù”\004ÛÙ”\004Û’Ù”\006ऩ\006ऱ\006ऴ\006क़\006ख़\006ग़\006ज़\006ड़\006ढ़\006फ़\006य़\006ো\006ৌ\006ড়\006ঢ়\006য়\006ਲ਼\006ਸ਼\006ਖ਼\006ਗ਼\006ਜ਼\006ਫ਼\006ୈ\006ୋ\006ୌ\006ଡ଼\006ଢ଼\006ஔ\006ொ\006ோ\006ௌ\006ై\006ೀ\006ೇ\006ೈ\006ೊ\009ೋ\006ൊ\006ോ\006ൌ\006ේ\006à·™à·\009à·™à·à·Š\006ෞ\006! གྷ\006ཌྷ\006དྷ\006བྷ\006ཛྷ\006ཀྵ\006ཱི\006ཱུ\006ྲྀ\006ླྀ\006ཱྀ\006ྒྷ\006ྜྷ\006ྡྷ\006ྦྷ\006ྫྷ\006à¾à¾µ\006ဦ\003áƒ\003ბ\003გ\003დ\003ე\003ვ\003ზ\003თ\003ი\003კ\003ლ\003მ\003ნ\003áƒ\003პ\003ჟ\003რ\003ს\003ტ\003უ\003ფ\003ქ\003ღ\003ყ\003შ\003ჩ\003ც\003ძ\003წ\003ჭ\003ხ\003ჯ\003ჰ\003ჱ\003ჲ\003ჳ\003ჴ\003ჵ\003aÌ¥\003ḃ\003bÌ£\003ḇ\005çÌ\003ḋ\003dÌ£\003ḏ\003ḑ\003dÌ­\005eÌ„Ì€\005eÌ„Ì\003eÌ­\003eÌ°\005ḝ\003ḟ\003gÌ„\003ḣ\003hÌ£\003ḧ\003ḩ\003hÌ®\003iÌ°\005ïÌ\003kÌ\003kÌ£\003ḵ\003lÌ£\005ḹ\003ḻ\003lÌ­\003mÌ\003ṁ\003mÌ£\003ṅ\003nÌ£\003ṉ\003nÌ­\005õÌ\005ṏ\005oÌ„Ì€\005oÌ„Ì\003pÌ\003ṗ\003ṙ\003rÌ£\005ṝ\003ṟ\003ṡ\003sÌ£\005sÌ̇\005ṧ\005ṩ\003ṫ\003tÌ£\003ṯ\003tÌ­\003ṳ\003uÌ°\003uÌ­\005ũÌ\005ṻ\003ṽ\003vÌ£\003wÌ€\003wÌ\003ẅ\003ẇ\003wÌ£\003ẋ\003ẍ\003ẏ\003zÌ‚\00! 3zÌ£\003ẕ\003ẖ\003ẗ\003wÌŠ\003yÌŠ\004ẛ\003aÌ£\003ả\! 005aÌ‚Ì \005aÌ‚Ì€\005ẩ\005ẫ\005ậ\005ăÌ\005ằ\005ẳ\005ẵ\005ặ\003eÌ£\003ẻ\003ẽ\005eÌ‚Ì\005eÌ‚Ì€\005ể\005ễ\005ệ\003ỉ\003iÌ£\003oÌ£\003ỏ\005oÌ‚Ì\005oÌ‚Ì€\005ổ\005ỗ\005ộ\005oÌ›Ì\005ờ\005ở\005ỡ\005ợ\003uÌ£\003ủ\005uÌ›Ì\005ừ\005ử\005ữ\005ự\003yÌ€\003yÌ£\003ỷ\003ỹ\004ἀ\004ἁ\006ἂ\006ἃ\006ἀÌ\006ἁÌ\006ἆ\006ἇ\004ἐ\004ἑ\006ἒ\006ἓ\006ἐÌ\006ἑÌ\004ἠ\004ἡ\006ἢ\006ἣ\006ἠÌ\006ἡÌ\006ἦ\006ἧ\004ἰ\004ἱ\006ἲ\006ἳ\006ἰÌ\006ἱÌ\006ἶ\006ἷ\004ὀ\004ὁ\006ὂ\006ὃ\006ὀÌ\006ὁÌ\004Ï…Ì“\004Ï…Ì”\006Ï…Ì“Ì€\006ὓ\006Ï…Ì“Ì\006Ï…Ì”Ì\006Ï…Ì“Í‚\006ὗ\004ὠ\004ὡ\006ὢ\006ὣ\006ὠÌ\006ὡÌ\006ὦ\006ὧ\004ὰ\004ὲ\004ὴ\004ὶ\004ὸ\004Ï…Ì€\004ὼ\006ᾀ\006ᾁ\008ᾂ\008ᾃ\008ἀÌÍ…\008ἁÌÍ…\008ᾆ\008ἁÍ! ‚Í…\006ᾐ\006ᾑ\008ᾒ\008ᾓ\008ἠÌÍ…\008ἡÌÍ…\008ᾖ\008ᾗ\006ᾠ\006ᾡ\008ᾢ\008ᾣ\008ὠÌÍ…\008ὡÌÍ…\008ᾦ\008ᾧ\004ᾰ\004ᾱ\006ᾲ\004ᾳ\006αÌÍ…\004ᾶ\006ᾷ\004῁\006ῂ\004ῃ\006ηÌÍ…\004ῆ\006ῇ\005῍\005᾿Ì\005῏\004ῐ\004ῑ\006ῒ\004ῖ\006ῗ\005῝\005῾Ì\005῟\004ῠ\004Ï…Ì„\006ῢ\004ÏÌ“\004ÏÌ”\004Ï…Í‚\006ῧ\004῭\001`\006ῲ\004ῳ\006ωÌÍ…\004ῶ\006ῷ\002´\000\003â…°\003â…±\003â…²\003â…³\003â…´\003â…µ\003â…¶\003â…·\003â…¸\003â…¹\003â…º\003â…»\003â…¼\003â…½\003â…¾\003â…¿\003â“\003â“‘\003â“’\003â““\003â“”\003â“•\003â“–\003â“—\003ⓘ\003â“™\003â“š\003â“›\003â“œ\003â“\003â“ž\003â“Ÿ\003â“ \003â“¡\003â“¢\003â“£\003ⓤ\003â“¥\003ⓦ\003ⓧ\003ⓨ\003â“©\006ã‹ã‚™\006ãã‚™\006ãã‚™\006ã‘ã‚™\006ã“ã‚™\006ã•ã‚™\006ã—ã‚™\006ã™ã‚™\006ã›ã‚™\006ãã‚™\006ãŸã‚™\006ã¡ã‚™\006ã¤ã‚™\006ã¦ã‚™\006ã¨ã‚™\006ã¯ã‚™\006! ã¯ã‚š\006ã²ã‚™\006ã²ã‚š\006ãµã‚™\006ãµã‚š\006ã¸ã‚™\006ã! ¸ã‚š\006 ã»ã‚™\006ã»ã‚š\006ã†ã‚™\006ã‚ã‚™\006ã‚«ã‚™\006ã‚­ã‚™\006グ\006ゲ\006ゴ\006ザ\006ã‚·ã‚™\006ズ\006ゼ\006ゾ\006ã‚¿ã‚™\006ãƒã‚™\006ヅ\006デ\006ド\006ãƒã‚™\006ãƒã‚š\006ビ\006ピ\006ブ\006プ\006ベ\006ペ\006ボ\006ポ\006ヴ\006ヷ\006ヸ\006ヹ\006ヺ\006ヾ\004×™Ö´\004ײַ\004ש×\004שׂ\006שּ×\006שּׂ\004×Ö·\004×Ö¸\004×Ö¼\004בּ\004×’Ö¼\004דּ\004×”Ö¼\004וּ\004×–Ö¼\004טּ\004×™Ö¼\004ךּ\004×›Ö¼\004לּ\004מּ\004× Ö¼\004סּ\004×£Ö¼\004פּ\004צּ\004קּ\004רּ\004שּ\004תּ\004וֹ\004בֿ\004×›Ö¿\004פֿ\003ï½\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" + "\003aÌ€\003aÌ\003aÌ‚\003ã\003ä\003aÌŠ\002æ\003ç\003eÌ€\003eÌ\003eÌ‚\003ë\003iÌ€\003iÌ\003iÌ‚\003ï\002ð\003ñ\003oÌ€\003oÌ\003oÌ‚\003õ\003ö\002ø\003uÌ€\003uÌ\003uÌ‚\003ü\003yÌ\002þ\003ÿ\003aÌ„\003ă\003ą\003cÌ\003cÌ‚\003ċ\003cÌŒ\003dÌŒ\002Ä‘\003eÌ„\003ĕ\003ė\003ę\003eÌŒ\003gÌ‚\003ğ\003ġ\003ģ\003hÌ‚\002ħ\003ĩ\003iÌ„\003ĭ\003į\003i̇\002ij\003jÌ‚\003ķ\003lÌ\003ļ\003lÌŒ\002Å€\002Å‚\003nÌ\003ņ\003nÌŒ\002Å‹\003oÌ„\003ŏ\003oÌ‹\002Å“\003rÌ\003ŗ\003rÌŒ\003sÌ\003sÌ‚\003ş\003sÌŒ\003ţ\003tÌŒ\002ŧ\003ũ\003uÌ„\003ŭ\003uÌŠ\003uÌ‹\003ų\003wÌ‚\003yÌ‚\003zÌ\003ż\003zÌŒ\002É“\002ƃ\002Æ…\002É”\002ƈ\002É–\002É—\002ÆŒ\002Ç\002É™\002É›\002Æ’\002É \002É£\002É©\002ɨ\002Æ™\002ɯ\002ɲ\002ɵ\003oÌ›\002Æ£\002Æ¥\002ƨ\002ʃ\002Æ­\002ʈ\003uÌ›\002ÊŠ\002Ê‹\002Æ´\002ƶ\002Ê’\002ƹ\002ƽ\002dž\002lj\002ÇŒ\003aÌŒ\003iÌŒ\003oÌŒ\003uÌŒ\005ǖ\005üÌ\005ǚ\005ǜ\005ǟ\005ǡ\004ǣ\002Ç¥\003gÌŒ\003kÌŒ\003oÌ! ¨\005ǭ\004Ê’ÌŒ\003jÌŒ\002dz\003gÌ\003nÌ€\005aÌŠÌ\004æÌ\004øÌ\003aÌ\003aÌ‘\003eÌ\003eÌ‘\003iÌ\003iÌ‘\003oÌ\003oÌ‘\003rÌ\003rÌ‘\003uÌ\003uÌ‘\003ș\003ț\003hÌŒ\003ȧ\003ȩ\005ȫ\005ȭ\003ȯ\005ȱ\003yÌ„\002Ì€\002Ì\002Ì“\004̈Ì\002ʹ\001;\004¨Ì\004αÌ\002·\004εÌ\004ηÌ\004ιÌ\004οÌ\004Ï…Ì\004ωÌ\006ϊÌ\002α\002β\002γ\002δ\002ε\002ζ\002η\002θ\002ι\002κ\002λ\002μ\002ν\002ξ\002ο\002Ï€\002Ï\002σ\002Ï„\002Ï…\002φ\002χ\002ψ\002ω\004ϊ\004ϋ\006ϋÌ\004Ï’Ì\004ϔ\002Ï£\002Ï¥\002ϧ\002Ï©\002Ï«\002Ï­\002ϯ\004ѐ\004ё\002Ñ’\004гÌ\002Ñ”\002Ñ•\002Ñ–\004ї\002ј\002Ñ™\002Ñš\002Ñ›\004кÌ\004ѝ\004ў\002ÑŸ\002а\002б\002в\002г\002д\002е\002ж\002з\002и\004й\002к\002л\002м\002н\002о\002п\002Ñ€\002Ñ\002Ñ‚\002у\002Ñ„\002Ñ…\002ц\002ч\002ш\002щ\002ÑŠ\002Ñ‹\002ÑŒ\002Ñ\002ÑŽ\002Ñ\002Ñ¡\002Ñ£\002Ñ¥\002ѧ\002Ñ©\002Ñ«\002Ñ­\002ѯ\002ѱ\002ѳ\002ѵ\004ѵÌ\002ѹ\002Ñ»\002ѽ\002Ñ¿\002Ò\002Ò! ‘\002Ò“\002Ò•\002Ò—\002Ò™\002Ò›\002Ò\002ÒŸ\002Ò¡\002Ò£\002Ò¥\! 002Ò§\00 2Ò©\002Ò«\002Ò­\002Ò¯\002Ò±\002Ò³\002Òµ\002Ò·\002Ò¹\002Ò»\002Ò½\002Ò¿\004ӂ\002Ó„\002Óˆ\002ÓŒ\004ӑ\004ӓ\002Ó•\004ӗ\002Ó™\004ӛ\004ӝ\004ӟ\002Ó¡\004ӣ\004ӥ\004ӧ\002Ó©\004ӫ\004Ñ̈\004ӯ\004ӱ\004ӳ\004ӵ\004ӹ\002Õ¡\002Õ¢\002Õ£\002Õ¤\002Õ¥\002Õ¦\002Õ§\002Õ¨\002Õ©\002Õª\002Õ«\002Õ¬\002Õ­\002Õ®\002Õ¯\002Õ°\002Õ±\002Õ²\002Õ³\002Õ´\002Õµ\002Õ¶\002Õ·\002Õ¸\002Õ¹\002Õº\002Õ»\002Õ¼\002Õ½\002Õ¾\002Õ¿\002Ö€\002Ö\002Ö‚\002Öƒ\002Ö„\002Ö…\002Ö†\004آ\004أ\004ÙˆÙ”\004إ\004ÙŠÙ”\004Û•Ù”\004ÛÙ”\004Û’Ù”\006ऩ\006ऱ\006ऴ\006क़\006ख़\006ग़\006ज़\006ड़\006ढ़\006फ़\006य़\006ো\006ৌ\006ড়\006ঢ়\006য়\006ਲ਼\006ਸ਼\006ਖ਼\006ਗ਼\006ਜ਼\006ਫ਼\006ୈ\006ୋ\006ୌ\006ଡ଼\006ଢ଼\006ஔ\006ொ\006ோ\006ௌ\006ై\006ೀ\006ೇ\006ೈ\006ೊ\009ೋ\006ൊ\006ോ\006ൌ\006ේ\006à·™à·\009à·™à·à·Š\006ෞ\006! གྷ\006ཌྷ\006དྷ\006བྷ\006ཛྷ\006ཀྵ\006ཱི\006ཱུ\006ྲྀ\006ླྀ\006ཱྀ\006ྒྷ\006ྜྷ\006ྡྷ\006ྦྷ\006ྫྷ\006à¾à¾µ\006ဦ\003áƒ\003ბ\003გ\003დ\003ე\003ვ\003ზ\003თ\003ი\003კ\003ლ\003მ\003ნ\003áƒ\003პ\003ჟ\003რ\003ს\003ტ\003უ\003ფ\003ქ\003ღ\003ყ\003შ\003ჩ\003ც\003ძ\003წ\003ჭ\003ხ\003ჯ\003ჰ\003ჱ\003ჲ\003ჳ\003ჴ\003ჵ\003aÌ¥\003ḃ\003bÌ£\003ḇ\005çÌ\003ḋ\003dÌ£\003ḏ\003ḑ\003dÌ­\005eÌ„Ì€\005eÌ„Ì\003eÌ­\003eÌ°\005ḝ\003ḟ\003gÌ„\003ḣ\003hÌ£\003ḧ\003ḩ\003hÌ®\003iÌ°\005ïÌ\003kÌ\003kÌ£\003ḵ\003lÌ£\005ḹ\003ḻ\003lÌ­\003mÌ\003ṁ\003mÌ£\003ṅ\003nÌ£\003ṉ\003nÌ­\005õÌ\005ṏ\005oÌ„Ì€\005oÌ„Ì\003pÌ\003ṗ\003ṙ\003rÌ£\005ṝ\003ṟ\003ṡ\003sÌ£\005sÌ̇\005ṧ\005ṩ\003ṫ\003tÌ£\003ṯ\003tÌ­\003ṳ\003uÌ°\003uÌ­\005ũÌ\005ṻ\003ṽ\003vÌ£\003wÌ€\003wÌ\003ẅ\003ẇ\003wÌ£\003ẋ\003ẍ\003ẏ\003zÌ‚\00! 3zÌ£\003ẕ\003ẖ\003ẗ\003wÌŠ\003yÌŠ\004ẛ\003aÌ£\003ả\! 005aÌ‚Ì \005aÌ‚Ì€\005ẩ\005ẫ\005ậ\005ăÌ\005ằ\005ẳ\005ẵ\005ặ\003eÌ£\003ẻ\003ẽ\005eÌ‚Ì\005eÌ‚Ì€\005ể\005ễ\005ệ\003ỉ\003iÌ£\003oÌ£\003ỏ\005oÌ‚Ì\005oÌ‚Ì€\005ổ\005ỗ\005ộ\005oÌ›Ì\005ờ\005ở\005ỡ\005ợ\003uÌ£\003ủ\005uÌ›Ì\005ừ\005ử\005ữ\005ự\003yÌ€\003yÌ£\003ỷ\003ỹ\004ἀ\004ἁ\006ἂ\006ἃ\006ἀÌ\006ἁÌ\006ἆ\006ἇ\004ἐ\004ἑ\006ἒ\006ἓ\006ἐÌ\006ἑÌ\004ἠ\004ἡ\006ἢ\006ἣ\006ἠÌ\006ἡÌ\006ἦ\006ἧ\004ἰ\004ἱ\006ἲ\006ἳ\006ἰÌ\006ἱÌ\006ἶ\006ἷ\004ὀ\004ὁ\006ὂ\006ὃ\006ὀÌ\006ὁÌ\004Ï…Ì“\004Ï…Ì”\006Ï…Ì“Ì€\006ὓ\006Ï…Ì“Ì\006Ï…Ì”Ì\006Ï…Ì“Í‚\006ὗ\004ὠ\004ὡ\006ὢ\006ὣ\006ὠÌ\006ὡÌ\006ὦ\006ὧ\004ὰ\004ὲ\004ὴ\004ὶ\004ὸ\004Ï…Ì€\004ὼ\006ᾀ\006ᾁ\008ᾂ\008ᾃ\008ἀÌÍ…\008ἁÌÍ…\008ᾆ\008ἁÍ! ‚Í…\006ᾐ\006ᾑ\008ᾒ\008ᾓ\008ἠÌÍ…\008ἡÌÍ…\008ᾖ\008ᾗ\006ᾠ\006ᾡ\008ᾢ\008ᾣ\008ὠÌÍ…\008ὡÌÍ…\008ᾦ\008ᾧ\004ᾰ\004ᾱ\006ᾲ\004ᾳ\006αÌÍ…\004ᾶ\006ᾷ\004῁\006ῂ\004ῃ\006ηÌÍ…\004ῆ\006ῇ\005῍\005᾿Ì\005῏\004ῐ\004ῑ\006ῒ\004ῖ\006ῗ\005῝\005῾Ì\005῟\004ῠ\004Ï…Ì„\006ῢ\004ÏÌ“\004ÏÌ”\004Ï…Í‚\006ῧ\004῭\001`\006ῲ\004ῳ\006ωÌÍ…\004ῶ\006ῷ\002´\000\003â…°\003â…±\003â…²\003â…³\003â…´\003â…µ\003â…¶\003â…·\003â…¸\003â…¹\003â…º\003â…»\003â…¼\003â…½\003â…¾\003â…¿\003â“\003â“‘\003â“’\003â““\003â“”\003â“•\003â“–\003â“—\003ⓘ\003â“™\003â“š\003â“›\003â“œ\003â“\003â“ž\003â“Ÿ\003â“ \003â“¡\003â“¢\003â“£\003ⓤ\003â“¥\003ⓦ\003ⓧ\003ⓨ\003â“©\006ã‹ã‚™\006ãã‚™\006ãã‚™\006ã‘ã‚™\006ã“ã‚™\006ã•ã‚™\006ã—ã‚™\006ã™ã‚™\006ã›ã‚™\006ãã‚™\006ãŸã‚™\006ã¡ã‚™\006ã¤ã‚™\006ã¦ã‚™\006ã¨ã‚™\006ã¯ã‚™\006! ã¯ã‚š\006ã²ã‚™\006ã²ã‚š\006ãµã‚™\006ãµã‚š\006ã¸ã‚™\006ã! ¸ã‚š\006 ã»ã‚™\006ã»ã‚š\006ã†ã‚™\006ã‚ã‚™\006ã‚«ã‚™\006ã‚­ã‚™\006グ\006ゲ\006ゴ\006ザ\006ã‚·ã‚™\006ズ\006ゼ\006ゾ\006ã‚¿ã‚™\006ãƒã‚™\006ヅ\006デ\006ド\006ãƒã‚™\006ãƒã‚š\006ビ\006ピ\006ブ\006プ\006ベ\006ペ\006ボ\006ポ\006ヴ\006ヷ\006ヸ\006ヹ\006ヺ\006ヾ\001\001\001\001\001\001\001\001\001 \001 +\001 \001 \001 \001\001\001\001\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\00! 0\000\00 0\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001! \001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\052! \053\000\000\000\000\000\000\000\000\000\000\000\000\000\054\0! 55\000\0 00\000" + "\000\000\000\002\003\004\005\006\007\000\000\000\000\008\009\010\011\012\013\014\015\016\000\000\017\000\000\018\000\000\000\000\000\000\000\000\019\020\000\021\022\023\000\000\000\024\025\026\000\027\000\028\000\029\000\030\000\000\000\000\000\031\032\000\033\000\034\035\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\036\037\038\039\040\041\042\043\044\045\000\000\000\046\000\000\000\000\000\000\000\000\000\000\000\000\047\048\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\049\050\051\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\! 000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\! 000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\00! 0\000\00 0\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001! \001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\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\0! 56\000\0 00\000" let norm_second_high = - "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\000\002\002\002\002\002\002\002\000\002\002\002\002\002\002\000\002\002\002\002\002\002\002\002\002\000\002\002\002\002\002\002\000\000\002\002\002\002\002\000\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\000\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\000\002\002\002\002\002\002\002\002\002\000\002\000\002\002\! 002\002\000\002\002\002\002\002\002\002\000\002\000\002\002\002\002\002\002\000\003\000\003\003\003\003\003\003\003\000\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\000\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\002\003\003\003\003\003\003\000\000\003\003\000\003\000\003\003\000\003\003\003\000\000\003\003\003\003\000\003\003\000\003\003\003\000\000\000\003\003\000\003\003\003\003\000\003\000\000\003\000\003\000\000\003\000\003\003\003\003\003\003\000\003\000\003\003\000\000\000\003\000\000\000\000\000\000\000\003\003\000\003\003\000\003\003\000\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\000\004\004\004\004\004\004\004\000\004\004\004\004\004\004\004\004\004\004\004\004\004\000\004\004\000\000\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\000\000\004\004\000\000\000\000\000\000\004\004\004\004\004\004\004\! 004\004\004\004\004\004\004\000\000\000\000\000\000\000\000\00! 0\000\00 0\000\004\004\000\004\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\004\004\004\004\004\004\000\004\000\004\004\004\004\004\004\004\004\005\005\005\005\005\005\005\005\005\005\005\005\000\005\005\005\005\005\005\005\005\005\004\004\004\004\005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\000\000\000\000\000\000\000\005\005\004\004\004\000\000\000\000\005\005\000\000\000\000\000\000\000\000\000\000\000\000\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\006\006\006\000\000\000\000\000\000! \000\000\000\005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\005\000\005\000\000\000\005\000\000\000\000\005\005\005\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\006\006\000\006\000\006\000\006\000\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\000\006\006\006\000\000\000\006\000\000\000\006\000\000\000\000\006\006\006\006\006\000\006\006\006\000\006\006\006\006\006\006\006\000\006\006\006\006\006\006\006\000\006\006\006\006\006\006\006\006\006\006\006\006\000\000\006\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \000\000\000\000\006\006\006\006\006\006\007\007\007\007\007\0! 07\007\0 07\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\007\007\007\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\000\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\000\000\000\000\000\000\000\007\000\000\007\00! 0\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\007\007\007\007\007\007\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\007\000\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\000\000\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\008\008\000\000\008\000\000\000\000\000\000\000\000\000\000\000\000\000\00! 0\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\! 000\000\ 000\000\000\000\000\000\000\000\000\000\008\000\000\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0! 00\000\000\000\000\000\000\000\000\000\000\008\000\000\000\000\000\000\008\008\000\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\008\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\000\000\000\000\000\000\000\008\000\000\000\000\008\000\000\000\000\008\000\000\000\000\008\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\0! 00\000\000\000\000\000\000\008\000\008\008\000\009\000\000\000! \000\000 \000\000\000\009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\009\000\000\000\000\000\000\000\000\000\009\000\000\000\000\009\000\000\000\000\009\000\000\000\000\009\000\000\000\000\000\000\000\000\000\000\000\000\009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\! 000\000\000\000\000\000\000\000\000\000\000\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\000\011\000\000\000\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\012\012\! 012\012\012\012\012\012\012\012\012\012\012\012\012\012\000\00! 0\000\00 0\000\000\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\000\000\012\012\012\012\012\012\000\000\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\013\013\000\000\012\012\012\012\013\013\000\000\013\013\013\013\013\013\013\013\000\013\000\013\000\013\000\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\004\013\004\013\004\013\004\013\004\013\004\013\004\000\000\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\014\014\014\014\013\013\013\013\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\000\014\014\014\014\013\004\014\000\005\000\000\014\014\014\014\000\014\014\013\004\013\004\014\014\014\014\014\014\014\004\000\000\014\014\014\014\013\004\000\014\014\014\014\014\015\005\015\015\015\015\014\014\013\004\015\015\004\015\000\000\015\015\015! \000\015\015\013\004\013\004\015\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\015\015\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\015\015\015\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\015\015\015\015\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \000\000\000\000\000\000\000\000\000\000\015\015\015\015\015\0! 15\015\0 15\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\000\015\000\015\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\000\016\000\016\000\016\000\000\000\000\000\000\016\016\000\016\016\000\016\016\000\016\016\000\016\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\000\017\000\017\000\017\000\000\000\000\000\000\017\017\000\017\017\000\017\017\000\017\017\000\017\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\01! 7\000\000\017\017\017\017\000\000\000\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\000\017\000\000\000\000\000\000\000\000\000\000\017\017\017\017\017\017\017\017\017\017\017\017\017\000\017\017\017\017\017\000\017\000\017\017\000\017\018\000\018\018\018\018\018\018\018\018\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\018\018\018\018\018\018\018\018\018\01! 8\018\018\018\018\018\018\018\018\018\018\018\018\018\018\018\! 000\000\ 000\000\000" + "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\000\002\002\002\002\002\002\002\000\002\002\002\002\002\002\000\002\002\002\002\002\002\002\002\002\000\002\002\002\002\002\002\000\000\002\002\002\002\002\000\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\000\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\000\002\002\002\002\002\002\002\002\002\000\002\000\002\002\! 002\002\000\002\002\002\002\002\002\002\000\002\000\002\002\002\002\002\002\000\003\000\003\003\003\003\003\003\003\000\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\000\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\002\003\003\003\003\003\003\000\000\003\003\000\003\000\003\003\000\003\003\003\000\000\003\003\003\003\000\003\003\000\003\003\003\000\000\000\003\003\000\003\003\003\003\000\003\000\000\003\000\003\000\000\003\000\003\003\003\003\003\003\000\003\000\003\003\000\000\000\003\000\000\000\000\000\000\000\003\003\000\003\003\000\003\003\000\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\000\004\004\004\004\004\004\004\000\004\004\004\004\004\004\004\004\004\004\004\004\004\000\004\004\000\000\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\000\000\004\004\000\000\000\000\000\000\004\004\004\004\004\004\004\! 004\004\004\004\004\004\004\000\000\000\000\000\000\000\000\00! 0\000\00 0\000\004\004\000\004\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\004\004\004\004\004\004\000\004\000\004\004\004\004\004\004\004\004\005\005\005\005\005\005\005\005\005\005\005\005\000\005\005\005\005\005\005\005\005\005\004\004\004\004\005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\000\000\000\000\000\000\000\005\005\004\004\004\000\000\000\000\005\005\000\000\000\000\000\000\000\000\000\000\000\000\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\006\006\006\000\000\000\000\000\000! \000\000\000\005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\005\000\005\000\000\000\005\000\000\000\000\005\005\005\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\006\006\000\006\000\006\000\006\000\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\000\006\006\006\000\000\000\006\000\000\000\006\000\000\000\000\006\006\006\006\006\000\006\006\006\000\006\006\006\006\006\006\006\000\006\006\006\006\006\006\006\000\006\006\006\006\006\006\006\006\006\006\006\006\000\000\006\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \000\000\000\000\006\006\006\006\006\006\007\007\007\007\007\0! 07\007\0 07\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\007\007\007\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\000\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\000\000\000\000\000\000\000\007\000\000\007\00! 0\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\007\007\007\007\007\007\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\007\000\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\000\000\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\008\008\000\000\008\000\000\000\000\000\000\000\000\000\000\000\000\000\00! 0\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\! 000\000\ 000\000\000\000\000\000\000\000\000\000\008\000\000\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0! 00\000\000\000\000\000\000\000\000\000\000\008\000\000\000\000\000\000\008\008\000\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\008\008\008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\000\000\000\000\000\000\000\008\000\000\000\000\008\000\000\000\000\008\000\000\000\000\008\000\000\000\000\000\000\000\000\000\000\000\000\008\000\000\0! 00\000\000\000\000\000\000\008\000\008\008\000\009\000\000\000! \000\000 \000\000\000\009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\009\000\000\000\000\000\000\000\000\000\009\000\000\000\000\009\000\000\000\000\009\000\000\000\000\009\000\000\000\000\000\000\000\000\000\000\000\000\009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\! 000\000\000\000\000\000\000\000\000\000\000\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\000\011\000\000\000\000\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\011\012\012\! 012\012\012\012\012\012\012\012\012\012\012\012\012\012\000\00! 0\000\00 0\000\000\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\000\000\012\012\012\012\012\012\000\000\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\012\013\013\000\000\012\012\012\012\013\013\000\000\013\013\013\013\013\013\013\013\000\013\000\013\000\013\000\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\004\013\004\013\004\013\004\013\004\013\004\013\004\000\000\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\013\014\014\014\014\013\013\013\013\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\014\000\014\014\014\014\013\004\014\000\005\000\000\014\014\014\014\000\014\014\013\004\013\004\014\014\014\014\014\014\014\004\000\000\014\014\014\014\013\004\000\014\014\014\014\014\015\005\015\015\015\015\014\014\013\004\015\015\004\015\000\000\015\015\015! \000\015\015\013\004\013\004\015\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\015\015\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\015\015\015\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\015\015\015\015\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \000\000\000\000\000\000\000\000\000\000\015\015\015\015\015\0! 15\015\0 15\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\000\015\000\015\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\000\016\000\016\000\016\000\000\000\000\000\000\016\016\000\016\016\000\016\016\000\016\016\000\016\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\000\017\000\017\000\017\000\000\000\000\000\000\017\017\000\017\017\000\017\017\000\017\017\000\017\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\01! 7\000\000\017\017\017\017\000\000\000\017\000\000\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\00! 0\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\00! 0\000\00 0\000\172\175\000\178\181\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\186\000\000\000\000\000\000\000\000\000\189\000\000\000\000\000\000\191\196\201\204\209\214\000\219\000\224\229\234\241\244\247\250\253\000\003\006\009\012\015\018\021\024\027\030\033\000\036\039\042\045\048\051\054\057\062\196\204\209\214\067\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\036\000\000\000\000\000\000\000\057\062\219\224\229\000\000\000\000\074\079\000\000\000\000\000\000\000\000\000\000\000\000\000\084\000\087\000\090\000\093\000\096\000\099\000\102\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\105\110\115\118\123\126\129\132\137\140\143\146\149\154\159\164\167\170\173\176\179\182\185\188\191\194\199\202\205\208\211\214\217\220\223\226\229\232\235\238\241\244\247\250\253\000\003\006\000\000\000\000\000\000! \000\000\000\194\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\105\110\000\118\000\000\000\132\000\000\000\000\149\154\159\000\009\000\012\000\015\000\018\000\021\000\024\000\027\000\030\000\033\000\036\000\039\000\042\042\047\000\050\000\053\000\056\000\059\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\062\000\065\000\068\000\071\000\074\000\077\000\080\000\083\000\086\000\089\000\092\000\095\000\098\000\101\000\104\000\107\000\110\000\113\000\116\000\119\000\122\000\125\000\128\000\131\000\000\134\134\139\000\000\000\142\000\000\000\145\000\000\000\000\148\148\153\153\158\000\161\161\166\000\169\169\174\174\179\179\184\000\187\187\192\192\197\197\202\000\205\205\210\210\215\215\220\220\225\225\230\230\000\000\235\235\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \000\000\000\000\240\243\246\249\252\255\002\005\008\011\014\0! 17\020\0 23\026\029\032\035\038\041\044\047\050\053\056\059\062\065\068\071\074\077\080\083\086\089\092\095\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\098\103\108\113\118\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\123\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\133\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\138\000\000\000\000\000\000\000\145\000\000\152\00! 0\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\159\166\173\180\187\194\201\208\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\215\222\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\229\236\000\243\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\250\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\015\022\000\000\029\000\000\000\000\000\000\000\000\000\000\000\000\000\00! 0\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\! 000\000\ 000\000\000\000\000\000\000\000\000\000\036\000\000\043\050\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\057\064\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\071\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\078\085\092\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\099\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0! 00\000\000\000\000\000\000\000\000\000\000\106\000\000\000\000\000\000\113\120\000\127\134\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\144\151\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\165\000\172\179\189\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\000\000\000\000\000\000\000\000\000\203\000\000\000\000\210\000\000\000\000\217\000\000\000\000\224\000\000\000\000\000\000\000\000\000\000\000\000\231\000\000\0! 00\000\000\000\000\000\000\238\000\245\252\000\003\000\000\000! \000\000 \000\000\000\010\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\000\000\000\000\000\000\000\000\000\024\000\000\000\000\031\000\000\000\000\038\000\000\000\000\045\000\000\000\000\000\000\000\000\000\000\000\000\052\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\059\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\066\070\074\078\082\086\090\094\098\102\106\110\114\118\122\126\130\134\138\142\146\150\154\158\162\166\170\174\178\182\186\190\194\198\202\206\210\214\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\! 000\000\000\000\000\000\000\000\000\000\000\218\218\222\222\226\226\230\230\234\234\240\240\244\244\248\248\252\252\000\000\004\004\010\010\016\016\020\020\024\024\030\030\034\034\038\038\042\042\046\046\050\050\054\054\058\058\062\062\068\068\072\072\076\076\080\080\084\084\090\090\094\094\098\098\102\102\106\106\110\110\114\114\118\118\122\122\126\126\132\132\138\138\144\144\150\150\154\154\158\158\162\162\166\166\172\172\176\176\180\180\184\184\190\190\196\196\202\202\206\206\210\210\214\214\218\218\222\222\226\226\230\230\236\236\242\242\246\246\250\250\254\254\002\002\006\006\010\010\014\014\018\018\022\022\026\026\030\030\034\034\038\042\046\050\000\054\000\000\000\000\059\059\063\063\067\067\073\073\079\079\085\085\091\091\097\097\103\103\109\109\115\115\121\121\127\127\131\131\135\135\139\139\145\145\151\151\157\157\163\163\169\169\173\173\177\177\181\181\185\185\191\191\197\197\203\203\209\209\215\215\221\221\227\227\233\233\239\239\245\245\249\249\253\253\003\003\! 009\009\015\015\021\021\027\027\031\031\035\035\039\039\000\00! 0\000\00 0\000\000\043\048\053\060\067\074\081\088\043\048\053\060\067\074\081\088\095\100\105\112\119\126\000\000\095\100\105\112\119\126\000\000\133\138\143\150\157\164\171\178\133\138\143\150\157\164\171\178\185\190\195\202\209\216\223\230\185\190\195\202\209\216\223\230\237\242\247\254\005\012\000\000\237\242\247\254\005\012\000\000\019\024\029\036\043\050\057\064\000\024\000\036\000\050\000\064\071\076\081\088\095\102\109\116\071\076\081\088\095\102\109\116\123\196\128\204\133\209\138\214\143\219\148\224\153\229\000\000\158\165\172\181\190\199\208\217\158\165\172\181\190\199\208\217\226\233\240\249\002\011\020\029\226\233\240\249\002\011\020\029\038\045\052\061\070\079\088\097\038\045\052\061\070\079\088\097\106\111\116\123\128\000\135\140\106\111\123\196\123\000\009\000\000\147\152\159\164\000\171\176\128\204\133\209\159\183\189\195\201\206\211\234\000\000\218\223\201\206\138\214\000\230\236\242\248\253\002\067\009\014\019\024\248\253\148\224\014\031\191\036\000\000\038\045\050! \000\057\062\143\219\153\229\045\069\000\000\000\000\000\000\000\000\000\000\000\000\000\000\072\072\072\072\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\072\072\072\072\072\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\072\072\072\072\072\072\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\073\077\081\085\089\093\097\101\105\109\113\117\121\125\129\133\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \000\000\000\000\000\000\000\000\000\000\137\141\145\149\153\1! 57\161\1 65\169\173\177\181\185\189\193\197\201\205\209\213\217\221\225\229\233\237\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\241\000\248\000\255\000\006\000\013\000\020\000\027\000\034\000\041\000\048\000\055\000\062\000\000\069\000\076\000\083\000\000\000\000\000\000\090\097\000\104\111\000\118\125\000\132\139\000\146\153\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\160\000\000\000\000\000\000\000\000\000\167\000\000\000\000\000\000\000\000\000\000\000\000\000\174\000\181\000\188\000\195\000\202\000\209\000\216\000\223\000\230\000\237\000\244\000\251\000\000\002\000\009\000\016\000\000\000\000\000\000\023\030\000\037\044\000\051\058\000\065\072\000\079\086\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\09! 3\000\000\100\107\114\121\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\135\000\140\000\000\000\000\000\000\000\000\000\000\145\150\155\162\169\174\179\184\189\194\199\204\209\000\214\219\224\229\234\000\239\000\244\249\000\254\003\000\008\013\018\023\028\033\038\043\048\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\072\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\053\057\061\065\069\073\077\081\085\089\09! 3\097\101\105\109\113\117\121\125\129\133\137\141\145\149\153\! 000\000\ 000\000\000" + "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\008\012\016\020\024\027\031\035\039\043\047\051\055\059\063\066\070\074\078\082\086\000\090\093\097\101\105\109\113\000\000\004\008\012\016\020\000\027\031\035\039\043\047\051\055\059\000\066\070\074\078\082\086\000\000\093\097\101\105\109\000\116\120\120\124\124\128\128\132\132\136\136\140\140\144\144\148\148\152\000\155\155\159\159\163\163\167\167\171\171\175\175\179\179\183\183\187\187\191\191\195\000\198\198\202\202\206\206\210\210\214\000\218\000\221\221\! 225\225\000\229\229\233\233\237\237\241\000\244\000\247\247\251\251\255\255\000\003\000\006\006\010\010\014\014\018\000\021\021\025\025\029\029\033\033\037\037\041\041\045\045\049\049\053\053\057\000\060\060\064\064\068\068\072\072\076\076\080\080\084\084\088\088\116\092\092\096\096\100\100\000\000\104\107\000\110\000\113\116\000\119\122\125\000\000\128\131\134\137\000\140\143\000\146\149\152\000\000\000\155\158\000\161\164\164\168\000\171\000\000\174\000\177\000\000\180\000\183\186\186\190\193\196\000\199\000\202\205\000\000\000\208\000\000\000\000\000\000\000\211\211\000\214\214\000\217\217\000\220\220\224\224\228\228\232\232\236\236\242\242\248\248\254\254\000\004\004\010\010\016\016\021\000\024\024\028\028\032\032\036\036\042\042\047\051\051\000\054\054\000\000\058\058\062\062\068\068\073\073\078\078\082\082\086\086\090\090\094\094\098\098\102\102\106\106\110\110\114\114\118\118\122\122\126\126\130\130\000\000\134\134\000\000\000\000\000\000\138\138\142\142\146\146\152\! 152\158\158\162\162\168\168\000\000\000\000\000\000\000\000\00! 0\000\00 0\000\172\175\000\178\181\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\186\000\000\000\000\000\000\000\000\000\189\000\000\000\000\000\000\191\196\201\204\209\214\000\219\000\224\229\234\241\244\247\250\253\000\003\006\009\012\015\018\021\024\027\030\033\000\036\039\042\045\048\051\054\057\062\196\204\209\214\067\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\036\000\000\000\000\000\000\000\057\062\219\224\229\000\000\000\000\074\079\000\000\000\000\000\000\000\000\000\000\000\000\000\084\000\087\000\090\000\093\000\096\000\099\000\102\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\105\110\115\118\123\126\129\132\137\140\143\146\149\154\159\164\167\170\173\176\179\182\185\188\191\194\199\202\205\208\211\214\217\220\223\226\229\232\235\238\241\244\247\250\253\000\003\006\000\000\000\000\000\000! \000\000\000\194\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\105\110\000\118\000\000\000\132\000\000\000\000\149\154\159\000\009\000\012\000\015\000\018\000\021\000\024\000\027\000\030\000\033\000\036\000\039\000\042\042\047\000\050\000\053\000\056\000\059\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\062\000\065\000\068\000\071\000\074\000\077\000\080\000\083\000\086\000\089\000\092\000\095\000\098\000\101\000\104\000\107\000\110\000\113\000\116\000\119\000\122\000\125\000\128\000\131\000\000\134\134\139\000\000\000\142\000\000\000\145\000\000\000\000\148\148\153\153\158\000\161\161\166\000\169\169\174\174\179\179\184\000\187\187\192\192\197\197\202\000\205\205\210\210\215\215\220\220\225\225\230\230\000\000\235\235\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \000\000\000\000\240\243\246\249\252\255\002\005\008\011\014\0! 17\020\0 23\026\029\032\035\038\041\044\047\050\053\056\059\062\065\068\071\074\077\080\083\086\089\092\095\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\098\103\108\113\118\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\123\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\133\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\138\000\000\000\000\000\000\000\145\000\000\152\00! 0\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\159\166\173\180\187\194\201\208\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\215\222\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\229\236\000\243\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\250\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\015\022\000\000\029\000\000\000\000\000\000\000\000\000\000\000\000\000\00! 0\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\! 000\000\ 000\000\000\000\000\000\000\000\000\000\036\000\000\043\050\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\057\064\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\071\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\078\085\092\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\099\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0! 00\000\000\000\000\000\000\000\000\000\000\106\000\000\000\000\000\000\113\120\000\127\134\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\144\151\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\165\000\172\179\189\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\000\000\000\000\000\000\000\000\000\203\000\000\000\000\210\000\000\000\000\217\000\000\000\000\224\000\000\000\000\000\000\000\000\000\000\000\000\231\000\000\0! 00\000\000\000\000\000\000\238\000\245\252\000\003\000\000\000! \000\000 \000\000\000\010\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\000\000\000\000\000\000\000\000\000\024\000\000\000\000\031\000\000\000\000\038\000\000\000\000\045\000\000\000\000\000\000\000\000\000\000\000\000\052\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\059\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\066\070\074\078\082\086\090\094\098\102\106\110\114\118\122\126\130\134\138\142\146\150\154\158\162\166\170\174\178\182\186\190\194\198\202\206\210\214\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\! 000\000\000\000\000\000\000\000\000\000\000\218\218\222\222\226\226\230\230\234\234\240\240\244\244\248\248\252\252\000\000\004\004\010\010\016\016\020\020\024\024\030\030\034\034\038\038\042\042\046\046\050\050\054\054\058\058\062\062\068\068\072\072\076\076\080\080\084\084\090\090\094\094\098\098\102\102\106\106\110\110\114\114\118\118\122\122\126\126\132\132\138\138\144\144\150\150\154\154\158\158\162\162\166\166\172\172\176\176\180\180\184\184\190\190\196\196\202\202\206\206\210\210\214\214\218\218\222\222\226\226\230\230\236\236\242\242\246\246\250\250\254\254\002\002\006\006\010\010\014\014\018\018\022\022\026\026\030\030\034\034\038\042\046\050\000\054\000\000\000\000\059\059\063\063\067\067\073\073\079\079\085\085\091\091\097\097\103\103\109\109\115\115\121\121\127\127\131\131\135\135\139\139\145\145\151\151\157\157\163\163\169\169\173\173\177\177\181\181\185\185\191\191\197\197\203\203\209\209\215\215\221\221\227\227\233\233\239\239\245\245\249\249\253\253\003\003\! 009\009\015\015\021\021\027\027\031\031\035\035\039\039\000\00! 0\000\00 0\000\000\043\048\053\060\067\074\081\088\043\048\053\060\067\074\081\088\095\100\105\112\119\126\000\000\095\100\105\112\119\126\000\000\133\138\143\150\157\164\171\178\133\138\143\150\157\164\171\178\185\190\195\202\209\216\223\230\185\190\195\202\209\216\223\230\237\242\247\254\005\012\000\000\237\242\247\254\005\012\000\000\019\024\029\036\043\050\057\064\000\024\000\036\000\050\000\064\071\076\081\088\095\102\109\116\071\076\081\088\095\102\109\116\123\196\128\204\133\209\138\214\143\219\148\224\153\229\000\000\158\165\172\181\190\199\208\217\158\165\172\181\190\199\208\217\226\233\240\249\002\011\020\029\226\233\240\249\002\011\020\029\038\045\052\061\070\079\088\097\038\045\052\061\070\079\088\097\106\111\116\123\128\000\135\140\106\111\123\196\123\000\009\000\000\147\152\159\164\000\171\176\128\204\133\209\159\183\189\195\201\206\211\234\000\000\218\223\201\206\138\214\000\230\236\242\248\253\002\067\009\014\019\024\248\253\148\224\014\031\191\036\000\000\038\045\050! \000\057\062\143\219\153\229\045\069\000\000\000\000\000\000\000\000\000\000\000\000\000\000\072\072\072\072\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\072\072\072\072\072\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\072\072\072\072\072\072\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\073\077\081\085\089\093\097\101\105\109\113\117\121\125\129\133\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000! \000\000\000\000\000\000\000\000\000\000\137\141\145\149\153\1! 57\161\1 65\169\173\177\181\185\189\193\197\201\205\209\213\217\221\225\229\233\237\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\241\000\248\000\255\000\006\000\013\000\020\000\027\000\034\000\041\000\048\000\055\000\062\000\000\069\000\076\000\083\000\000\000\000\000\000\090\097\000\104\111\000\118\125\000\132\139\000\146\153\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\160\000\000\000\000\000\000\000\000\000\167\000\000\000\000\000\000\000\000\000\000\000\000\000\174\000\181\000\188\000\195\000\202\000\209\000\216\000\223\000\230\000\237\000\244\000\251\000\000\002\000\009\000\016\000\000\000\000\000\000\023\030\000\037\044\000\051\058\000\065\072\000\079\086\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\09! 3\000\000\100\107\114\121\000\000\000\128\000\000\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\00! 0\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" Modified: trunk/src/update.ml =================================================================== --- trunk/src/update.ml 2009-06-15 14:26:01 UTC (rev 354) +++ trunk/src/update.ml 2009-06-17 14:42:07 UTC (rev 355) @@ -431,8 +431,10 @@ (System.fspathToDebugString ffrom) (System.fspathToDebugString fto)); Util.convertUnixErrorsToFatal "copying archive" (fun () -> - System.unlink fto; begin try + System.unlink fto + with Unix.Unix_error (Unix.ENOENT, _, _) -> () end; + begin try System.link ffrom fto with Unix.Unix_error _ -> let outFd = Modified: trunk/src/uutil.ml =================================================================== --- trunk/src/uutil.ml 2009-06-15 14:26:01 UTC (rev 354) +++ trunk/src/uutil.ml 2009-06-17 14:42:07 UTC (rev 355) @@ -137,7 +137,7 @@ if n > 0 then begin let _ = output target buf 0 n in l := !l + n; - if !l > 100 * 1024 then begin + if !l >= 100 * 1024 then begin notify !l; l := 0 end; From mattboll at penia.org Thu Jun 18 03:56:57 2009 From: mattboll at penia.org (Matthieu Bollot) Date: Thu, 18 Jun 2009 09:56:57 +0200 Subject: [Unison-hackers] internationalization Message-ID: <1245311817.15808.6.camel@katya.penia.org> Hi, Is there any news about internationalization ? ( http://tech.groups.yahoo.com/group/unison-users/message/7755 ) I didn't watch the svn, nor the others versions after 2.27.57 but I didn't see anything in changelog. I'll have to translate it in french, so I could help. best regards, Matthieu. From sylvain at le-gall.net Thu Jun 18 04:31:09 2009 From: sylvain at le-gall.net (Sylvain Le Gall) Date: Thu, 18 Jun 2009 08:31:09 +0000 (UTC) Subject: [Unison-hackers] internationalization References: <1245311817.15808.6.camel@katya.penia.org> Message-ID: On 18-06-2009, Matthieu Bollot wrote: > Hi, > > Is there any news about internationalization ? > ( http://tech.groups.yahoo.com/group/unison-users/message/7755 ) > I didn't watch the svn, nor the others versions after 2.27.57 but I > didn't see anything in changelog. > > I'll have to translate it in french, so I could help. > Well, let say that I have been busy with other thing. I am still intending to propose a patch using ocaml-gettext. Maybe next week, ping me if I forgot. Regards, Sylvain Le Gall From vouillon at seas.upenn.edu Thu Jun 18 04:34:27 2009 From: vouillon at seas.upenn.edu (vouillon@seas.upenn.edu) Date: Thu, 18 Jun 2009 04:34:27 -0400 Subject: [Unison-hackers] [unison-svn] r356 - in branches/2.27/src: . lwt Message-ID: <200906180834.n5I8YRpX019972@yaws.seas.upenn.edu> Author: vouillon Date: 2009-06-18 04:34:23 -0400 (Thu, 18 Jun 2009) New Revision: 356 Modified: branches/2.27/src/RECENTNEWS branches/2.27/src/lwt/depend branches/2.27/src/lwt/lwt_unix.ml branches/2.27/src/mkProjectInfo.ml branches/2.27/src/os.ml branches/2.27/src/osx.ml branches/2.27/src/transfer.ml Log: Backport to stable release: * Fixed bug resulting in slow performances when transferring a file using our rsync implementation from a 64-bit architecture to a 32-bit architecture. * Fixed bug in Lwt_unix.run which could make it fail with a Not_found exception (see [Not_found raised in tryCopyMovedFile] errors) * Properly deals with non-conformant AppleDouble files produced by Mac OS X. * Fixed bug that results in Unison missing ressource fork changes Modified: branches/2.27/src/RECENTNEWS =================================================================== --- branches/2.27/src/RECENTNEWS 2009-06-17 14:42:07 UTC (rev 355) +++ branches/2.27/src/RECENTNEWS 2009-06-18 08:34:23 UTC (rev 356) @@ -1,3 +1,16 @@ +CHANGES FROM VERSION 2.27.140 + +Backport to stable release: +* Fixed bug resulting in slow performances when transferring a file + using our rsync implementation from a 64-bit architecture to a + 32-bit architecture. +* Fixed bug in Lwt_unix.run which could make it fail with a Not_found + exception (see [Not_found raised in tryCopyMovedFile] errors) +* Properly deals with non-conformant AppleDouble files produced + by Mac OS X. +* Fixed bug that results in Unison missing ressource fork changes + +------------------------------- CHANGES FROM VERSION 2.27.109 Backport to stable release: Modified: branches/2.27/src/lwt/depend =================================================================== --- branches/2.27/src/lwt/depend 2009-06-17 14:42:07 UTC (rev 355) +++ branches/2.27/src/lwt/depend 2009-06-18 08:34:23 UTC (rev 356) @@ -6,5 +6,7 @@ lwt_util.cmx: lwt.cmx lwt_util.cmi pqueue.cmo: pqueue.cmi pqueue.cmx: pqueue.cmi +lwt.cmi: lwt_unix.cmi: lwt.cmi lwt_util.cmi: lwt.cmi +pqueue.cmi: Modified: branches/2.27/src/lwt/lwt_unix.ml =================================================================== --- branches/2.27/src/lwt/lwt_unix.ml 2009-06-17 14:42:07 UTC (rev 355) +++ branches/2.27/src/lwt/lwt_unix.ml 2009-06-18 08:34:23 UTC (rev 356) @@ -141,33 +141,39 @@ restart_threads !event_counter now; List.iter (fun fd -> - match List.assoc fd !inputs with - `Read (buf, pos, len, res) -> - wrap_syscall inputs fd res - (fun () -> Unix.read fd buf pos len) - | `Accept res -> - wrap_syscall inputs fd res - (fun () -> - let (s, _) as v = Unix.accept fd in - if not windows_hack then Unix.set_nonblock s; - v) - | `Wait res -> - wrap_syscall inputs fd res (fun () -> ())) + try + match List.assoc fd !inputs with + `Read (buf, pos, len, res) -> + wrap_syscall inputs fd res + (fun () -> Unix.read fd buf pos len) + | `Accept res -> + wrap_syscall inputs fd res + (fun () -> + let (s, _) as v = Unix.accept fd in + if not windows_hack then Unix.set_nonblock s; + v) + | `Wait res -> + wrap_syscall inputs fd res (fun () -> ()) + with Not_found -> + ()) readers; List.iter (fun fd -> - match List.assoc fd !outputs with - `Write (buf, pos, len, res) -> - wrap_syscall outputs fd res - (fun () -> Unix.write fd buf pos len) - | `CheckSocket res -> - wrap_syscall outputs fd res - (fun () -> - try ignore (Unix.getpeername fd) with - Unix.Unix_error (Unix.ENOTCONN, _, _) -> - ignore (Unix.read fd " " 0 1)) - | `Wait res -> - wrap_syscall inputs fd res (fun () -> ())) + try + match List.assoc fd !outputs with + `Write (buf, pos, len, res) -> + wrap_syscall outputs fd res + (fun () -> Unix.write fd buf pos len) + | `CheckSocket res -> + wrap_syscall outputs fd res + (fun () -> + try ignore (Unix.getpeername fd) with + Unix.Unix_error (Unix.ENOTCONN, _, _) -> + ignore (Unix.read fd " " 0 1)) + | `Wait res -> + wrap_syscall inputs fd res (fun () -> ()) + with Not_found -> + ()) writers; if !child_exited then begin child_exited := false; Modified: branches/2.27/src/mkProjectInfo.ml =================================================================== --- branches/2.27/src/mkProjectInfo.ml 2009-06-17 14:42:07 UTC (rev 355) +++ branches/2.27/src/mkProjectInfo.ml 2009-06-18 08:34:23 UTC (rev 356) @@ -79,3 +79,4 @@ + Modified: branches/2.27/src/os.ml =================================================================== --- branches/2.27/src/os.ml 2009-06-17 14:42:07 UTC (rev 355) +++ branches/2.27/src/os.ml 2009-06-18 08:34:23 UTC (rev 356) @@ -237,7 +237,7 @@ in retryLoop 10 info (* Maximum retries: 10 times *) (match optDig with None -> None | Some (d, _) -> Some d) - (match optDig with None -> None | Some (_, d) -> Some d) + None let fullfingerprint_to_string (fp,rfp) = Printf.sprintf "(%s,%s)" (Fingerprint.toString fp) (Fingerprint.toString rfp) Modified: branches/2.27/src/osx.ml =================================================================== --- branches/2.27/src/osx.ml 2009-06-17 14:42:07 UTC (rev 355) +++ branches/2.27/src/osx.ml 2009-06-18 08:34:23 UTC (rev 356) @@ -53,6 +53,7 @@ let doubleFiller = String.make 16 '\000' let finfoLength = 32L let emptyFinderInfo () = String.make 32 '\000' +let ressource_fork_empty_tag = "This resource fork intentionally left blank " let getInt2 buf ofs = (Char.code buf.[ofs]) * 256 + Char.code buf.[ofs + 1] @@ -118,8 +119,6 @@ fail path "bad magic number"; if String.sub header 4 4 <> doubleVersion then fail path "bad version"; - if String.sub header 8 16 <> doubleFiller then - fail path "bad filler"; let numEntries = getInt2 header 24 in let entries = ref [] in for i = 1 to numEntries do @@ -213,21 +212,36 @@ let (fspath, path) = Fspath.findWorkingDir fspath path in let (doublePath, inch, entries) = openDouble fspath path in let (rsrcOffset, rsrcLength) = - try Safelist.assoc `RSRC entries with Not_found -> - (0L, 0L) + try + let (offset, len) = Safelist.assoc `RSRC entries in + (* We need to check that the ressource fork is not a + dummy one included for compatibility reasons *) + if len = 286L && + protect (fun () -> + LargeFile.seek_in inch (Int64.add offset 16L); + let len = String.length ressource_fork_empty_tag in + let buf = String.create len in + really_input inch buf 0 len; + buf = ressource_fork_empty_tag) + (fun () -> close_in_noerr inch) + then + (0L, 0L) + else + (offset, len) + with Not_found -> + (0L, 0L) in let finfo = protect (fun () -> try let (ofs, len) = Safelist.assoc `FINFO entries in - if len <> finfoLength then fail doublePath "bad finder info"; - let res = readDoubleFromOffset doublePath inch ofs 32 in - close_in inch; - res + if len < finfoLength then fail doublePath "bad finder info"; + readDoubleFromOffset doublePath inch ofs 32 with Not_found -> "") (fun () -> close_in_noerr inch) in + close_in inch; let stats = Unix.LargeFile.stat doublePath in { ressInfo = if rsrcLength = 0L then NoRess else @@ -283,7 +297,7 @@ let (doublePath, inch, entries) = openDouble fspath path in begin try let (ofs, len) = Safelist.assoc `FINFO entries in - if len <> finfoLength then fail doublePath "bad finder info"; + if len < finfoLength then fail doublePath "bad finder info"; let fullFinfo = protect (fun () -> Modified: branches/2.27/src/transfer.ml =================================================================== --- branches/2.27/src/transfer.ml 2009-06-17 14:42:07 UTC (rev 355) +++ branches/2.27/src/transfer.ml 2009-06-18 08:34:23 UTC (rev 356) @@ -451,6 +451,10 @@ | [], r :: r' -> addList k r r' | ((cs, fp) :: r), _ -> + (* Negative 31-bits integers are sign-extended when + unmarshalled on a 64-bit architecture, so we + truncate them back to 31 bits. *) + let cs = cs land 0x7fffffff in let h = (hash cs) land (hashTableLength - 1) in hashTable.(h) <- (k, cs, fp)::(hashTable.(h)); addList (k + 1) r l' From vouillon at seas.upenn.edu Thu Jun 18 04:36:06 2009 From: vouillon at seas.upenn.edu (vouillon@seas.upenn.edu) Date: Thu, 18 Jun 2009 04:36:06 -0400 Subject: [Unison-hackers] [unison-svn] r357 - branches/2.32/src Message-ID: <200906180836.n5I8a6Qi020060@yaws.seas.upenn.edu> Author: vouillon Date: 2009-06-18 04:36:04 -0400 (Thu, 18 Jun 2009) New Revision: 357 Modified: branches/2.32/src/RECENTNEWS branches/2.32/src/mkProjectInfo.ml branches/2.32/src/os.ml branches/2.32/src/osx.ml branches/2.32/src/transfer.ml Log: * Fixed bug resulting in slow performances when transferring a file using our rsync implementation from a 64-bit architecture to a 32-bit architecture. * Properly deals with non-conformant AppleDouble files produced by Mac OS X; produce AppleDouble files with the same structure as the one produced by Mac OS X. * Fixed bug that results in Unison missing ressource fork changes Modified: branches/2.32/src/RECENTNEWS =================================================================== --- branches/2.32/src/RECENTNEWS 2009-06-18 08:34:23 UTC (rev 356) +++ branches/2.32/src/RECENTNEWS 2009-06-18 08:36:04 UTC (rev 357) @@ -1,3 +1,14 @@ +CHANGES FROM VERSION 2.32.38 + +* Fixed bug resulting in slow performances when transferring a file + using our rsync implementation from a 64-bit architecture to a + 32-bit architecture. +* Properly deals with non-conformant AppleDouble files produced by Mac + OS X; produce AppleDouble files with the same structure as the one + produced by Mac OS X. +* Fixed bug that results in Unison missing ressource fork changes + +------------------------------- CHANGES FROM VERSION 2.32.33 * Fix to the Mac GUI: the bigarray library is now required Modified: branches/2.32/src/mkProjectInfo.ml =================================================================== --- branches/2.32/src/mkProjectInfo.ml 2009-06-18 08:34:23 UTC (rev 356) +++ branches/2.32/src/mkProjectInfo.ml 2009-06-18 08:36:04 UTC (rev 357) @@ -117,3 +117,4 @@ + Modified: branches/2.32/src/os.ml =================================================================== --- branches/2.32/src/os.ml 2009-06-18 08:34:23 UTC (rev 356) +++ branches/2.32/src/os.ml 2009-06-18 08:36:04 UTC (rev 357) @@ -281,7 +281,7 @@ in retryLoop 10 info (* Maximum retries: 10 times *) (match optDig with None -> None | Some (d, _) -> Some d) - (match optDig with None -> None | Some (_, d) -> Some d) + None let fullfingerprint_to_string (fp,rfp) = Printf.sprintf "(%s,%s)" (Fingerprint.toString fp) (Fingerprint.toString rfp) Modified: branches/2.32/src/osx.ml =================================================================== --- branches/2.32/src/osx.ml 2009-06-18 08:34:23 UTC (rev 356) +++ branches/2.32/src/osx.ml 2009-06-18 08:36:04 UTC (rev 357) @@ -15,7 +15,10 @@ along with this program. If not, see . *) +let debug = Trace.debug "osx" +(****) + external isMacOSXPred : unit -> bool = "isMacOSX" let isMacOSX = isMacOSXPred () @@ -65,8 +68,37 @@ let doubleMagic = "\000\005\022\007" let doubleVersion = "\000\002\000\000" let doubleFiller = String.make 16 '\000' +let ressource_fork_empty_tag = "This resource fork intentionally left blank " let finfoLength = 32L let emptyFinderInfo () = String.make 32 '\000' +let empty_ressource_fork = + "\000\000\001\000" ^ + "\000\000\001\000" ^ + "\000\000\000\000" ^ + "\000\000\000\030" ^ + ressource_fork_empty_tag ^ + String.make (66+128) '\000' ^ + "\000\000\001\000" ^ + "\000\000\001\000" ^ + "\000\000\000\000" ^ + "\000\000\000\030" ^ + "\000\000\000\000" ^ + "\000\000\000\000" ^ + "\000\028\000\030" ^ + "\255\255" +let empty_attribute_chunk () = + "\000\000" ^ (* pad *) + "ATTR" ^ (* magic *) + "\000\000\000\000" ^ (* debug tag *) + "\000\000\014\226" ^ (* total size *) + "\000\000\000\156" ^ (* data_start *) + "\000\000\000\000" ^ (* data_length *) + "\000\000\000\000" ^ (* reserved *) + "\000\000\000\000" ^ + "\000\000\000\000" ^ + "\000\000" ^ (* flags *) + "\000\000" ^ (* num_attrs *) + String.make 3690 '\000' let getInt2 buf ofs = (Char.code buf.[ofs]) * 256 + Char.code buf.[ofs + 1] @@ -132,8 +164,6 @@ fail path "bad magic number"; if String.sub header 4 4 <> doubleVersion then fail path "bad version"; - if String.sub header 8 16 <> doubleFiller then - fail path "bad filler"; let numEntries = getInt2 header 24 in let entries = ref [] in for i = 1 to numEntries do @@ -227,21 +257,41 @@ let (fspath, path) = Fspath.findWorkingDir fspath path in let (doublePath, inch, entries) = openDouble fspath path in let (rsrcOffset, rsrcLength) = - try Safelist.assoc `RSRC entries with Not_found -> + try + let (offset, len) = Safelist.assoc `RSRC entries in + (* We need to check that the ressource fork is not a + dummy one included for compatibility reasons *) + if len = 286L && + protect (fun () -> + LargeFile.seek_in inch (Int64.add offset 16L); + let len = String.length ressource_fork_empty_tag in + let buf = String.create len in + really_input inch buf 0 len; + buf = ressource_fork_empty_tag) + (fun () -> close_in_noerr inch) + then + (0L, 0L) + else + (offset, len) + with Not_found -> (0L, 0L) in + debug (fun () -> + Util.msg + "AppleDouble for file %s / %s: ressource fork length: %d\n" + (Fspath.toString fspath) (Path.toString path) + (Int64.to_int rsrcLength)); let finfo = protect (fun () -> try let (ofs, len) = Safelist.assoc `FINFO entries in - if len <> finfoLength then fail doublePath "bad finder info"; - let res = readDoubleFromOffset doublePath inch ofs 32 in - close_in inch; - res + if len < finfoLength then fail doublePath "bad finder info"; + readDoubleFromOffset doublePath inch ofs 32 with Not_found -> "") (fun () -> close_in_noerr inch) in + close_in inch; let stats = Util.convertUnixErrorsToTransient "stating AppleDouble file" (fun () -> Unix.LargeFile.stat doublePath) in @@ -299,7 +349,7 @@ let (doublePath, inch, entries) = openDouble fspath path in begin try let (ofs, len) = Safelist.assoc `FINFO entries in - if len <> finfoLength then fail doublePath "bad finder info"; + if len < finfoLength then fail doublePath "bad finder info"; let fullFinfo = protect (fun () -> @@ -333,15 +383,27 @@ open_out_gen [Open_wronly; Open_creat; Open_excl; Open_binary] 0o600 path in + (* Apparently, for compatibility with various old versions + of Mac OS X that did not follow the AppleDouble specification, + we have to include a dummy ressource fork... + We also put an empty extended attribute section at the + end of the finder info section, mimicking the Mac OS X + kernel behavior. *) protect (fun () -> output_string outch doubleMagic; output_string outch doubleVersion; output_string outch doubleFiller; - output_string outch "\000\001"; (* One entry *) + output_string outch "\000\002"; (* Two entries *) output_string outch "\000\000\000\009"; (* Finder info *) - output_string outch "\000\000\000\038"; (* offset *) - output_string outch "\000\000\000\032"; (* length *) + output_string outch "\000\000\000\050"; (* offset *) + output_string outch "\000\000\014\176"; (* length *) + output_string outch "\000\000\000\002"; (* Ressource fork *) + output_string outch "\000\000\014\226"; (* offset *) + output_string outch "\000\000\001\030"; (* length *) output_string outch (insertInfo (emptyFinderInfo ()) finfo); + output_string outch (empty_attribute_chunk ()); + (* extended attributes *) + output_string outch empty_ressource_fork; close_out outch) (fun () -> close_out_noerr outch) end @@ -389,6 +451,9 @@ | HfsRess _ -> Fingerprint.file fspath (ressPath path) | AppleDoubleRess (_, _, _, len, (path, offset)) -> + debug (fun () -> + Util.msg "ressource fork fingerprint: path %s, offset %d, len %d" + path (Int64.to_int offset) (Uutil.Filesize.toInt len)); Fingerprint.subfile path offset len let ressLength ress = @@ -439,12 +504,14 @@ output_string outch "\000\002"; (* Two entries *) output_string outch "\000\000\000\009"; (* Finder info *) output_string outch "\000\000\000\050"; (* offset *) - output_string outch "\000\000\000\032"; (* length *) + output_string outch "\000\000\014\176"; (* length *) output_string outch "\000\000\000\002"; (* Resource fork *) - output_string outch "\000\000\000\082"; (* offset *) + output_string outch "\000\000\014\226"; (* offset *) output_string outch (setInt4 (Uutil.Filesize.toInt64 length)); (* length *) output_string outch (emptyFinderInfo ()); + output_string outch (empty_attribute_chunk ()); + (* extended attributes *) flush outch) (fun () -> close_out_noerr outch); outch) Modified: branches/2.32/src/transfer.ml =================================================================== --- branches/2.32/src/transfer.ml 2009-06-18 08:34:23 UTC (rev 356) +++ branches/2.32/src/transfer.ml 2009-06-18 08:36:04 UTC (rev 357) @@ -466,6 +466,10 @@ | [], r :: r' -> addList k r r' | ((cs, fp) :: r), _ -> + (* Negative 31-bits integers are sign-extended when + unmarshalled on a 64-bit architecture, so we + truncate them back to 31 bits. *) + let cs = cs land 0x7fffffff in let h = (hash cs) land (hashTableLength - 1) in hashTable.(h) <- (k, cs, fp)::(hashTable.(h)); addList (k + 1) r l' From schmitta at seas.upenn.edu Thu Jun 18 05:29:45 2009 From: schmitta at seas.upenn.edu (ALAN SCHMITT) Date: Thu, 18 Jun 2009 05:29:45 -0400 Subject: [Unison-hackers] [unison-svn] r358 - branches/2.27/doc branches/2.27/src/uimacnew branches/2.32/src trunk/doc trunk/fstest trunk/src trunk/src/uimacnew Message-ID: <200906180929.n5I9Tj1o022948@yaws.seas.upenn.edu> Author: schmitta Date: 2009-06-18 05:29:40 -0400 (Thu, 18 Jun 2009) New Revision: 358 Modified: branches/2.27/doc/unison-manual.tex branches/2.27/src/uimacnew/ branches/2.32/src/Makefile.OCaml trunk/doc/unison-manual.tex trunk/fstest/ trunk/src/ trunk/src/Makefile.OCaml trunk/src/uimacnew/ Log: - svn:ignoring some files - correcting some typos in the manual - incorporating Makefile changes to allow specifying the minimal OS X version targeted, thanks to a patch from Martin von Gagern Modified: branches/2.27/doc/unison-manual.tex =================================================================== --- branches/2.27/doc/unison-manual.tex 2009-06-18 08:36:04 UTC (rev 357) +++ branches/2.27/doc/unison-manual.tex 2009-06-18 09:29:40 UTC (rev 358) @@ -475,7 +475,7 @@ \noindent indicates that the file {\tt c} has been modified only in the second replica, and that the default action is therefore to propagate the new -version to the first replica. To {\bf f}ollw Unison's recommendation, +version to the first replica. To {\bf f}ollow Unison's recommendation, press the ``f'' at the prompt. If both replicas are modified and their contents are different, then @@ -494,7 +494,7 @@ These display conventions are used by both versions of the user interface. The only difference lies in the way in which Unison's -default actions are either accepted or overriden by the user. +default actions are either accepted or overridden by the user. \begin{textui} The status of each modified file is displayed, in turn. Property changes on: branches/2.27/src/uimacnew ___________________________________________________________________ Name: svn:ignore + build ExternalSettings.xcconfig Modified: branches/2.32/src/Makefile.OCaml =================================================================== --- branches/2.32/src/Makefile.OCaml 2009-06-18 08:36:04 UTC (rev 357) +++ branches/2.32/src/Makefile.OCaml 2009-06-18 09:29:40 UTC (rev 358) @@ -155,7 +155,7 @@ endif endif -MINOSXVERSION=10.5 +MINOSXVERSION=10.4 # NOTE: the OCAMLLIBDIR is not getting passed correctly? # The two cases for cltool are needed because Xcode 2.1+ Modified: trunk/doc/unison-manual.tex =================================================================== --- trunk/doc/unison-manual.tex 2009-06-18 08:36:04 UTC (rev 357) +++ trunk/doc/unison-manual.tex 2009-06-18 09:29:40 UTC (rev 358) @@ -475,7 +475,7 @@ \noindent indicates that the file {\tt c} has been modified only in the second replica, and that the default action is therefore to propagate the new -version to the first replica. To {\bf f}ollw Unison's recommendation, +version to the first replica. To {\bf f}ollow Unison's recommendation, press the ``f'' at the prompt. If both replicas are modified and their contents are different, then @@ -494,7 +494,7 @@ These display conventions are used by both versions of the user interface. The only difference lies in the way in which Unison's -default actions are either accepted or overriden by the user. +default actions are either accepted or overridden by the user. \begin{textui} The status of each modified file is displayed, in turn. Property changes on: trunk/fstest ___________________________________________________________________ Name: svn:ignore + build Property changes on: trunk/src ___________________________________________________________________ Name: svn:ignore - *.cmx *.cmi *.cmo mkProjectInfo unison TAGS Makefile.ProjectInfo + *.cmx *.cmi *.cmo mkProjectInfo unison TAGS Makefile.ProjectInfo unison.tmproj Modified: trunk/src/Makefile.OCaml =================================================================== --- trunk/src/Makefile.OCaml 2009-06-18 08:36:04 UTC (rev 357) +++ trunk/src/Makefile.OCaml 2009-06-18 09:29:40 UTC (rev 358) @@ -166,7 +166,11 @@ endif endif -MINOSXVERSION=10.5 +MINOSXVERSION=10.4 +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+ @@ -174,7 +178,7 @@ .PHONY: macexecutable macexecutable: $(NAME)-blob.o # sed -e's/@@VERSION@@/$(VERSION)/' $(UIMACDIR)/Info.plist.template > $(UIMACDIR)/Info.plist - (cd $(UIMACDIR); xcodebuild OCAMLLIBDIR="$(OCAMLLIBDIR)" SYMROOT=build) + (cd $(UIMACDIR); xcodebuild $(XCODEFLAGS) OCAMLLIBDIR="$(OCAMLLIBDIR)" SYMROOT=build) if [ -e $(UIMACDIR)/build/Default ]; then \ gcc -mmacosx-version-min=$(MINOSXVERSION) $(UIMACDIR)/cltool.c -o $(UIMACDIR)/build/Default/Unison.app/Contents/MacOS/cltool -framework Carbon; \ else \ Property changes on: trunk/src/uimacnew ___________________________________________________________________ Name: svn:ignore + build ExternalSettings.xcconfig From vouillon at seas.upenn.edu Fri Jun 19 10:13:06 2009 From: vouillon at seas.upenn.edu (vouillon@seas.upenn.edu) Date: Fri, 19 Jun 2009 10:13:06 -0400 Subject: [Unison-hackers] [unison-svn] r359 - trunk/src Message-ID: <200906191413.n5JED60D014741@yaws.seas.upenn.edu> Author: vouillon Date: 2009-06-19 10:13:03 -0400 (Fri, 19 Jun 2009) New Revision: 359 Modified: trunk/src/Makefile.OCaml trunk/src/RECENTNEWS trunk/src/case.ml trunk/src/copy.ml trunk/src/globals.mli trunk/src/mkProjectInfo.ml trunk/src/path.mli trunk/src/remote.ml trunk/src/update.ml Log: * Various small changes Modified: trunk/src/Makefile.OCaml =================================================================== --- trunk/src/Makefile.OCaml 2009-06-18 09:29:40 UTC (rev 358) +++ trunk/src/Makefile.OCaml 2009-06-19 14:13:03 UTC (rev 359) @@ -416,7 +416,9 @@ -$(RM) -r *.o core gmon.out *~ .*~ -$(RM) -r *.obj *.lib *.exp -$(RM) -r *.tmp *.bak?.tmp .*.bak?.tmp - -$(RM) system/*.cm[iox] system/*.{o,obj} + -$(RM) system/*.cm[iox] system/*.{o,obj} system/win/*~ + -$(RM) system/generic/*.cm[iox] system/generic/*.{o,obj} system/generic/*~ + -$(RM) system/win/*.cm[iox] system/win/*.{o,obj} system/win/*~ .PHONY: paths paths: Modified: trunk/src/RECENTNEWS =================================================================== --- trunk/src/RECENTNEWS 2009-06-18 09:29:40 UTC (rev 358) +++ trunk/src/RECENTNEWS 2009-06-19 14:13:03 UTC (rev 359) @@ -1,5 +1,10 @@ CHANGES FROM VERSION 2.35.-17 +* Various small changes + +------------------------------- +CHANGES FROM VERSION 2.35.-17 + * Use a better file name for keeping a copy of an incorrectly transferred file. In particular, this is now a temp filename, and Unison will not try to propagate it next time it is run. Modified: trunk/src/case.ml =================================================================== --- trunk/src/case.ml 2009-06-18 09:29:40 UTC (rev 358) +++ trunk/src/case.ml 2009-06-19 14:13:03 UTC (rev 359) @@ -133,7 +133,7 @@ let sensitiveOps = object method mode = Sensitive method modeDesc = "case sensitive" - method compare s s' = compare s s' + method compare s s' = compare (s : string) s' method hash s = Hashtbl.hash s method normalizePattern s = s method caseInsensitiveMatch = false Modified: trunk/src/copy.ml =================================================================== --- trunk/src/copy.ml 2009-06-18 09:29:40 UTC (rev 358) +++ trunk/src/copy.ml 2009-06-19 14:13:03 UTC (rev 359) @@ -88,7 +88,7 @@ Transfer aborted." (Fspath.toPrintString (Fspath.concat fspathFrom pathFrom)))) -let checkContentsChangeOnHost = +let checkContentsChangeOnRoot = Remote.registerRootCmd "checkContentsChange" (fun (fspathFrom, @@ -99,7 +99,7 @@ let checkContentsChange root pathFrom archDesc archDig archStamp archRess paranoid = - checkContentsChangeOnHost + checkContentsChangeOnRoot root (pathFrom, archDesc, archDig, archStamp, archRess, paranoid) (****) @@ -211,11 +211,9 @@ let localFile fspathFrom pathFrom fspathTo pathTo realPathTo update desc ressLength ido = -(* let use_id f = match ido with Some id -> f id | None -> () in*) Util.convertUnixErrorsToTransient "copying locally" (fun () -> -(* use_id (fun id -> Uutil.showProgress id Uutil.Filesize.zero "l");*) debug (fun () -> Util.msg "Copy.localFile %s / %s to %s / %s\n" (Fspath.toDebugString fspathFrom) (Path.toString pathFrom) @@ -462,7 +460,6 @@ Lwt.catch (fun () -> decompressor := Remote.MsgIdMap.add file_id decompr !decompressor; - Uutil.showProgress id Uutil.Filesize.zero "f"; compressRemotely connFrom (bi, fspathFrom, pathFrom, fileKind, srcFileSize, id, file_id) >>= fun () -> @@ -720,7 +717,8 @@ rootFrom pathFrom rootTo fspathTo pathTo realPathTo update desc fp ress id useExistingTarget in - (* When streaming, we only transfer one file at a time *) + (* When streaming, we only transfer one file at a time, so we don't + need to limit the number of concurrent transfers *) if Prefs.read Remote.streamingActivated then f () else Modified: trunk/src/globals.mli =================================================================== --- trunk/src/globals.mli 2009-06-18 09:29:40 UTC (rev 358) +++ trunk/src/globals.mli 2009-06-19 14:13:03 UTC (rev 359) @@ -22,8 +22,8 @@ (* same thing, as a list *) val rootsList : unit -> Common.root list -(* same thing, but in a standard order and ensuring that the Local root, if *) -(* any, comes first *) +(* same thing, but in a standard order and ensuring that a Local root *) +(* comes first *) val rootsInCanonicalOrder : unit -> Common.root list (* Run a command on all roots *) Modified: trunk/src/mkProjectInfo.ml =================================================================== --- trunk/src/mkProjectInfo.ml 2009-06-18 09:29:40 UTC (rev 358) +++ trunk/src/mkProjectInfo.ml 2009-06-19 14:13:03 UTC (rev 359) @@ -164,3 +164,4 @@ + Modified: trunk/src/path.mli =================================================================== --- trunk/src/path.mli 2009-06-18 09:29:40 UTC (rev 358) +++ trunk/src/path.mli 2009-06-19 14:13:03 UTC (rev 359) @@ -19,7 +19,7 @@ val child : 'a path -> Name.t -> 'a path val parent : local -> local val finalName : t -> Name.t option -val deconstruct : t -> (Name.t * t) option +val deconstruct : 'a path -> (Name.t * 'a path) option val deconstructRev : local -> (Name.t * local) option val fromString : string -> 'a path Modified: trunk/src/remote.ml =================================================================== --- trunk/src/remote.ml 2009-06-18 09:29:40 UTC (rev 358) +++ trunk/src/remote.ml 2009-06-19 14:13:03 UTC (rev 359) @@ -960,8 +960,9 @@ checkHeader conn (Bytearray.create 1) 0 (String.length connectionHeader) >>= (fun () -> Lwt.ignore_result (receive conn); - negociateFlowControl conn >>= (fun () -> - Lwt.return conn)) + (* Flow control negociation can be done asynchronously. *) + Lwt.ignore_result (negociateFlowControl conn); + Lwt.return conn) let inetAddr host = let targetHostEntry = Unix.gethostbyname host in Modified: trunk/src/update.ml =================================================================== --- trunk/src/update.ml 2009-06-18 09:29:40 UTC (rev 358) +++ trunk/src/update.ml 2009-06-19 14:13:03 UTC (rev 359) @@ -213,19 +213,26 @@ NoArchive appears only at root-level (indicated by [top]). Property: Two archives of the same labeled-tree structure have the same hash-value. NB: [h] is the hash accumulator *) -let rec checkArchive (top: bool) (path: Path.t) (arch: archive) (h: int): int = +(* Note that we build the current path as a list of names, as this is + much cheaper than using values of type [Path.t] *) +let rec checkArchive + (top: bool) (path: Name.t list) (arch: archive) (h: int): int = match arch with ArchiveDir (desc, children) -> begin match NameMap.validate children with `Ok -> () | `Duplicate nm -> + let path = + List.fold_right (fun n p -> Path.child p n) path Path.empty in raise (Util.Fatal (Printf.sprintf "Corrupted archive: \ the file %s occurs twice in path %s" (Name.toString nm) (Path.toString path))); | `Invalid (nm, nm') -> + let path = + List.fold_right (fun n p -> Path.child p n) path Path.empty in raise (Util.Fatal (Printf.sprintf "Corrupted archive: the files %s and %s are not \ @@ -236,7 +243,7 @@ NameMap.fold (fun n a h -> Uutil.hash2 (Name.hash n) - (checkArchive false (Path.child path n) a h)) + (checkArchive false (n :: path) a h)) children (Props.hash desc h) | ArchiveFile (desc, dig, _, ress) -> Uutil.hash2 (Hashtbl.hash dig) (Props.hash desc h) @@ -1653,7 +1660,7 @@ showArchive archive; Format.print_flush(); **) - let archiveHash = checkArchive true Path.empty archive 0 in + let archiveHash = checkArchive true [] archive 0 in storeArchiveLocal (Os.fileInUnisonDir newName) root archive archiveHash magic; Lwt.return (Some archiveHash) From vouillon at seas.upenn.edu Fri Jun 19 11:44:18 2009 From: vouillon at seas.upenn.edu (vouillon@seas.upenn.edu) Date: Fri, 19 Jun 2009 11:44:18 -0400 Subject: [Unison-hackers] [unison-svn] r360 - trunk/src Message-ID: <200906191544.n5JFiIph019759@yaws.seas.upenn.edu> Author: vouillon Date: 2009-06-19 11:44:15 -0400 (Fri, 19 Jun 2009) New Revision: 360 Modified: trunk/src/RECENTNEWS trunk/src/abort.ml trunk/src/abort.mli trunk/src/copy.ml trunk/src/files.ml trunk/src/mkProjectInfo.ml trunk/src/transport.ml trunk/src/uigtk2.ml trunk/src/update.ml trunk/src/update.mli Log: * Bumped version number: incompatible protocol changes * 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. * Save a copy of a failed transfer only when the source file is unchanged. * Function Trace.log is not called anymore from Copy.tryCopyMovedFile as Trace.log performs a callback to the client inside a Lwt_unix.run event loop, which introduces spurious synchronization between threads. Instead, the function returns a message which is sent back to the client. * Code reorganization in files.ml/update.ml to minimize the number of network roundtrips. Modified: trunk/src/RECENTNEWS =================================================================== --- trunk/src/RECENTNEWS 2009-06-19 14:13:03 UTC (rev 359) +++ trunk/src/RECENTNEWS 2009-06-19 15:44:15 UTC (rev 360) @@ -1,3 +1,26 @@ +CHANGES FROM VERSION 2.36.-27 + +* Bumped version number: incompatible protocol changes + +* 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. +* Save a copy of a failed transfer only when the source file is + unchanged. +* Function Trace.log is not called anymore from Copy.tryCopyMovedFile + as Trace.log performs a callback to the client inside a Lwt_unix.run + event loop, which introduces spurious synchronization between + threads. Instead, the function returns a message which is sent back + to the client. +* Code reorganization in files.ml/update.ml to minimize the number of + network roundtrips. + +------------------------------- CHANGES FROM VERSION 2.35.-17 * Various small changes Modified: trunk/src/abort.ml =================================================================== --- trunk/src/abort.ml 2009-06-19 14:13:03 UTC (rev 359) +++ trunk/src/abort.ml 2009-06-19 15:44:15 UTC (rev 360) @@ -15,21 +15,45 @@ along with this program. If not, see . *) - let debug = Trace.debug "abort" -let files = ref ([] : Uutil.File.t list) +(****) + +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 to 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 () = files := []; abortAll := false +let reset () = Hashtbl.clear files; abortAll := false (****) let file id = debug (fun() -> Util.msg "Aborting line %s\n" (Uutil.File.toString id)); - files := id :: !files + bumpErrorCount id let all () = abortAll := true @@ -37,33 +61,10 @@ let check id = debug (fun() -> Util.msg "Checking line %s\n" (Uutil.File.toString id)); - if !abortAll || Safelist.mem id !files then begin + 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" - -let (>>=) = Lwt.bind - -let mergeErrors id e runningThreads = - if not (testException e) then file id; - match e with - Util.Transient _ -> - let e = ref e in - Lwt_util.iter - (fun act -> - Lwt.catch - (fun () -> act >>= fun _ -> Lwt.return ()) - (fun e' -> - match e' with - Util.Transient _ -> - if testException !e then e := e'; - Lwt.return () - | _ -> - Lwt.fail e')) - runningThreads >>= fun () -> - Lwt.fail !e - | _ -> - Lwt.fail e Modified: trunk/src/abort.mli =================================================================== --- trunk/src/abort.mli 2009-06-19 14:13:03 UTC (rev 359) +++ trunk/src/abort.mli 2009-06-19 15:44:15 UTC (rev 360) @@ -13,8 +13,3 @@ (* Test whether the exeption is an abort exception. *) val testException : exn -> bool - -(* When one thread has failed (in a non-fatal way), this function will - abort the current transfer and wait for all other threads in the - list to terminate before continuing *) -val mergeErrors : Uutil.File.t -> exn -> 'a Lwt.t list -> 'b Lwt.t Modified: trunk/src/copy.ml =================================================================== --- trunk/src/copy.ml 2009-06-19 14:13:03 UTC (rev 359) +++ trunk/src/copy.ml 2009-06-19 15:44:15 UTC (rev 360) @@ -127,23 +127,31 @@ let info = Fileinfo.get false fspathTo pathTo in let fp' = Os.fingerprint fspathTo pathTo info in if fp' <> fp then begin - 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.return (Failure (Printf.sprintf - "The file %s was incorrectly transferred (fingerprint mismatch in %s) \ - -- temp file saved as %s" - (Path.toString pathTo) - (Os.reasonForFingerprintMismatch fp fp') - (Fspath.toDebugString (Fspath.concat fspathTo savepath)))) + Lwt.return (Failure (Os.reasonForFingerprintMismatch fp fp')) end else Lwt.return (Success 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 = @@ -202,7 +210,6 @@ Uutil.readWriteBounded inFd outFd fileLength (fun l -> use_id (fun id -> - Abort.check id; Uutil.showProgress id (Uutil.Filesize.ofInt l) "l")); close_in inFd; close_out outFd) @@ -228,22 +235,6 @@ (****) -(* BCP '06: This is a hack to work around a bug on the Windows platform - that causes lightweight threads on the server to hang. I conjecture that - the problem has to do with the RPC mechanism, which was used here to - make a call *back* from the server to the client inside Trace.log so that - the log message would be appended to the log file on the client. *) -(* BCP '08: Jerome thinks that printing these messages using Util.msg - may be causing the dreaded "assertion failure in remote.ml," which - happens only on windows and seems correlated with the xferbycopying - switch. The conjecture is that some windows ssh servers may combine - the stdout and stderr streams, which would result in these messages - getting interleaved with Unison's RPC protocol stream. *) -let loggit s = - if Prefs.read Globals.someHostIsRunningWindows - then () (* Util.msg "%s" *) - else Trace.log s - let tryCopyMovedFile fspathTo pathTo realPathTo update desc fp ress id = if not (Prefs.read Xferhint.xferbycopying) then None else Util.convertUnixErrorsToTransient "tryCopyMovedFile" (fun() -> @@ -253,10 +244,6 @@ None -> None | Some (candidateFspath, candidatePath) -> - loggit (Printf.sprintf - "Shortcut: copying %s from local file %s\n" - (Path.toString realPathTo) - (Path.toString candidatePath)); debug (fun () -> Util.msg "tryCopyMovedFile: found match at %s,%s. Try local copying\n" @@ -272,33 +259,36 @@ if isTransferred then begin debug (fun () -> Util.msg "tryCopyMoveFile: success.\n"); Xferhint.insertEntry (fspathTo, pathTo) fp; - Some info + let msg = + Printf.sprintf + "Shortcut: copied %s from local file %s\n" + (Path.toString realPathTo) + (Path.toString candidatePath) + in + Some (info, msg) end else begin debug (fun () -> - Util.msg "tryCopyMoveFile: candidate file modified!"); + Util.msg "tryCopyMoveFile: candidate file %s modified!\n" + (Path.toString candidatePath)); Xferhint.deleteEntry (candidateFspath, candidatePath); Os.delete fspathTo pathTo; - loggit (Printf.sprintf - "Shortcut didn't work because %s was modified\n" - (Path.toString candidatePath)); None end end else begin - loggit (Printf.sprintf - "Shortcut didn't work because %s disappeared!\n" - (Path.toString candidatePath)); + debug (fun () -> + Util.msg "tryCopyMoveFile: candidate file %s disappeared!\n" + (Path.toString candidatePath)); Xferhint.deleteEntry (candidateFspath, candidatePath); None end with Util.Transient s -> debug (fun () -> - Util.msg "tryCopyMovedFile: local copy didn't work [%s]" s); + Util.msg + "tryCopyMovedFile: local copy from %s didn't work [%s]" + (Path.toString candidatePath) s); Xferhint.deleteEntry (candidateFspath, candidatePath); Os.delete fspathTo pathTo; - loggit (Printf.sprintf - "Local copy of %s failed\n" - (Path.toString candidatePath)); None) (****) @@ -345,11 +335,13 @@ (fun () -> streamTransferInstruction conn (fun processTransferInstructionRemotely -> + (* We abort the file transfer on error if it has not + already started *) + if fileKind = `DATA then Abort.check id; let infd = openFileIn fspathFrom pathFrom fileKind in lwt_protect (fun () -> let showProgress count = - Abort.check id; Uutil.showProgress id (Uutil.Filesize.ofInt count) "r" in let compr = match biOpt with @@ -397,9 +389,12 @@ end (* Lazy creation of the destination file *) -let destinationFd fspath path kind len outfd = +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 = `DATA then Abort.check id; let fd = openFileOut fspath path kind len in outfd := Some fd; fd @@ -414,7 +409,6 @@ let outfd = ref None in let infd = ref None in let showProgress count = - Abort.check id; Uutil.showProgress id (Uutil.Filesize.ofInt count) "r" in let (bi, decompr) = match update with @@ -443,7 +437,7 @@ fun ti -> let fd = destinationFd - fspathTo pathTo fileKind srcFileSize outfd in + fspathTo pathTo fileKind srcFileSize outfd id in let eof = Transfer.Rsync.rsyncDecompress ifd fd showProgress ti in @@ -452,7 +446,8 @@ (None, (* Simple generic decompressor *) fun ti -> - let fd = destinationFd fspathTo pathTo fileKind srcFileSize outfd in + let fd = + destinationFd fspathTo pathTo fileKind srcFileSize outfd id in let eof = Transfer.receive fd showProgress ti in if eof then begin close_out fd; outfd := None end) in @@ -670,14 +665,14 @@ "%s/%s has already been transferred\n" (Fspath.toDebugString fspathTo) (Path.toString pathTo)); setFileinfo fspathTo pathTo realPathTo update desc; - Lwt.return (`DONE (Success info)) + Lwt.return (`DONE (Success info, None)) end else match tryCopyMovedFile fspathTo pathTo realPathTo update desc fp ress id with - Some info -> + Some (info, msg) -> (* Transfer was performed by copying *) - Lwt.return (`DONE (Success info)) + Lwt.return (`DONE (Success info, Some msg)) | None -> if shouldUseExternalCopyprog update desc then Lwt.return (`EXTERNAL (prepareExternalTransfer fspathTo pathTo)) @@ -685,7 +680,7 @@ reallyTransferFile connFrom fspathFrom pathFrom fspathTo pathTo realPathTo update desc fp ress id >>= fun status -> - Lwt.return (`DONE status) + Lwt.return (`DONE (status, None)) end let transferFileOnRoot = @@ -702,15 +697,19 @@ 8 (* Read buffer *) let transferFile - rootFrom pathFrom rootTo fspathTo pathTo realPathTo - update desc fp ress id = + 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 -> + `DONE (status, msg) -> + begin match msg with + Some msg -> Trace.log msg + | None -> () + end; Lwt.return status | `EXTERNAL useExistingTarget -> transferFileUsingExternalCopyprog @@ -759,4 +758,5 @@ We check this before reporting a failure *) checkContentsChange rootFrom pathFrom desc fp stamp ress true >>= fun () -> - Lwt.fail (Util.Transient reason) + (* This function always fails! *) + saveTempFileOnRoot rootTo (pathTo, realPathTo, reason) Modified: trunk/src/files.ml =================================================================== --- trunk/src/files.ml 2009-06-19 14:13:03 UTC (rev 359) +++ trunk/src/files.ml 2009-06-19 15:44:15 UTC (rev 360) @@ -69,74 +69,78 @@ let processCommitLogs() = Lwt_unix.run (Globals.allHostsIter (fun h -> processCommitLogOnHost h ())) - + (* ------------------------------------------------------------ *) - -let deleteLocal (fspath, (workingDirOpt, path)) = - (* when the workingDirectory is set, we are dealing with a temporary file *) - (* so we don't call the stasher in this case. *) - begin match workingDirOpt with - Some p -> - debug (fun () -> Util.msg "deleteLocal [%s] (%s, %s)\n" (Fspath.toDebugString fspath) (Fspath.toDebugString p) (Path.toString path)); - Os.delete p path - | None -> - debug (fun () -> Util.msg "deleteLocal [%s] (None, %s)\n" (Fspath.toDebugString fspath) (Path.toString path)); - Stasher.backup fspath path `AndRemove - end; + +let deleteLocal (fspathTo, (pathTo, ui)) = + debug (fun () -> + Util.msg "deleteLocal [%s] (None, %s)\n" + (Fspath.toDebugString fspathTo) (Path.toString pathTo)); + let localPathTo = Update.translatePathLocal fspathTo pathTo in + (* Make sure the target is unchanged first *) + (* (There is an unavoidable race condition here.) *) + Update.checkNoUpdates fspathTo localPathTo ui; + Stasher.backup fspathTo localPathTo `AndRemove; + (* Archive update must be done last *) + Update.replaceArchiveLocal fspathTo localPathTo Update.NoArchive; Lwt.return () - -let performDelete = Remote.registerRootCmd "delete" deleteLocal - -(* FIX: maybe we should rename the destination before making any check ? *) + +let deleteOnRoot = Remote.registerRootCmd "delete" deleteLocal + let delete rootFrom pathFrom rootTo pathTo ui = - Update.transaction (fun id -> - Update.replaceArchive rootFrom pathFrom Update.NoArchive id - >>= (fun _ -> - Update.replaceArchive rootTo pathTo Update.NoArchive id - >>= (fun localPathTo -> - (* Make sure the target is unchanged *) - (* (There is an unavoidable race condition here.) *) - Update.checkNoUpdates rootTo pathTo ui >>= (fun () -> - performDelete rootTo (None, localPathTo))))) - + deleteOnRoot rootTo (pathTo, ui) >>= fun _ -> + Update.replaceArchive rootFrom pathFrom Update.NoArchive + (* ------------------------------------------------------------ *) - -let setPropRemote = + +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 - "setProp" - (fun (fspath, (workingDir, path, kind, newDesc)) -> - Fileinfo.set workingDir path kind newDesc; - Lwt.return ()) - -let setPropRemote2 = - Remote.registerRootCmd - "setProp2" - (fun (fspath, (path, kind, newDesc)) -> - let (workingDir,realPath) = Fspath.findWorkingDir fspath path in - Fileinfo.set workingDir realPath kind newDesc; - Lwt.return ()) - + "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 fromRoot fromPath toRoot toPath newDesc oldDesc uiFrom uiTo = +let setProp rootFrom pathFrom rootTo pathTo newDesc oldDesc uiFrom uiTo = debug (fun() -> Util.msg "setProp %s %s %s\n %s %s %s\n" - (root2string fromRoot) (Path.toString fromPath) + (root2string rootFrom) (Path.toString pathFrom) (Props.toString newDesc) - (root2string toRoot) (Path.toString toPath) + (root2string rootTo) (Path.toString pathTo) (Props.toString oldDesc)); - Update.transaction (fun id -> - Update.updateProps fromRoot fromPath None uiFrom id >>= (fun _ -> - (* [uiTo] provides the modtime while [desc] provides the other - file properties *) - Update.updateProps toRoot toPath (Some newDesc) uiTo id >>= - (fun toLocalPath -> - setPropRemote2 toRoot (toLocalPath, `Update oldDesc, newDesc)))) - + setPropOnRoot rootTo (pathTo, uiTo, newDesc, oldDesc) >>= fun _ -> + updateProps rootFrom pathFrom None uiFrom + (* ------------------------------------------------------------ *) -let mkdirRemote = +let mkdirOnRoot = Remote.registerRootCmd "mkdir" (fun (fspath,(workingDir,path)) -> @@ -155,18 +159,32 @@ Lwt.return (false, (Fileinfo.get false workingDir path).Fileinfo.desc) end) -let mkdir onRoot workingDir path = mkdirRemote onRoot (workingDir,path) +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 renameLocal (root, (localTargetPath, fspath, pathFrom, pathTo)) = - debug (fun () -> Util.msg "Renaming %s to %s in %s; root is %s\n" - (Path.toString pathFrom) - (Path.toString pathTo) - (Fspath.toDebugString fspath) - (Fspath.toDebugString root)); - let source = Fspath.concat fspath pathFrom in - let target = Fspath.concat fspath pathTo in + +let performRename fspathTo localPathTo workingDir pathFrom pathTo = + 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)) @@ -180,9 +198,8 @@ 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 - + 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 @@ -190,7 +207,7 @@ 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 = + let moveFirst = match (filetypeFrom, filetypeTo) with | (_, `ABSENT) -> false | ((`FILE | `SYMLINK), @@ -198,13 +215,13 @@ | _ -> true (* Safe default *) in if moveFirst then begin debug (fun() -> Util.msg "rename: moveFirst=true\n"); - let tmpPath = Os.tempPath fspath pathTo in - let temp = Fspath.concat fspath tmpPath in + let 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 root localTargetPath `ByCopying; + Stasher.backup fspathTo localPathTo `ByCopying; writeCommitLog source target temp'; Util.finalize (fun() -> (* If the first rename fails, the log can be removed: the @@ -228,22 +245,20 @@ Os.delete temp Path.empty end else begin debug (fun() -> Util.msg "rename: moveFirst=false\n"); - Stasher.backup root localTargetPath `ByCopying; + Stasher.backup fspathTo localPathTo `ByCopying; Os.rename "renameLocal(3)" source Path.empty target Path.empty; - debug (fun() -> + debug (fun() -> if filetypeFrom = `FILE then Util.msg - "Contents of %s after renaming = %s\n" + "Contents of %s after renaming = %s\n" (Fspath.toDebugString target) (Fingerprint.toString (Fingerprint.file target Path.empty))); - end; - Lwt.return ()) - -let renameOnHost = Remote.registerRootCmd "rename" renameLocal - + end) + (* FIX: maybe we should rename the destination before making any check ? *) -(* FIX: When this code was originally written, we assumed that the - checkNoUpdates would happen immediately before the renameOnHost, so that +(* 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 @@ -252,15 +267,28 @@ check that their assumptions had not been violated and then switch the temp file into place, but remain able to roll back if something fails either locally or on the other side. *) -let rename root pathInArchive localPath workingDir pathOld pathNew ui = +let renameLocal + (fspathTo, (localPathTo, workingDir, pathFrom, pathTo, ui, archOpt)) = + (* Make sure the target is unchanged, then do the rename. + (Note that there is an unavoidable race condition here...) *) + Update.checkNoUpdates fspathTo localPathTo ui; + performRename fspathTo localPathTo workingDir pathFrom pathTo; + (* Archive update must be done last *) + begin match archOpt with + Some archTo -> Stasher.stashCurrentVersion fspathTo localPathTo None; + Update.replaceArchiveLocal fspathTo localPathTo archTo + | None -> () + end; + Lwt.return () + +let renameOnHost = Remote.registerRootCmd "rename" renameLocal + +let rename root pathInArchive localPath workingDir pathOld pathNew ui archOpt = debug (fun() -> Util.msg "rename(root=%s, pathOld=%s, pathNew=%s)\n" (root2string root) (Path.toString pathOld) (Path.toString pathNew)); - (* Make sure the target is unchanged, then do the rename. - (Note that there is an unavoidable race condition here...) *) - Update.checkNoUpdates root pathInArchive ui >>= (fun () -> - renameOnHost root (localPath, workingDir, pathOld, pathNew)) + renameOnHost root (localPath, workingDir, pathOld, pathNew, ui, archOpt) (* ------------------------------------------------------------ *) @@ -291,18 +319,29 @@ (* ------------------------------------------------------------ *) -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 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)); @@ -358,6 +397,9 @@ (* Calculate target paths *) setupTargetPaths rootTo pathTo >>= fun (workingDir, realPathTo, tempPathTo, localPathTo) -> + (* 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 *) @@ -369,87 +411,110 @@ Util.msg "copyRec %s --> %s (really to %s)\n" (Path.toString pFrom) (Path.toString pTo) (Path.toString realPTo)); - match f with - Update.ArchiveFile (desc, dig, stamp, ress) -> - Lwt_util.run_in_region copyReg 1 (fun () -> - Abort.check id; - let stmp = if Update.useFastChecking () then Some stamp else None in - Copy.file - rootFrom pFrom rootTo workingDir pTo realPTo - update desc dig stmp ress id - >>= fun info -> - let ress' = Osx.stamp info.Fileinfo.osX in - Lwt.return - (Update.ArchiveFile (Props.override info.Fileinfo.desc desc, - dig, 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)); - mkdir rootTo workingDir pTo) >>= fun (alreadyThere, initialDesc) -> - Abort.check id; - begin if alreadyThere then - let childNames = - Update.NameMap.fold (fun nm _ l -> nm :: l) children [] in - deleteSpuriousChildren rootTo (workingDir, pTo, childNames) - else - Lwt.return () - end >>= fun () -> - Abort.check id; - let runningThreads = ref [] in - Lwt.catch - (fun () -> - let ch = + Lwt.catch + (fun () -> + match f with + Update.ArchiveFile (desc, dig, 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 dig stmp ress id + >>= fun info -> + let ress' = Osx.stamp info.Fileinfo.osX in + Lwt.return + (Update.ArchiveFile (Props.override info.Fileinfo.desc desc, + dig, 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 thread : Update.archive Lwt.t = - copyRec (Path.child pFrom name) - (Path.child pTo name) - (Path.child realPTo name) - child - in - runningThreads := thread :: !runningThreads; - thread) + copyRec (Path.child pFrom name) + (Path.child pTo name) + (Path.child realPTo name) + child) children in + (* We collect the thread results *) Update.NameMap.fold - (fun nm arThr chThr -> - arThr >>= fun ar -> - chThr >>= fun ch -> - Lwt.return (Update.NameMap.add nm ar ch)) - ch - (Lwt.return Update.NameMap.empty)) - (fun e -> - (* If one thread fails (in a non-fatal way), we wait for - all other threads to terminate before continuing *) - Abort.mergeErrors id e !runningThreads) - >>= fun newChildren -> - Lwt_util.run_in_region copyReg 1 (fun () -> - (* We use the actual file permissions so as to preserve - inherited bits *) - Abort.check id; - setPropRemote rootTo - (workingDir, pTo, `Set initialDesc, desc)) >>= fun () -> - Lwt.return (Update.ArchiveDir (desc, newChildren)) - | Update.NoArchive -> - assert false + (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 - Update.transaction (fun id -> - (* Update the archive on the source replica (but don't commit - the changes yet) and return the part of the new archive - corresponding to this path *) - Update.updateArchive rootFrom pathFrom uiFrom id - >>= fun (localPathFrom, archFrom) -> - copyRec localPathFrom tempPathTo realPathTo archFrom >>= fun archTo -> - Update.replaceArchive rootTo pathTo archTo id >>= fun _ -> - rename rootTo pathTo localPathTo workingDir tempPathTo realPathTo uiTo) + (* 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 pathTo localPathTo workingDir tempPathTo realPathTo uiTo + (Some archTo) >>= 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 (* ------------------------------------------------------------ *) @@ -624,7 +689,7 @@ (Local, fspathFrom) pathFrom rootTo workingDirForCopy tempPathTo realPathTo `Copy newprops fp None stamp id >>= fun info -> rename rootTo pathTo localPathTo workingDirForCopy tempPathTo realPathTo - uiTo ) + uiTo None) let keeptempfilesaftermerge = Prefs.createBool @@ -899,13 +964,9 @@ (Props.get (Fs.stat arch_fspath) infoarch.osX, dig, Fileinfo.stamp (Fileinfo.get true arch_fspath Path.empty), Osx.stamp infoarch.osX) in - Update.transaction - (fun transid -> - Update.replaceArchive root1 path new_archive_entry transid - >>= fun _ -> - Update.replaceArchive root2 path new_archive_entry transid - >>= fun _ -> - Lwt.return ()) + Update.replaceArchive root1 path new_archive_entry >>= fun _ -> + Update.replaceArchive root2 path new_archive_entry >>= fun _ -> + Lwt.return () end else (Lwt.return ()) )))) ) (fun _ -> Modified: trunk/src/mkProjectInfo.ml =================================================================== --- trunk/src/mkProjectInfo.ml 2009-06-19 14:13:03 UTC (rev 359) +++ trunk/src/mkProjectInfo.ml 2009-06-19 15:44:15 UTC (rev 360) @@ -5,8 +5,8 @@ let projectName = "unison" let majorVersion = 2 -let minorVersion = 35 -let pointVersionOrigin = 349 (* Revision that corresponds to point version 0 *) +let minorVersion = 36 +let pointVersionOrigin = 359 (* Revision that corresponds to point version 0 *) (* Documentation: This is a program to construct a version of the form Major.Minor.Point, @@ -165,3 +165,4 @@ + Modified: trunk/src/transport.ml =================================================================== --- trunk/src/transport.ml 2009-06-19 14:13:03 UTC (rev 359) +++ trunk/src/transport.ml 2009-06-19 15:44:15 UTC (rev 360) @@ -75,16 +75,6 @@ (fun _ -> Printf.sprintf "[END] %s\n" lwtShortDescription) -let stashCurrentVersionOnRoot: Common.root -> Path.t -> unit Lwt.t = - Remote.registerRootCmd - "stashCurrentVersion" - (fun (fspath, path) -> - Lwt.return (Stasher.stashCurrentVersion fspath (Update.translatePathLocal fspath path) None)) - -let stashCurrentVersions fromRoot toRoot path = - stashCurrentVersionOnRoot fromRoot path >>= (fun()-> - stashCurrentVersionOnRoot toRoot path) - let doAction (fromRoot,toRoot) path fromContents toContents id = Lwt_util.resize_region actionReg (Prefs.read maxthreads); (* When streaming, we can transfer many file simultaneously: @@ -125,8 +115,7 @@ ("Updating file " ^ Path.toString path) (fun () -> Files.copy (`Update (fileSize uiFrom uiTo)) - fromRoot path uiFrom toRoot path uiTo id >>= (fun()-> - stashCurrentVersions fromRoot toRoot path)) + fromRoot path uiFrom toRoot path uiTo id) | (_, _, _, uiFrom), (_, _, _, uiTo) -> logLwtNumbered ("Copying " ^ Path.toString path ^ "\n from " ^ @@ -135,8 +124,7 @@ ("Copying " ^ Path.toString path) (fun () -> Files.copy `Copy - fromRoot path uiFrom toRoot path uiTo id >>= (fun()-> - stashCurrentVersions fromRoot toRoot path))) + fromRoot path uiFrom toRoot path uiTo id)) (fun e -> Trace.log (Printf.sprintf "Failed: %s\n" (Util.printException e)); Modified: trunk/src/uigtk2.ml =================================================================== --- trunk/src/uigtk2.ml 2009-06-19 14:13:03 UTC (rev 359) +++ trunk/src/uigtk2.ml 2009-06-19 15:44:15 UTC (rev 360) @@ -1625,7 +1625,8 @@ mainWindow#set_cell ~text:(transcodeFilename path ^ " [failed: click on this line for details]") i 4 - end + end; + if !current = Some i then updateDetails (); in let totalBytesToTransfer = ref Uutil.Filesize.zero in Modified: trunk/src/update.ml =================================================================== --- trunk/src/update.ml 2009-06-19 14:13:03 UTC (rev 359) +++ trunk/src/update.ml 2009-06-19 15:44:15 UTC (rev 360) @@ -470,9 +470,6 @@ (* archiveCache: map(rootGlobalName, archive) *) let archiveCache = Hashtbl.create 7 -(* commitAction: map(rootGlobalName * transactionId, action: unit -> unit) *) -let commitActions = Hashtbl.create 7 - (* Retrieve an archive from the cache *) let getArchive (thisRoot: string): archive = Hashtbl.find archiveCache thisRoot @@ -639,80 +636,7 @@ >>= (fun _ -> Lwt.return identicals) else Lwt.return identicals) -(* commitActions(thisRoot, id) <- action *) -let setCommitAction (thisRoot: string) (id: int) (action: unit -> unit): unit = - let key = (thisRoot, id) in - Hashtbl.replace commitActions key action -(* perform and remove the action associated with (thisRoot, id) *) -let softCommitLocal (thisRoot: string) (id: int) = - debug (fun () -> - Util.msg "Committing %d\n" id); - let key = (thisRoot, id) in - Hashtbl.find commitActions key (); - Hashtbl.remove commitActions key - -(* invoke softCommitLocal on a given root (which is possibly remote) *) -let softCommitOnRoot: Common.root -> int -> unit Lwt.t = - Remote.registerRootCmd - "softCommit" - (fun (fspath, id) -> - Lwt.return (softCommitLocal (thisRootsGlobalName fspath) id)) - -(* Commit the archive on all roots. The archive must have been updated on - all roots before that. I.e., carry out the action corresponding to [id] - on all the roots *) -let softCommit (id: int): unit Lwt.t = - Util.convertUnixErrorsToFatal "softCommit" (*XXX*) - (fun () -> - Globals.allRootsIter - (fun r -> softCommitOnRoot r id)) - -(* [rollBackLocal thisRoot id] removes the action associated with (thisRoot, - id) *) -let rollBackLocal thisRoot id = - let key = (thisRoot, id) in - try Hashtbl.remove commitActions key with Not_found -> () - -let rollBackOnRoot: Common.root -> int -> unit Lwt.t = - Remote.registerRootCmd - "rollBack" - (fun (fspath, id) -> - Lwt.return (rollBackLocal (thisRootsGlobalName fspath) id)) - -(* Rollback the archive on all roots. *) -(* I.e., remove the action associated with [id] on all roots *) -let rollBack id = - Util.convertUnixErrorsToFatal "rollBack" (*XXX*) - (fun () -> - Globals.allRootsIter - (fun r -> rollBackOnRoot r id)) - -let ids = ref 0 -let new_id () = incr ids; !ids - -type transaction = int - -(* [transaction f]: transactional execution - * [f] should take in a unique id, which it can use to `setCommitAction', - * and returns a thread. - * When the thread finishes execution, the committing action associated with - * [id] is invoked. - *) -let transaction (f: int -> unit Lwt.t): unit Lwt.t = - let id = new_id () in - Lwt.catch - (fun () -> - f id >>= (fun () -> - softCommit id)) - (fun exn -> - match exn with - Util.Transient _ -> - rollBack id >>= (fun () -> - Lwt.fail exn) - | _ -> - Lwt.fail exn) - (*****************************************************************************) (* Archive locking *) (*****************************************************************************) @@ -922,9 +846,9 @@ returns [(ar, result)], then update archive with [ar] at [rest] and return [result]. *) let rec updatePathInArchive archive fspath - (here: Path.local) (rest: Path.t) - (action: archive -> Fspath.t -> Path.local -> archive * 'c): - archive * 'c + (here: Path.local) (rest: 'a Path.path) + (action: archive -> Path.local -> archive): + archive = debugverbose (fun() -> @@ -933,7 +857,7 @@ (Path.toString here) (Path.toString rest)); match Path.deconstruct rest with None -> - action archive fspath here + action archive here | Some(name, rest') -> let (desc, name', child, otherChildren) = match archive with @@ -949,13 +873,13 @@ match updatePathInArchive child fspath (Path.child here name') rest' action with - NoArchive, res -> - if otherChildren = NameMap.empty && desc == Props.dummy then - NoArchive, res + NoArchive -> + if NameMap.is_empty otherChildren && desc == Props.dummy then + NoArchive else - ArchiveDir (desc, otherChildren), res - | child, res -> - ArchiveDir (desc, NameMap.add name' child otherChildren), res + ArchiveDir (desc, otherChildren) + | child -> + ArchiveDir (desc, NameMap.add name' child otherChildren) (*************************************************************************) (* Extract of a part of a archive *) @@ -1782,34 +1706,15 @@ | ArchiveSymlink _ | NoArchive -> arch -let updateArchiveLocal fspath path ui id = +let updateArchive fspath path ui = debug (fun() -> - Util.msg "updateArchiveLocal %s %s\n" + Util.msg "updateArchive %s %s\n" (Fspath.toDebugString fspath) (Path.toString path)); let root = thisRootsGlobalName fspath in let archive = getArchive root in - let (localPath, subArch) = getPathInArchive archive Path.empty path in - let newArch = updateArchiveRec ui (stripArchive path subArch) in - let commit () = - let archive = getArchive root in - let archive, () = - updatePathInArchive archive fspath Path.empty path - (fun _ _ _ -> newArch, ()) in - setArchiveLocal root archive in - setCommitAction root id commit; - debug (fun() -> - Util.msg "updateArchiveLocal --> %s\n" (Path.toString localPath)); - (localPath, newArch) + let (_, subArch) = getPathInArchive archive Path.empty path in + updateArchiveRec ui (stripArchive path subArch) -let updateArchiveOnRoot = - Remote.registerRootCmd - "updateArchive" - (fun (fspath, (path, ui, id)) -> - Lwt.return (updateArchiveLocal fspath path ui id)) - -let updateArchive root path ui id = - updateArchiveOnRoot root (path, ui, id) - (* This function is called for files changed only in identical ways. It only updates the archives and perhaps makes backups. *) let markEqualLocal fspath paths = @@ -1820,13 +1725,12 @@ debug (fun() -> Util.msg "markEqualLocal %s %s\n" (Fspath.toDebugString fspath) (Path.toString path)); - let arch, (subArch, localPath) = + let arch = updatePathInArchive !archive fspath Path.empty path - (fun archive _ localPath -> - let arch = updateArchiveRec (Updates (uc, New)) archive in - arch, (arch, localPath)) + (fun archive localPath -> + Stasher.stashCurrentVersion fspath localPath None; + updateArchiveRec (Updates (uc, New)) archive) in - Stasher.stashCurrentVersion fspath localPath None; archive := arch); setArchiveLocal root !archive @@ -1845,34 +1749,27 @@ Tree.map (fun n -> n) (fun (uc1,uc2) -> uc2) equals]) end -let replaceArchiveLocal fspath pathTo arch id = +let replaceArchiveLocal fspath path newArch = debug (fun() -> Util.msg "replaceArchiveLocal %s %s\n" (Fspath.toDebugString fspath) - (Path.toString pathTo) + (Path.toString path) ); let root = thisRootsGlobalName fspath in - let localPath = translatePathLocal fspath pathTo in - let commit () = - debug (fun() -> Util.msg "replaceArchiveLocal: committing\n"); - let archive = getArchive root in - let archive, () = - updatePathInArchive archive fspath Path.empty pathTo - (fun _ _ _ -> arch, ()) - in - setArchiveLocal root archive - in - setCommitAction root id commit; - localPath + 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, id)) -> - Lwt.return (replaceArchiveLocal fspath pathTo arch id)) + (fun (fspath, (pathTo, arch)) -> + replaceArchiveLocal fspath pathTo arch; + Lwt.return ()) -let replaceArchive root pathTo archive id = - replaceArchiveOnRoot root (pathTo, archive, id) +let replaceArchive root pathTo archive = + replaceArchiveOnRoot root (pathTo, archive) (* Update the archive to reflect - the last observed state of the file on disk (ui) @@ -1912,37 +1809,24 @@ end | None -> newArch -let updatePropsLocal fspath path propOpt ui id = +let updateProps fspath path propOpt ui = debug (fun() -> - Util.msg "updatePropsLocal %s %s\n" + Util.msg "updateProps %s %s\n" (Fspath.toDebugString fspath) (Path.toString path)); let root = thisRootsGlobalName fspath in - let commit () = - let archive = getArchive root in - let archive, () = - updatePathInArchive archive fspath Path.empty path - (fun arch _ _ -> doUpdateProps arch propOpt ui, ()) in - setArchiveLocal root archive in - setCommitAction root id commit; - let localPath = translatePathLocal fspath path in - localPath + let archive = getArchive root in + let archive = + updatePathInArchive archive fspath Path.empty path + (fun arch _ -> doUpdateProps arch propOpt ui) in + setArchiveLocal root archive -let updatePropsOnRoot = - Remote.registerRootCmd - "updateProps" - (fun (fspath, (path, propOpt, ui, id)) -> - Lwt.return (updatePropsLocal fspath path propOpt ui id)) - -let updateProps root path propOpt ui id = - updatePropsOnRoot root (path, propOpt, ui, id) - (*************************************************************************) (* Make sure no change has happened *) (*************************************************************************) -let checkNoUpdatesLocal fspath pathInArchive ui = +let checkNoUpdates fspath pathInArchive ui = debug (fun() -> - Util.msg "checkNoUpdatesLocal %s %s\n" + Util.msg "checkNoUpdates %s %s\n" (Fspath.toDebugString fspath) (Path.toString pathInArchive)); let archive = getArchive (thisRootsGlobalName fspath) in let (localPath, archive) = @@ -1959,12 +1843,3 @@ " (if this happens repeatedly on a file that has not been changed, \n" ^ " try running once with 'fastcheck' set to false)" else ""))) - -let checkNoUpdatesOnRoot = - Remote.registerRootCmd - "checkNoUpdates" - (fun (fspath, (pathInArchive, ui)) -> - Lwt.return (checkNoUpdatesLocal fspath pathInArchive ui)) - -let checkNoUpdates root pathInArchive ui = - checkNoUpdatesOnRoot root (pathInArchive, ui) Modified: trunk/src/update.mli =================================================================== --- trunk/src/update.mli 2009-06-19 14:13:03 UTC (rev 359) +++ trunk/src/update.mli 2009-06-19 15:44:15 UTC (rev 360) @@ -29,27 +29,17 @@ val markEqual : (Name.t, Common.updateContent * Common.updateContent) Tree.t -> unit -(* Commit in memory the last archive updates, or rollback if an exception is - raised. A commit function must have been specified on both sides before - finishing the transaction. *) -type transaction -val transaction : (transaction -> unit Lwt.t) -> unit Lwt.t - -(* Update a part of an archive *) -val updateArchive : - Common.root -> Path.t -> Common.updateItem -> transaction -> - (Path.local * archive) Lwt.t +(* 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 -> transaction -> Path.local Lwt.t +val replaceArchive : Common.root -> Path.t -> archive -> unit Lwt.t +val replaceArchiveLocal : Fspath.t -> Path.local -> archive -> unit (* Update only some permissions *) val updateProps : - Common.root -> Path.t -> Props.t option -> Common.updateItem -> - transaction -> Path.local Lwt.t + 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 *) -val checkNoUpdates : - Common.root -> Path.t -> Common.updateItem -> unit Lwt.t +val checkNoUpdates : Fspath.t -> Path.local -> Common.updateItem -> unit (* Save to disk the archive updates *) val commitUpdates : unit -> unit From Jerome.Vouillon at pps.jussieu.fr Sun Jun 21 09:07:53 2009 From: Jerome.Vouillon at pps.jussieu.fr (Jerome Vouillon) Date: Sun, 21 Jun 2009 15:07:53 +0200 Subject: [Unison-hackers] [unison-users] Unison aborts all the synchronization after a permission issue In-Reply-To: <46D5E75E-627A-4052-87E0-068A44972845@cis.upenn.edu> References: <46D5E75E-627A-4052-87E0-068A44972845@cis.upenn.edu> Message-ID: <20090621130753.GA12070@pps.jussieu.fr> Hi Benjamin, On Mon, Jun 15, 2009 at 08:11:05AM -0400, Benjamin Pierce wrote: > This is a longstanding issue. It's not a bug -- the behavior is not > only "correct" but deeply built into the spec's definition of > conflict. Of course, in practice it's often irritating, and by > hindsight we should have designed it differently! But at this point > it will take some careful thought to make it work differently, even as > an option. (If anybody is up for giving it careful thought and > creating a patch, I'd be glad to consider adding it.) I believe the following patch (against the developer version) does the right thing (*). Then, there are some user interface issues: - With this patch, errors deep inside a directory are not reported to the user. Unison should report them all while still allowing to propagate the directory. - Overwriting (or deleting) a directory with deep errors will fail during propagation. We should either forbid the user from attempting to overwrite such a directory, or relax the checks in function Update.checkNoUpdates. (Or implement partial deletion.) I will not have time to work further on this this week, though. (*) We have a change of behavior when one replica contains a directory with a deep error at some location and the other does not contain a directory there. Here are the different cases to consider: 1) Propagating the directory. a) The directory is not in the archive. If the other side is unchanged, Unison will propagate everything in the directory but the locations with an error and will update the archives accordingly. The spec without the atomicity rule allows this. (Note that, in this case, the change in function Update.updateArchiveRec does nothing as the archives contain NoArchive at the location of the error.) If the other side is changed, the user has to force the synchronization of the directory. Unison will propagate the directory and update the archives the same way. We are outside the scope of the spec, but I think Unison behaves reasonnably. (b) The directory is in the archives. In this case, the other side must have changed. So, the user has to force the synchronization of the directory and we are outside the scope of the spec. The locations with errors are going to be removed from the archives (change in Update.checkNoUpdatesRec). It is not clear whether this is the right thing to do. One could argue both ways. One may want to keep the previous archive contents as the synchronization of these locations was not performed. On the other hand, the user has chosen to propagate back the directory. Clearing the archive is a way of taking this into account. Also, this is easier to implement: this is exactly what we need for propagation in case (1.b) and in Update.checkNoUpdatesRec in case (2). 2) Propagating the contents of the other replica. Unison will not do anything by default, which is correct. Forcing the deletion of the directory will either fail if the errors are still there, or succeed if the locations corresponding to an error are now empty (thanks to the change in function Update.checkNoUpdatesRec). The spec without the atomicity rule allows to remove every unchanged part from the directory. So, what is done here is correct when we are under the scope of the spec. -- Jerome -------------- next part -------------- Index: update.ml =================================================================== --- update.ml (r?vision 360) +++ update.ml (copie de travail) @@ -1646,8 +1646,10 @@ (* the result of patching [archive] using [ui] *) let rec updateArchiveRec ui archive = match ui with - NoUpdates | Error _ -> + NoUpdates -> archive + | Error _ -> + NoArchive | Updates (uc, _) -> match uc with Absent -> Index: recon.ml =================================================================== --- recon.ml (r?vision 360) +++ recon.ml (copie de travail) @@ -214,7 +214,8 @@ () (* lifting errors in individual updates to replica problems *) -let propagateErrors (rplc: Common.replicas): Common.replicas = +let propagateErrors (rplc: Common.replicas): Common.replicas = rplc +(* match rplc with Problem _ -> rplc @@ -228,6 +229,7 @@ Problem ("[root 2]: " ^ err) with UpdateError err -> Problem ("[root 1]: " ^ err) +*) type singleUpdate = Rep1Updated | Rep2Updated From mattboll at penia.org Tue Jun 23 10:38:14 2009 From: mattboll at penia.org (Matthieu Bollot) Date: Tue, 23 Jun 2009 16:38:14 +0200 Subject: [Unison-hackers] internationalization In-Reply-To: References: <1245311817.15808.6.camel@katya.penia.org> Message-ID: <1245767894.3914.208.camel@katya.penia.org> > Maybe next week, ping me if I forgot. $ ping ;)