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