Skip to content
Newer
Older
100644 202 lines (190 sloc) 7.45 KB
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
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 Jun 28, 2011
66 let database_reconnect = var "database_reconnect"
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
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 Jun 22, 2011
82 let debug_xml = var "debug_xml"
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
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 Jun 28, 2011
104 let low_level_db_log = var "low_level_db_log"
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
105 let no_access_log = var "no_access_log"
106 let no_database_upgrade = var "no_database_upgrade"
107 let no_flood_prevention = var "no_flood_prevention"
108 let no_server_info = var "no_server_info"
109 let nocache = var "nocache"
110 let object_debug = var "object_debug"
111 let ocamldep_show_logs = var "ocamldep_show_logs"
112 let omanager_debug = var "omanager_debug"
113 let opacapi_loose = var "opacapi_loose"
114 let opadoc = var "opadoc"
115 let opatop_annot = var "opatop_annot"
116 let opatop_expr = var "opatop_expr"
117 let opatop_hook = var "opatop_hook"
118 let opatop_unvalrec = var "opatop_unvalrec"
119 let parser_cache_debug = var "parser_cache_debug"
120 let patterns_normalize = var "patterns_normalize"
121 let patterns_real_patas = var "patterns_real_patas"
122 let ping_debug = var "ping_debug"
123 let ppdebug = var "ppdebug"
124 let protocol_debug = var "protocol_debug"
125 let qmlc_no_magic = var "qmlc_no_magic"
126 let qmltop_time = var "qmltop_time"
127 let redundancy = var "redundancy"
128 let reorder = var "reorder"
129 let resource_tracker_debug = var "resource_tracker_debug"
130 let rpc_alt_skeleton = var "rpc_alt_skeleton"
131 let rpc_debug = var "rpc_debug"
132 let sa_dependencies = var "sa_dependencies"
133 let sa_printer_annot = var "sa_printer_annot"
134 let sa_printer_ty = var "sa_printer_ty"
135 let sa_trx = var "sa_trx"
136 let sa_xml_pattern = var "sa_xml_pattern"
137 let scheduler_debug = var "scheduler_debug"
138 let server_serialize = var "server_serialize"
139 let server_stats = var "server_stats"
140 let session_debug = var "session_debug"
141 let show_logs = var "show_logs"
142 let simplifymagic_disable = var "simplifymagic_disable"
143 let simplifymagic_failures = var "simplifymagic_failures"
144 let slicer_cond = var "slicer_cond"
145 let slicer_debug = var "slicer_debug"
146 let slicer_time = var "slicer_time"
147 let ssl_debug = var "ssl_debug"
148 let testing = var "testing"
149 let typer = var "typer"
150 let weblib_debug = var "weblib_debug"
151 (* testers *)
152 type debug_tester = debug_var -> bool
153 let default = function Some x -> x <> "0" | None -> false
154 let null d = not (default d)
155 let defined s = s <> None
156 let undefined s = s = None
157 let equals s = function
158 | None -> false
159 | Some s' -> String.compare s s' = 0
160 let toggle = equals "1"
161 let level cond = function
162 | None -> false
163 | Some s ->
164 begin
165 match Base.int_of_string_opt s with
166 | Some i -> cond i
167 | _ -> false
168 end
169 let islevel n = level (fun i -> i = n)
170 let maxlevel n = level (fun i -> i <= n)
171 let minlevel n = level (fun i -> i >= n)
172 let contains substr = function
173 | None -> false
174 | Some envvar -> Base.String.is_contained substr envvar
175 let cont cont var = cont var
176 let is_contained str = function
177 | None -> false
178 | Some envvar -> Base.String.is_contained envvar str
179
180 let flag str = function
181 | None -> false
461365b [cleanup] Base.String: changed String.split to a much simpler String.…
Louis Gesbert authored Jun 23, 2011
182 | Some var -> List.mem str (Base.String.slice ',' var)
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
183
184 let _ =
185 match check_vars with
186 | Some "0"
187 | None -> ()
188 | Some s ->
189 let strong = s = "s" in
190 let error = ref false in
191 let iter var_equal_value =
192 let var = Base.String.left_at var_equal_value '=' in
193 if (Base.String.is_prefix "MLSTATE_" var)
194 && not (Hashtbl.mem table var)
195 then
196 begin
197 Printf.eprintf "[!] DebugVariables(MLSTATE_CHECK_VARS) -- process environment contains an unknown var :\n\t%s\n%!" var ;
198 if strong then error := true
199 end in
200 Array.iter iter (Unix.environment ());
201 if !error then (Printf.eprintf "[!] MLSTATE_CHECK_VARS=s => exit 1\n%!"; exit 1)
Something went wrong with that request. Please try again.