adam@1848
|
1 (* Copyright (c) 2008-2011, 2013, Adam Chlipala
|
adamc@764
|
2 * All rights reserved.
|
adamc@764
|
3 *
|
adamc@764
|
4 * Redistribution and use in source and binary forms, with or without
|
adamc@764
|
5 * modification, are permitted provided that the following conditions are met:
|
adamc@764
|
6 *
|
adamc@764
|
7 * - Redistributions of source code must retain the above copyright notice,
|
adamc@764
|
8 * this list of conditions and the following disclaimer.
|
adamc@764
|
9 * - Redistributions in binary form must reproduce the above copyright notice,
|
adamc@764
|
10 * this list of conditions and the following disclaimer in the documentation
|
adamc@764
|
11 * and/or other materials provided with the distribution.
|
adamc@764
|
12 * - The names of contributors may not be used to endorse or promote products
|
adamc@764
|
13 * derived from this software without specific prior written permission.
|
adamc@764
|
14 *
|
adamc@764
|
15 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
adamc@764
|
16 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
adamc@764
|
17 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
adamc@764
|
18 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
|
adam@1682
|
19 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
|
adamc@764
|
20 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
|
adamc@764
|
21 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
adamc@764
|
22 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
|
adamc@764
|
23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
adamc@764
|
24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
adamc@764
|
25 * POSSIBILITY OF SUCH DAMAGE.
|
adamc@764
|
26 *)
|
adamc@764
|
27
|
adamc@764
|
28 signature SETTINGS = sig
|
adam@1682
|
29
|
ezyang@1739
|
30 (* XXX these should be unit -> string too *)
|
ezyang@1739
|
31 val configBin : string ref
|
ezyang@1739
|
32 val configLib : string ref
|
ezyang@1739
|
33 val configSrcLib : string ref
|
ezyang@1739
|
34 val configInclude : string ref
|
ezyang@1739
|
35 val configSitelisp : string ref
|
ezyang@1739
|
36
|
ezyang@1739
|
37 val libUr : unit -> string
|
ezyang@1739
|
38 val libC : unit -> string
|
ezyang@1739
|
39 val libJs : unit -> string
|
ezyang@1739
|
40
|
adamc@866
|
41 val setDebug : bool -> unit
|
adamc@866
|
42 val getDebug : unit -> bool
|
adam@1682
|
43
|
ezyang@1739
|
44 val libFile : string -> string
|
adamc@866
|
45 val clibFile : string -> string
|
adamc@866
|
46
|
adamc@765
|
47 (* How do all application URLs begin? *)
|
adamc@764
|
48 val setUrlPrefix : string -> unit
|
adamc@764
|
49 val getUrlPrefix : unit -> string
|
adam@1370
|
50 val getUrlPrePrefix : unit -> string
|
adam@1637
|
51 val getUrlPrefixFull : unit -> string
|
adam@1637
|
52 (* The full prefix is the value that was set explicitly, while the "pre"
|
adam@1637
|
53 * prefix gets the protocol/host/port part and the unqualified prefix gets
|
adam@1637
|
54 * the URI. *)
|
adamc@764
|
55
|
adamc@765
|
56 (* How many seconds should the server wait before assuming a Comet client has left? *)
|
adamc@764
|
57 val setTimeout : int -> unit
|
adamc@764
|
58 val getTimeout : unit -> int
|
adamc@764
|
59
|
adamc@765
|
60 (* Which C header files are needed? *)
|
adamc@764
|
61 val setHeaders : string list -> unit
|
adamc@764
|
62 val getHeaders : unit -> string list
|
adamc@764
|
63
|
adamc@766
|
64 (* Which extra JavaScript URLs should be included? *)
|
adamc@766
|
65 val setScripts : string list -> unit
|
adamc@766
|
66 val getScripts : unit -> string list
|
adamc@766
|
67
|
adamc@765
|
68 type ffi = string * string
|
adamc@765
|
69
|
adamc@765
|
70 (* Which FFI types may be sent from clients to servers? *)
|
adamc@765
|
71 val setClientToServer : ffi list -> unit
|
adamc@765
|
72 val mayClientToServer : ffi -> bool
|
adamc@765
|
73
|
adamc@765
|
74 (* Which FFI functions have side effects? *)
|
adamc@765
|
75 val setEffectful : ffi list -> unit
|
adam@1878
|
76 val addEffectful : ffi -> unit
|
adamc@765
|
77 val isEffectful : ffi -> bool
|
adamc@765
|
78
|
adamc@1171
|
79 (* Which FFI functions should not have their calls removed or reordered, but cause no lasting effects? *)
|
adamc@1171
|
80 val setBenignEffectful : ffi list -> unit
|
adam@2010
|
81 val addBenignEffectful : ffi -> unit
|
adamc@1171
|
82 val isBenignEffectful : ffi -> bool
|
adamc@1171
|
83
|
adamc@765
|
84 (* Which FFI functions may only be run in clients? *)
|
adamc@765
|
85 val setClientOnly : ffi list -> unit
|
adam@2010
|
86 val addClientOnly : ffi -> unit
|
adamc@765
|
87 val isClientOnly : ffi -> bool
|
adamc@765
|
88
|
adamc@765
|
89 (* Which FFI functions may only be run on servers? *)
|
adamc@765
|
90 val setServerOnly : ffi list -> unit
|
adam@2010
|
91 val addServerOnly : ffi -> unit
|
adamc@765
|
92 val isServerOnly : ffi -> bool
|
adamc@765
|
93
|
adamc@765
|
94 (* Which FFI functions may be run in JavaScript? (JavaScript function names included) *)
|
adamc@765
|
95 val setJsFuncs : (ffi * string) list -> unit
|
adam@2010
|
96 val addJsFunc : ffi * string -> unit
|
adamc@765
|
97 val jsFunc : ffi -> string option
|
adam@1433
|
98 val allJsFuncs : unit -> (ffi * string) list
|
adamc@765
|
99
|
adamc@768
|
100 datatype pattern_kind = Exact | Prefix
|
adamc@768
|
101 datatype action = Allow | Deny
|
adamc@768
|
102 type rule = { action : action, kind : pattern_kind, pattern : string }
|
adamc@768
|
103
|
adamc@768
|
104 datatype path_kind = Any | Url | Table | Sequence | View | Relation | Cookie | Style
|
adam@1752
|
105 type rewrite = { pkind : path_kind, kind : pattern_kind, from : string, to : string, hyphenate : bool }
|
adamc@768
|
106
|
adamc@768
|
107 (* Rules for rewriting URLs from canonical forms *)
|
adamc@768
|
108 val setRewriteRules : rewrite list -> unit
|
adamc@768
|
109 val rewrite : path_kind -> string -> string
|
adamc@768
|
110
|
adamc@769
|
111 (* Validating URLs and MIME types *)
|
adamc@769
|
112 val setUrlRules : rule list -> unit
|
adamc@770
|
113 val getUrlRules : unit -> rule list
|
adamc@769
|
114 val checkUrl : string -> bool
|
adamc@769
|
115
|
adamc@769
|
116 val setMimeRules : rule list -> unit
|
adamc@770
|
117 val getMimeRules : unit -> rule list
|
adamc@769
|
118 val checkMime : string -> bool
|
adamc@769
|
119
|
adam@1465
|
120 val setRequestHeaderRules : rule list -> unit
|
adam@1465
|
121 val getRequestHeaderRules : unit -> rule list
|
adam@1465
|
122 val checkRequestHeader : string -> bool
|
adam@1465
|
123
|
adam@1465
|
124 val setResponseHeaderRules : rule list -> unit
|
adam@1465
|
125 val getResponseHeaderRules : unit -> rule list
|
adam@1465
|
126 val checkResponseHeader : string -> bool
|
adam@1465
|
127
|
adam@1799
|
128 val setEnvVarRules : rule list -> unit
|
adam@1799
|
129 val getEnvVarRules : unit -> rule list
|
adam@1799
|
130 val checkEnvVar : string -> bool
|
adam@1799
|
131
|
adamc@855
|
132 (* Web protocols that generated programs may speak *)
|
adamc@855
|
133 type protocol = {
|
adamc@1095
|
134 name : string, (* Call it this on the command line *)
|
adamc@1096
|
135 compile : string, (* Pass these `gcc -c' arguments *)
|
adamc@1095
|
136 linkStatic : string, (* Pass these static linker arguments *)
|
adamc@1095
|
137 linkDynamic : string,(* Pass these dynamic linker arguments *)
|
adamc@1164
|
138 persistent : bool, (* Multiple requests per process? *)
|
adamc@1164
|
139 code : unit -> Print.PD.pp_desc (* Extra code to include in C files *)
|
adamc@855
|
140 }
|
adamc@855
|
141 val addProtocol : protocol -> unit
|
adamc@856
|
142 val setProtocol : string -> unit
|
adamc@855
|
143 val currentProtocol : unit -> protocol
|
adamc@855
|
144
|
adamc@866
|
145 (* Different DBMSes *)
|
adamc@867
|
146 datatype sql_type =
|
adamc@867
|
147 Int
|
adamc@867
|
148 | Float
|
adamc@867
|
149 | String
|
adamc@1011
|
150 | Char
|
adamc@867
|
151 | Bool
|
adamc@867
|
152 | Time
|
adamc@867
|
153 | Blob
|
adamc@867
|
154 | Channel
|
adamc@867
|
155 | Client
|
adamc@867
|
156 | Nullable of sql_type
|
adamc@867
|
157
|
adamc@873
|
158 val p_sql_ctype : sql_type -> string
|
adamc@867
|
159 val isBlob : sql_type -> bool
|
adamc@870
|
160 val isNotNull : sql_type -> bool
|
adamc@867
|
161
|
adam@1293
|
162 datatype failure_mode = Error | None
|
adam@1293
|
163
|
adamc@866
|
164 type dbms = {
|
adamc@866
|
165 name : string,
|
adamc@866
|
166 (* Call it this on the command line *)
|
adam@1682
|
167 randomFunction : string,
|
adam@1682
|
168 (* DBMS's name for random number-generating function *)
|
adamc@866
|
169 header : string,
|
adamc@866
|
170 (* Include this C header file *)
|
adamc@866
|
171 link : string,
|
adamc@866
|
172 (* Pass these linker arguments *)
|
adamc@873
|
173 p_sql_type : sql_type -> string,
|
adamc@870
|
174 init : {dbstring : string,
|
adamc@870
|
175 prepared : (string * int) list,
|
adamc@870
|
176 tables : (string * (string * sql_type) list) list,
|
adamc@872
|
177 views : (string * (string * sql_type) list) list,
|
adamc@870
|
178 sequences : string list} -> Print.PD.pp_desc,
|
adamc@874
|
179 (* Define uw_client_init(), uw_db_init(), uw_db_close(), uw_db_begin(), uw_db_commit(), and uw_db_rollback() *)
|
adamc@873
|
180 query : {loc : ErrorMsg.span, cols : sql_type list,
|
adamc@880
|
181 doCols : ({loc : ErrorMsg.span, wontLeakStrings : bool, col : int, typ : sql_type} -> Print.PD.pp_desc)
|
adamc@867
|
182 -> Print.PD.pp_desc}
|
adamc@867
|
183 -> Print.PD.pp_desc,
|
adamc@867
|
184 queryPrepared : {loc : ErrorMsg.span, id : int, query : string,
|
adamc@873
|
185 inputs : sql_type list, cols : sql_type list,
|
adamc@880
|
186 doCols : ({loc : ErrorMsg.span, wontLeakStrings : bool, col : int,
|
adamc@880
|
187 typ : sql_type} -> Print.PD.pp_desc)
|
adamc@879
|
188 -> Print.PD.pp_desc,
|
adamc@879
|
189 nested : bool}
|
adamc@868
|
190 -> Print.PD.pp_desc,
|
adam@1293
|
191 dml : ErrorMsg.span * failure_mode -> Print.PD.pp_desc,
|
adamc@868
|
192 dmlPrepared : {loc : ErrorMsg.span, id : int, dml : string,
|
adam@1293
|
193 inputs : sql_type list, mode : failure_mode} -> Print.PD.pp_desc,
|
adamc@878
|
194 nextval : {loc : ErrorMsg.span, seqE : Print.PD.pp_desc, seqName : string option} -> Print.PD.pp_desc,
|
adamc@874
|
195 nextvalPrepared : {loc : ErrorMsg.span, id : int, query : string} -> Print.PD.pp_desc,
|
adamc@1073
|
196 setval : {loc : ErrorMsg.span, seqE : Print.PD.pp_desc, count : Print.PD.pp_desc} -> Print.PD.pp_desc,
|
adamc@874
|
197 sqlifyString : string -> string,
|
adamc@874
|
198 p_cast : string * sql_type -> string,
|
adamc@874
|
199 p_blank : int * sql_type -> string (* Prepared statement input *),
|
adamc@877
|
200 supportsDeleteAs : bool,
|
adamc@886
|
201 supportsUpdateAs : bool,
|
adamc@877
|
202 createSequence : string -> string,
|
adamc@878
|
203 textKeysNeedLengths : bool,
|
adamc@879
|
204 supportsNextval : bool,
|
adamc@882
|
205 supportsNestedPrepared : bool,
|
adamc@890
|
206 sqlPrefix : string,
|
adamc@1014
|
207 supportsOctetLength : bool,
|
adamc@1014
|
208 trueString : string,
|
adamc@1196
|
209 falseString : string,
|
adamc@1196
|
210 onlyUnion : bool,
|
adam@1777
|
211 nestedRelops : bool,
|
adam@1777
|
212 windowFunctions : bool
|
adamc@866
|
213 }
|
adamc@857
|
214
|
adamc@866
|
215 val addDbms : dbms -> unit
|
adamc@866
|
216 val setDbms : string -> unit
|
adamc@866
|
217 val currentDbms : unit -> dbms
|
adamc@858
|
218
|
adamc@891
|
219 val setDbstring : string option -> unit
|
adamc@891
|
220 val getDbstring : unit -> string option
|
adamc@891
|
221
|
adamc@891
|
222 val setExe : string option -> unit
|
adamc@891
|
223 val getExe : unit -> string option
|
adamc@891
|
224
|
adamc@891
|
225 val setSql : string option -> unit
|
adamc@891
|
226 val getSql : unit -> string option
|
adamc@891
|
227
|
adamc@1016
|
228 val setCoreInline : int -> unit
|
adamc@1016
|
229 val getCoreInline : unit -> int
|
adamc@1016
|
230
|
adamc@1016
|
231 val setMonoInline : int -> unit
|
adamc@1016
|
232 val getMonoInline : unit -> int
|
adamc@1016
|
233
|
adamc@1095
|
234 val setStaticLinking : bool -> unit
|
adamc@1095
|
235 val getStaticLinking : unit -> bool
|
adamc@1095
|
236
|
adamc@1114
|
237 val setDeadlines : bool -> unit
|
adamc@1114
|
238 val getDeadlines : unit -> bool
|
adamc@1114
|
239
|
adamc@1164
|
240 val setSigFile : string option -> unit
|
adamc@1164
|
241 val getSigFile : unit -> string option
|
adamc@1164
|
242
|
adamc@1183
|
243 (* Which GET-able functions should be allowed to have side effects? *)
|
adamc@1183
|
244 val setSafeGets : string list -> unit
|
adamc@1183
|
245 val isSafeGet : string -> bool
|
adamc@1183
|
246
|
adam@1294
|
247 val setOnError : (string * string list * string) option -> unit
|
adam@1294
|
248 val getOnError : unit -> (string * string list * string) option
|
adam@1307
|
249
|
adam@1307
|
250 val addLimit : string * int -> unit
|
adam@1307
|
251 val limits : unit -> (string * int) list
|
adam@1332
|
252
|
adam@1332
|
253 val setMinHeap : int -> unit
|
adam@1332
|
254 val getMinHeap : unit -> int
|
adam@1393
|
255
|
adam@1393
|
256 val addAlwaysInline : string -> unit
|
adam@1393
|
257 val checkAlwaysInline : string -> bool
|
adam@1478
|
258
|
adam@1966
|
259 val addNeverInline : string -> unit
|
adam@1966
|
260 val checkNeverInline : string -> bool
|
adam@1966
|
261
|
adam@1478
|
262 val addNoXsrfProtection : string -> unit
|
adam@1478
|
263 val checkNoXsrfProtection : string -> bool
|
adam@1629
|
264
|
adam@1629
|
265 val setTimeFormat : string -> unit
|
adam@1629
|
266 val getTimeFormat : unit -> string
|
grrwlf@1871
|
267
|
adam@1953
|
268 val getCCompiler : unit -> string
|
adam@1953
|
269 val setCCompiler : string -> unit
|
adam@1953
|
270
|
adam@1953
|
271 val setMangleSql : bool -> unit
|
adam@1953
|
272 val mangleSql : string -> string
|
adam@1953
|
273 val mangleSqlCatalog : string -> string
|
adam@1953
|
274 val mangleSqlTable : string -> string
|
adam@1956
|
275
|
adam@1956
|
276 val setIsHtml5 : bool -> unit
|
adam@1956
|
277 val getIsHtml5 : unit -> bool
|
adam@2010
|
278
|
adam@2010
|
279 val setLessSafeFfi : bool -> unit
|
adam@2010
|
280 val getLessSafeFfi : unit -> bool
|
adamc@764
|
281 end
|