blob: e8e3df228278fb2528bb88c914cb268aab777413 (
plain)
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
|
open Ctypes
open Foreign
module CT = Config_tree
let error_message = ref ""
let to_json_str = fun s -> `String s
let make_config_tree name = Ctypes.Root.create (CT.make name)
let destroy c_ptr =
Root.release c_ptr
let from_string s =
try
error_message := "";
let config = Vyos1x_parser.config Vyos1x_lexer.token (Lexing.from_string s) in
Ctypes.Root.create config
with
| Failure s | Vyos1x_lexer.Error s -> error_message := s; Ctypes.null
| _ -> error_message := "Parse error"; Ctypes.null
let get_error () = !error_message
let render c_ptr =
Vyos1x_renderer.render (Root.get c_ptr)
let render_commands c_ptr =
CT.render_commands ~alwayssort:true ~sortchildren:true (Root.get c_ptr) []
let set_add_value c_ptr path value =
let ct = Root.get c_ptr in
let path = Pcre.split ~rex:(Pcre.regexp "\\s+") path in
try
let new_ct = CT.set ct path (Some value) CT.AddValue in
Root.set c_ptr new_ct;
0 (* return 0 *)
with CT.Duplicate_value -> 1
let set_replace_value c_ptr path value =
let ct = Root.get c_ptr in
let path = Pcre.split ~rex:(Pcre.regexp "\\s+") path in
let new_ct = Config_tree.set ct path (Some value) Config_tree.ReplaceValue in
Root.set c_ptr new_ct;
0 (* return 0 *)
let set_valueless c_ptr path =
let ct = Root.get c_ptr in
let path = Pcre.split ~rex:(Pcre.regexp "\\s+") path in
try
let new_ct = Config_tree.set ct path None CT.AddValue in
Root.set c_ptr new_ct;
0 (* return 0 *)
with CT.Useless_set -> 1
let delete_value c_ptr path value =
let ct = Root.get c_ptr in
let path = Pcre.split ~rex:(Pcre.regexp "\\s+") path in
try
let new_ct = CT.delete ct path (Some value) in
Root.set c_ptr new_ct;
0 (* return 0 *)
with CT.No_such_value -> 1
let delete_node c_ptr path =
let ct = Root.get c_ptr in
let path = Pcre.split ~rex:(Pcre.regexp "\\s+") path in
if not (Vytree.exists ct path) then 1 else
let new_ct = Config_tree.delete ct path None in
Root.set c_ptr new_ct;
0 (* return 0 *)
let rename_node c_ptr path newname =
let ct = Root.get c_ptr in
let path = Pcre.split ~rex:(Pcre.regexp "\\s+") path in
if not (Vytree.exists ct path) then 1 else
let new_ct = Vytree.rename ct path newname in
Root.set c_ptr new_ct;
0 (* return 0 *)
let set_tag c_ptr path =
let ct = Root.get c_ptr in
let path = Pcre.split ~rex:(Pcre.regexp "\\s+") path in
try
Root.set c_ptr (CT.set_ephemeral ct path true);
0 (* return 0 *)
with _ -> 1
let is_tag c_ptr path =
let ct = Root.get c_ptr in
let path = Pcre.split ~rex:(Pcre.regexp "\\s+") path in
if (CT.is_ephemeral ct path) then 1 else 0
let exists c_ptr path =
let ct = Root.get c_ptr in
let path = Pcre.split ~rex:(Pcre.regexp "\\s+") path in
if (Vytree.exists ct path) then 1 else 0
let list_nodes c_ptr path =
let ct = Root.get c_ptr in
let path = Pcre.split ~rex:(Pcre.regexp "\\s+") path in
try
let nodes = Vytree.children_of_path ct path in
let nodes_json = `List (List.map to_json_str nodes) in
Yojson.Safe.to_string nodes_json
with _ -> Yojson.Safe.to_string `Null
let return_value c_ptr path =
let ct = Root.get c_ptr in
let path = Pcre.split ~rex:(Pcre.regexp "\\s+") path in
try
Yojson.Safe.to_string (`String (CT.get_value ct path))
with
| CT.Node_has_no_value -> Yojson.Safe.to_string (`String "")
| _ -> Yojson.Safe.to_string `Null
let return_values c_ptr path =
let ct = Root.get c_ptr in
let path = Pcre.split ~rex:(Pcre.regexp "\\s+") path in
let to_json_str = fun s -> `String s in
try
let values = CT.get_values ct path in
let values_json = `List (List.map to_json_str values) in
Yojson.Safe.to_string values_json
with _ -> Yojson.Safe.to_string `Null
module Stubs(I : Cstubs_inverted.INTERNAL) =
struct
let () = I.internal "make" (string @-> returning (ptr void)) make_config_tree
let () = I.internal "destroy" ((ptr void) @-> returning void) destroy
let () = I.internal "from_string" (string @-> returning (ptr void)) from_string
let () = I.internal "get_error" (void @-> returning string) get_error
let () = I.internal "to_string" ((ptr void) @-> returning string) render
let () = I.internal "to_commands" ((ptr void) @-> returning string) render_commands
let () = I.internal "set_add_value" ((ptr void) @-> string @-> string @-> returning int) set_add_value
let () = I.internal "set_replace_value" ((ptr void) @-> string @-> string @-> returning int) set_replace_value
let () = I.internal "set_valueless" ((ptr void) @-> string @-> returning int) set_valueless
let () = I.internal "delete_value" ((ptr void) @-> string @-> string @-> returning int) delete_value
let () = I.internal "delete_node" ((ptr void) @-> string @-> returning int) delete_node
let () = I.internal "rename_node" ((ptr void) @-> string @-> string @-> returning int) rename_node
let () = I.internal "set_tag" ((ptr void) @-> string @-> returning int) set_tag
let () = I.internal "is_tag" ((ptr void) @-> string @-> returning int) is_tag
let () = I.internal "exists" ((ptr void) @-> string @-> returning int) exists
let () = I.internal "list_nodes" ((ptr void) @-> string @-> returning string) list_nodes
let () = I.internal "return_value" ((ptr void) @-> string @-> returning string) return_value
let () = I.internal "return_values" ((ptr void) @-> string @-> returning string) return_values
end
|
