unison

Fork of Unison, a bi-directional file synchronization tool
git clone git://git.laack.co/unison.git
Log | Files | Refs | README | LICENSE

case.ml (6316B)

      1 (* Unison file synchronizer: src/case.ml *)
      2 (* Copyright 1999-2020, Benjamin C. Pierce
      3 
      4     This program is free software: you can redistribute it and/or modify
      5     it under the terms of the GNU General Public License as published by
      6     the Free Software Foundation, either version 3 of the License, or
      7     (at your option) any later version.
      8 
      9     This program is distributed in the hope that it will be useful,
     10     but WITHOUT ANY WARRANTY; without even the implied warranty of
     11     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     12     GNU General Public License for more details.
     13 
     14     You should have received a copy of the GNU General Public License
     15     along with this program.  If not, see <http://www.gnu.org/licenses/>.
     16 *)
     17 
     18 
     19 (* The update detector, reconciler, and transporter behave differently       *)
     20 (* depending on whether the local and/or remote file system is case          *)
     21 (* insensitive.  This pref is set during the initial handshake if any one of *)
     22 (* the hosts is case insensitive.                                            *)
     23 let caseInsensitiveMode =
     24   Prefs.createBoolWithDefault "ignorecase"
     25     ~category:(`Advanced `Sync)
     26     "identify upper/lowercase filenames (true/false/default)"
     27     ("When set to {\\tt true}, this flag causes Unison to treat "
     28      ^ "filenames as case insensitive---i.e., files in the two "
     29      ^ "replicas whose names differ in (upper- and lower-case) `spelling' "
     30      ^ "are treated as the same file.  When the flag is set to {\\tt false}, Unison "
     31      ^ "will treat all filenames as case sensitive.  Ordinarily, when the flag is "
     32      ^ "set to {\\tt default}, "
     33      ^ "filenames are automatically taken to be case-insensitive if "
     34      ^ "either host is running Windows or OSX.  In rare circumstances it may be  "
     35      ^ "useful to set the flag manually.")
     36 
     37 (* Defining this variable as a preference ensures that it will be propagated
     38    to the other host during initialization *)
     39 let someHostIsInsensitive =
     40   Prefs.createBool "someHostIsInsensitive" false
     41     ~category:(`Internal `Pseudo)
     42     "*Pseudo-preference for internal use only" ""
     43 
     44 let unicode =
     45   Prefs.createBoolWithDefault "unicode"
     46     ~category:(`Advanced `General)
     47     "assume Unicode encoding in case insensitive mode"
     48     "When set to {\\tt true}, this flag causes Unison to perform \
     49      case insensitive file comparisons assuming Unicode encoding.  \
     50      This is the default.  When the flag is set to {\\tt false}, \
     51      Latin 1 encoding is assumed (this means that all bytes that are \
     52      not letters in Latin 1 encoding will be compared byte-for-byte, \
     53      even if they may be valid characters in some other encoding).  \
     54      When Unison runs in case sensitive mode, this flag only makes \
     55      a difference if one host is running Mac OS X.  \
     56      Under Mac OS X, it selects whether comparing the filenames up to \
     57      decomposition, or byte-for-byte."
     58 
     59 let unicodeEncoding =
     60   Prefs.createBool "unicodeEnc" false
     61     ~category:(`Internal `Pseudo)
     62     "*Pseudo-preference for internal use only" ""
     63 
     64 let useUnicode () =
     65   let pref = Prefs.read unicode in
     66   pref = `True || pref = `Default
     67 
     68 let unicodeCaseSensitive =
     69   Prefs.createBool "unicodeCS" false
     70     ~category:(`Internal `Pseudo)
     71     ~local:true
     72     "*Pseudo-preference for internal use only" ""
     73 
     74 (* During startup the client determines the case sensitivity of each root.   *)
     75 (* If any root is case insensitive, all roots must know it; we ensure this   *)
     76 (* by storing the information in a pref so that it is propagated to the      *)
     77 (* server with the rest of the prefs.                                        *)
     78 let init b someHostRunningOsX =
     79   Prefs.set someHostIsInsensitive
     80     (Prefs.read caseInsensitiveMode = `True ||
     81      (Prefs.read caseInsensitiveMode = `Default && b));
     82   Prefs.set unicodeCaseSensitive (useUnicode () && someHostRunningOsX);
     83   Prefs.set unicodeEncoding (useUnicode ())
     84 
     85 (****)
     86 
     87 type mode = Sensitive | Insensitive | UnicodeSensitive | UnicodeInsensitive
     88 
     89 (*
     90 Important invariant:
     91   if [compare s s' = 0],
     92   then [hash s = hash s'] and
     93   and  [Rx.match_string rx (normalizeMatchedString s) =
     94         Rx.match_string rx (normalizeMatchedString s')]
     95   (when [rx] has been compiled using the [caseInsensitiveMatch] mode)
     96 *)
     97 
     98 let sensitiveOps = object
     99   method mode = Sensitive
    100   method modeDesc = "case sensitive"
    101   method compare s s' = compare (s : string) s'
    102   method hash s = Uutil.hash s
    103   method normalizePattern s = s
    104   method caseInsensitiveMatch = false
    105   method normalizeMatchedString s = s
    106   method normalizeFilename s = s
    107   method badEncoding s = false
    108 end
    109 
    110 let insensitiveOps = object
    111   method mode = Insensitive
    112   method modeDesc = "Latin-1 case insensitive"
    113   method compare s s' = Util.nocase_cmp s s'
    114   method hash s = Uutil.hash (String.map Util.lowercase_latin1 s)
    115   method normalizePattern s = s
    116   method caseInsensitiveMatch = true
    117   method normalizeMatchedString s = s
    118   method normalizeFilename s = s
    119   method badEncoding s = false
    120 end
    121 
    122 let unicodeSensitiveOps = object
    123   method mode = UnicodeSensitive
    124   method modeDesc = "Unicode case sensitive"
    125   method compare s s' = Unicode.case_sensitive_compare s s'
    126   method hash s = Uutil.hash (Unicode.decompose s)
    127   method normalizePattern p = Unicode.decompose p
    128   method caseInsensitiveMatch = false
    129   method normalizeMatchedString s = Unicode.decompose s
    130   method normalizeFilename s = Unicode.compose s
    131   method badEncoding s = not (Unicode.check_utf_8 s)
    132 end
    133 
    134 let unicodeInsensitiveOps = object
    135   method mode = UnicodeInsensitive
    136   method modeDesc = "Unicode case insensitive"
    137   method compare s s' = Unicode.case_insensitive_compare s s'
    138   method hash s = Uutil.hash (Unicode.normalize s)
    139   method normalizePattern p = Unicode.normalize p
    140   method caseInsensitiveMatch = false
    141   method normalizeMatchedString s = Unicode.normalize s
    142   method normalizeFilename s = Unicode.compose s
    143   method badEncoding s = not (Unicode.check_utf_8 s)
    144 end
    145 
    146 (* Note: the dispatch must be fast *)
    147 let ops () =
    148   if Prefs.read someHostIsInsensitive then begin
    149     if Prefs.read unicodeEncoding then
    150       unicodeInsensitiveOps
    151     else
    152       insensitiveOps
    153   end else
    154     if Prefs.read unicodeCaseSensitive then
    155       unicodeSensitiveOps
    156     else
    157       sensitiveOps
    158 
    159 let caseSensitiveModeDesc = sensitiveOps#modeDesc