Source file logging_interface.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
open Logging
include Namespace.Unsupported
let ( |> ) a b = b a
let general_params = [
"coalesce", disable_coalesce;
"conflict", disable_conflict;
"commit", disable_conflict;
"newconn", disable_newconn;
"endconn", disable_endconn;
"transaction", disable_transaction;
]
let read _t (perms: Perms.t) (path: Store.Path.t) =
Perms.has perms Perms.CONFIGURE;
match Store.Path.to_string_list path with
| [] -> ""
| "request" :: [] -> ""
| "reply-ok" :: [] -> ""
| "reply-err" :: [] -> ""
| "request" :: x :: [] -> if List.mem x !disable_request then "1" else Store.Path.doesnt_exist path
| "reply-ok" :: x :: [] -> if List.mem x !disable_reply_ok then "1" else Store.Path.doesnt_exist path
| "reply-err" :: x :: [] -> if List.mem x !disable_reply_err then "1" else Store.Path.doesnt_exist path
| x :: [] ->
if List.mem_assoc x general_params
then if !(List.assoc x general_params) then "1" else Store.Path.doesnt_exist path
else Store.Path.doesnt_exist path
| _ -> Store.Path.doesnt_exist path
let exists t perms path = try ignore(read t perms path); true with Store.Path.Doesnt_exist _ -> false
let write _t _creator perms path value =
Perms.has perms Perms.CONFIGURE;
let f list value key = match value with
| "1" -> if not(List.mem key !list) then list := key :: !list
| _ -> raise (Invalid_argument value) in
match Store.Path.to_string_list path with
| "request" :: x :: [] -> f disable_request value x
| "reply-ok" :: x :: [] -> f disable_reply_ok value x
| "reply-err" :: x :: [] -> f disable_reply_err value x
| x :: [] ->
begin
if List.mem_assoc x general_params then
(List.assoc x general_params) := match value with
| "1" -> true
| _ -> raise (Invalid_argument value)
end
| _ -> Store.Path.doesnt_exist path
let list _t perms path =
Perms.has perms Perms.CONFIGURE;
match Store.Path.to_string_list path with
| [] -> [ "request"; "reply-ok"; "reply-err" ] @ (List.map fst (List.filter (fun (_, b) -> !b) general_params))
| "request" :: [] -> !disable_request
| "reply-ok" :: [] -> !disable_reply_ok
| "reply-err" :: [] -> !disable_reply_err
| _ -> []
let rm _t perms path =
Perms.has perms Perms.CONFIGURE;
let f list key = list := List.filter (fun x -> x <> key) !list in
match Store.Path.to_string_list path with
| "request" :: x :: [] -> f disable_request x
| "reply-ok" :: x :: [] -> f disable_reply_ok x
| "reply-err" :: x :: [] -> f disable_reply_err x
| x :: [] ->
if List.mem_assoc x general_params
then (List.assoc x general_params) := false
else Store.Path.doesnt_exist path
| _ -> Store.Path.doesnt_exist path