blob: 6d19a767061cf20f46a23e38da614629ff12125e (
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
|
open Ctypes
open Foreign
module CT = Config_tree
let make_config_tree name = Ctypes.Root.create (Config_tree.make name)
let destroy c_ptr =
Root.release c_ptr
let from_string s =
try
let config = Vyos1x_parser.config Vyos1x_lexer.token (Lexing.from_string s) in
Ctypes.Root.create config
with _ -> Ctypes.null
let render c_ptr =
Vyos1x_renderer.render (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) Config_tree.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 = Config_tree.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 *)
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 "to_string" ((ptr void) @-> returning string) render
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
end
|
