Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 204 lines (192 sloc) 7.705 kB
fccc685 Initial open-source release
MLstate authored
1 (*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
18
19 (* THIS FILE HAS A DOCUMENTED MLI *)
20
21 type debug_var = string option
22
23 let other_mlstate_variables = ["no_embedded_lib"; "noide"]
24 let table = Hashtbl.create 100
25
26 let var var =
27 let var = "MLSTATE_" ^ (String.uppercase var) in
28 let value =
29 try
30 Some (Sys.getenv var)
31 with
32 | Not_found -> None in
33 assert (not (Hashtbl.mem table var));
34 Hashtbl.add table var value ;
35 value
36
37 let () = List.iter (fun s -> ignore (var s)) other_mlstate_variables
38 (* *PLEASE* keep in alphabetical order (here and in mli) *)
39 let add_stdlib = var "add_stdlib"
40 let badop_debug = var "badop_debug"
41 let badop_xml_import_commit_transaction_step = var "badop_xml_import_commit_transaction_step"
42 let bsl_loading = var "bsl_loading"
43 let bsl_no_restriction = var "bsl_no_restriction"
44 let bsl_projection = var "bsl_projection"
45 let bsl_register = var "bsl_register"
46 let bsl_sl = var "bsl_sl"
47 let bypass_hoisting = var "bypass_hoisting"
48 let check_vars = var "check_vars"
49 let closure_debug = var "closure_debug"
50 let closure_opt = var "closure_opt"
51 let closure_stat = var "closure_stat"
52 let const_sharing_client_float = var "const_sharing_client_float"
53 let const_sharing_client_record = var "const_sharing_client_record"
54 let const_sharing_client_remove_coerce = var "const_sharing_client_remove_coerce"
55 let const_sharing_client_string = var "const_sharing_client_string"
56 let const_sharing_server_float = var "const_sharing_server_float"
57 let const_sharing_server_record = var "const_sharing_server_record"
58 let const_sharing_server_remove_coerce = var "const_sharing_server_remove_coerce"
59 let const_sharing_server_string = var "const_sharing_server_string"
60 let cps_blocking_wait = var "cps_blocking_wait"
61 let cps_debug = var "cps_debug"
62 let cps_keep_letcont = var "cps_keep_letcont"
63 let cps_noskip = var "cps_noskip"
64 let cps_stack_trace = var "cps_stack_trace"
65 let cps_verbose = var "cps_verbose"
6ff7da0 [fix] database: adding the possibility to automatically attempt to re…
Louis Gesbert authored
66 let database_reconnect = var "database_reconnect"
fccc685 Initial open-source release
MLstate authored
67 let db3_no_final_snapshot = var "db3_no_final_snapshot"
68 let db3_transaction_limit = var "db3_transaction_limit"
69 let dbgen_always_upgrade = var "dbgen_always_upgrade"
70 let dbgen_butcher = var "dbgen_butcher"
71 let dbgen_debug = var "dbgen_debug"
72 let dbgen_flags = var "dbgen_flags"
73 let debug_db = var "debug_db"
74 let debug_db_index = var "debug_db_index"
75 let debug_db_max_delta = var "debug_db_max_delta"
76 let debug_paxos = var "debug_paxos"
77 let debug_paxos_cluster = var "debug_paxos_cluster"
78 let debug_paxos_consensus = var "debug_paxos_consensus"
79 let debug_paxos_le = var "debug_paxos_le"
80 let debug_paxos_rbr = var "debug_paxos_rbr"
81 let debug_paxos_sched = var "debug_paxos_sched"
bc2add4 [cleanup] Log: add a debug variable for xml
Raja authored
82 let debug_xml = var "debug_xml"
fccc685 Initial open-source release
MLstate authored
83 let diffing = var "diffing"
84 let effects_show = var "effects_show"
85 let expl_inst_debug = var "expl_inst_debug"
86 let expl_inst_no_memo = var "expl_inst_no_memo"
87 let expl_inst_normalize = var "expl_inst_normalize"
88 let expl_inst_opt_debug = var "expl_inst_opt_debug"
89 let expl_inst_typename = var "expl_inst_typename"
90 let libnet_cluster = var "libnet_cluster"
91 let hlnet_debug = var "hlnet_debug"
92 let hldir_debug = var "hldir_debug"
93 let http_debug = var "http_debug"
94 let http_no_cookie = var "http_no_cookie"
95 let js_imp = var "js_imp"
96 let js_match_compilation = var "js_match_compilation"
97 let js_no_split = var "js_no_split"
98 let js_no_tailcall = var "js_no_tailcall"
99 let js_renaming = var "js_renaming"
100 let js_serialize = var "js_serialize"
101 let lambda_coerce = var "lambda_coerce"
102 let lambda_correct = var "lambda_correct"
103 let lambda_debug = var "lambda_debug"
6ff7da0 [fix] database: adding the possibility to automatically attempt to re…
Louis Gesbert authored
104 let low_level_db_log = var "low_level_db_log"
1831471 [debug] mimetype: add debugVariable MIMETYPE_DEBUG and some debug
Raja authored
105 let mimetype_debug = var "mimetype_debug"
2cc8f8d @nrs135 [feature] stdlib: Added buffer reuse to Mongo.
nrs135 authored
106 let mongo_debug = var "mongo_debug"
fccc685 Initial open-source release
MLstate authored
107 let no_access_log = var "no_access_log"
108 let no_database_upgrade = var "no_database_upgrade"
109 let no_flood_prevention = var "no_flood_prevention"
110 let no_server_info = var "no_server_info"
111 let nocache = var "nocache"
112 let object_debug = var "object_debug"
113 let ocamldep_show_logs = var "ocamldep_show_logs"
114 let omanager_debug = var "omanager_debug"
115 let opacapi_loose = var "opacapi_loose"
116 let opadoc = var "opadoc"
117 let opatop_annot = var "opatop_annot"
118 let opatop_expr = var "opatop_expr"
119 let opatop_hook = var "opatop_hook"
120 let opatop_unvalrec = var "opatop_unvalrec"
121 let parser_cache_debug = var "parser_cache_debug"
122 let patterns_normalize = var "patterns_normalize"
123 let patterns_real_patas = var "patterns_real_patas"
124 let ping_debug = var "ping_debug"
125 let ppdebug = var "ppdebug"
126 let protocol_debug = var "protocol_debug"
127 let qmlc_no_magic = var "qmlc_no_magic"
128 let qmltop_time = var "qmltop_time"
129 let redundancy = var "redundancy"
130 let reorder = var "reorder"
131 let resource_tracker_debug = var "resource_tracker_debug"
132 let rpc_alt_skeleton = var "rpc_alt_skeleton"
133 let rpc_debug = var "rpc_debug"
134 let sa_dependencies = var "sa_dependencies"
135 let sa_printer_annot = var "sa_printer_annot"
136 let sa_printer_ty = var "sa_printer_ty"
137 let sa_trx = var "sa_trx"
138 let sa_xml_pattern = var "sa_xml_pattern"
139 let scheduler_debug = var "scheduler_debug"
140 let server_serialize = var "server_serialize"
141 let server_stats = var "server_stats"
142 let session_debug = var "session_debug"
143 let show_logs = var "show_logs"
144 let simplifymagic_disable = var "simplifymagic_disable"
145 let simplifymagic_failures = var "simplifymagic_failures"
146 let slicer_cond = var "slicer_cond"
147 let slicer_debug = var "slicer_debug"
148 let slicer_time = var "slicer_time"
149 let ssl_debug = var "ssl_debug"
150 let testing = var "testing"
151 let typer = var "typer"
152 let weblib_debug = var "weblib_debug"
153 (* testers *)
154 type debug_tester = debug_var -> bool
155 let default = function Some x -> x <> "0" | None -> false
156 let null d = not (default d)
157 let defined s = s <> None
158 let undefined s = s = None
159 let equals s = function
160 | None -> false
161 | Some s' -> String.compare s s' = 0
162 let toggle = equals "1"
163 let level cond = function
164 | None -> false
165 | Some s ->
166 begin
167 match Base.int_of_string_opt s with
168 | Some i -> cond i
169 | _ -> false
170 end
171 let islevel n = level (fun i -> i = n)
172 let maxlevel n = level (fun i -> i <= n)
173 let minlevel n = level (fun i -> i >= n)
174 let contains substr = function
175 | None -> false
176 | Some envvar -> Base.String.is_contained substr envvar
177 let cont cont var = cont var
178 let is_contained str = function
179 | None -> false
180 | Some envvar -> Base.String.is_contained envvar str
181
182 let flag str = function
183 | None -> false
461365b [cleanup] Base.String: changed String.split to a much simpler String.…
Louis Gesbert authored
184 | Some var -> List.mem str (Base.String.slice ',' var)
fccc685 Initial open-source release
MLstate authored
185
186 let _ =
187 match check_vars with
188 | Some "0"
189 | None -> ()
190 | Some s ->
191 let strong = s = "s" in
192 let error = ref false in
193 let iter var_equal_value =
194 let var = Base.String.left_at var_equal_value '=' in
195 if (Base.String.is_prefix "MLSTATE_" var)
196 && not (Hashtbl.mem table var)
197 then
198 begin
199 Printf.eprintf "[!] DebugVariables(MLSTATE_CHECK_VARS) -- process environment contains an unknown var :\n\t%s\n%!" var ;
200 if strong then error := true
201 end in
202 Array.iter iter (Unix.environment ());
203 if !error then (Printf.eprintf "[!] MLSTATE_CHECK_VARS=s => exit 1\n%!"; exit 1)
Something went wrong with that request. Please try again.