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
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
|
module CT = Vyos1x.Config_tree
module CD = Vyos1x.Config_diff
module VT = Vyos1x.Vytree
module RT = Vyos1x.Reference_tree
module D = Directories
exception Session_error of string
type cfg_op =
| CfgSet of string list * string option * CT.value_behaviour
| CfgDelete of string list * string option
type world = {
mutable running_config: CT.t;
mutable reference_tree: RT.t;
vyconf_config: Vyconf_config.t;
dirs: Directories.t
}
type session_data = {
proposed_config : CT.t;
modified: bool;
conf_mode: bool;
changeset: cfg_op list;
client_app: string;
user: string;
}
let make world client_app user = {
proposed_config = world.running_config;
modified = false;
conf_mode = false;
changeset = [];
client_app = client_app;
user = user
}
let string_of_op op =
match op with
| CfgSet (path, value, _) ->
let path_str = Vyos1x.Util.string_of_list path in
(match value with
| None -> Printf.sprintf "set %s" path_str
| Some v -> Printf.sprintf "set %s \"%s\"" path_str v)
| CfgDelete (path, value) ->
let path_str = Vyos1x.Util.string_of_list path in
(match value with
| None -> Printf.sprintf "delete %s" path_str
| Some v -> Printf.sprintf "delete %s \"%s\"" path_str v)
let set_modified s =
if s.modified = true then s
else {s with modified = true}
let apply_cfg_op op config =
match op with
| CfgSet (path, value, value_behaviour) ->
CT.set config path value value_behaviour
| CfgDelete (path, value) ->
CT.delete config path value
let rec apply_changes changeset config =
match changeset with
| [] -> config
| c :: cs -> apply_changes cs (apply_cfg_op c config)
let validate w _s path =
try
RT.validate_path D.(w.dirs.validators) w.reference_tree path
with RT.Validation_error x -> raise (Session_error x)
let validate_tree w' t =
let validate_path w out path =
let res =
try
RT.validate_path D.(w.dirs.validators) w.reference_tree path;
out
with RT.Validation_error x -> out ^ x
in res
in
let paths = CT.value_paths_of_tree t in
let out = List.fold_left (validate_path w') "" paths in
match out with
| "" -> ()
| _ -> raise (Session_error out)
let split_path w _s path =
RT.split_path w.reference_tree path
let set w s path =
let _ = validate w s path in
let path, value = split_path w s path in
let refpath = RT.refpath w.reference_tree path in
let value_behaviour = if RT.is_multi w.reference_tree refpath then CT.AddValue else CT.ReplaceValue in
let op = CfgSet (path, value, value_behaviour) in
let config =
try
apply_cfg_op op s.proposed_config |>
(fun c -> RT.set_tag_data w.reference_tree c path) |>
(fun c -> RT.set_leaf_data w.reference_tree c path)
with CT.Useless_set ->
raise (Session_error (Printf.sprintf "Useless set, path: %s" (string_of_op op)))
in
{s with proposed_config=config; changeset=(op :: s.changeset)}
let delete w s path =
let path, value = split_path w s path in
let op = CfgDelete (path, value) in
let config = apply_cfg_op op s.proposed_config in
{s with proposed_config=config; changeset=(op :: s.changeset)}
let discard w s =
{s with proposed_config=w.running_config}
let session_changed w s =
(* structural equality test requires consistent ordering, which is
* practised, but may be unreliable; test actual difference
*)
let diff = CD.diff_tree [] w.running_config s.proposed_config in
let add_tree = CT.get_subtree diff ["add"] in
let del_tree = CT.get_subtree diff ["del"] in
(del_tree <> CT.default) || (add_tree <> CT.default)
let load w s file =
let ct = Vyos1x.Config_file.load_config file in
match ct with
| Error e -> raise (Session_error (Printf.sprintf "Error loading config: %s" e))
| Ok config ->
validate_tree w config; {s with proposed_config=config;}
let save w s file =
let ct = w.running_config in
let res = Vyos1x.Config_file.save_config ct file in
match res with
| Error e -> raise (Session_error (Printf.sprintf "Error saving config: %s" e))
| Ok () -> s
let get_value w s path =
if not (VT.exists s.proposed_config path) then
raise (Session_error ("Config path does not exist"))
else let refpath = RT.refpath w.reference_tree path in
if not (RT.is_leaf w.reference_tree refpath) then
raise (Session_error "Cannot get a value of a non-leaf node")
else if (RT.is_multi w.reference_tree refpath) then
raise (Session_error "This node can have more than one value")
else if (RT.is_valueless w.reference_tree refpath) then
raise (Session_error "This node can have more than one value")
else CT.get_value s.proposed_config path
let get_values w s path =
if not (VT.exists s.proposed_config path) then
raise (Session_error ("Config path does not exist"))
else let refpath = RT.refpath w.reference_tree path in
if not (RT.is_leaf w.reference_tree refpath) then
raise (Session_error "Cannot get a value of a non-leaf node")
else if not (RT.is_multi w.reference_tree refpath) then
raise (Session_error "This node can have only one value")
else CT.get_values s.proposed_config path
let list_children w s path =
if not (VT.exists s.proposed_config path) then
raise (Session_error ("Config path does not exist"))
else let refpath = RT.refpath w.reference_tree path in
if (RT.is_leaf w.reference_tree refpath) then
raise (Session_error "Cannot list children of a leaf node")
else VT.children_of_path s.proposed_config path
let exists _w s path =
VT.exists s.proposed_config path
let show_config _w s path fmt =
let open Vyconf_connect.Vyconf_pbt in
if (path <> []) && not (VT.exists s.proposed_config path) then
raise (Session_error ("Path does not exist"))
else
let node = s.proposed_config in
match fmt with
| Curly -> CT.render_at_level node path
| Json ->
let node =
(match path with [] -> s.proposed_config |
_ as ps -> VT.get s.proposed_config ps) in
CT.to_yojson node |> Yojson.Safe.pretty_to_string
|
