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
185
186
187
188
189
190
191
192
193
194
195
196
|
module VT = Vyos1x.Vytree
module CT = Vyos1x.Config_tree
module CD = Vyos1x.Config_diff
module RT = Vyos1x.Reference_tree
module FP = FilePath
type tree_source = DELETE | ADD
let tree_source_to_yojson = function
| DELETE -> `String "DELETE"
| ADD -> `String "ADD"
type status = {
success : bool;
out : string;
} [@@deriving to_yojson]
type node_data = {
script_name: string;
priority: int;
tag_value: string option;
arg_value: string option;
path: string list;
source: tree_source;
reply: status option;
} [@@deriving to_yojson]
let default_node_data = {
script_name = "";
priority = 0;
tag_value = None;
arg_value = None;
path = [];
source = ADD;
reply = Some { success = false; out = ""; };
}
type commit_data = {
session_id: string;
named_active : string option;
named_proposed : string option;
dry_run: bool;
atomic: bool;
background: bool;
init: status option;
node_list: node_data list;
} [@@deriving to_yojson]
let default_commit_data = {
session_id = "";
named_active = None;
named_proposed = None;
dry_run = false;
atomic = false;
background = false;
init = Some { success = false; out = ""; };
node_list = [];
}
let lex_order c1 c2 =
let c = Vyos1x.Util.lex_order c1.path c2.path in
match c with
| 0 ->
begin
match c1.tag_value, c2.tag_value with
| Some t1, Some t2 -> Vyos1x.Util.lexical_numeric_compare t1 t2
| _ -> 0
end
| _ as a -> a
module CI = struct
type t = node_data
let compare a b =
match compare a.priority b.priority with
| 0 -> lex_order a b
| _ as c -> c
end
module CS = Set.Make(CI)
let owner_args_from_data p o =
let oa = Pcre.split o in
let owner = FilePath.basename (List.nth oa 0) in
if List.length oa < 2 then owner, None
else
let var = List.nth oa 1 in
let res = Pcre.extract_all ~pat:"\\.\\./" var in
let var_pos = Array.length res in
let arg_value = Vyos1x.Util.get_last_n p var_pos
in owner, arg_value
let add_tag_instance cd cs tv =
CS.add { cd with tag_value = Some tv; } cs
let get_node_data rt ct src (path, cs') t =
if Vyos1x.Util.is_empty path then
(path, cs')
else
if (VT.name_of_node t) = "" then
(path, cs')
else
let rpath = List.rev path in
(* the following is critical to avoid redundant calculations for owner
of a tag node, quadratic in the number of tag node values *)
if CT.is_tag_value ct rpath then
(path, cs')
else
let rt_path = RT.refpath rt rpath in
let priority =
match RT.get_priority rt rt_path with
| None -> 0
| Some s -> int_of_string s
in
let owner = RT.get_owner rt rt_path in
match owner with
| None -> (path, cs')
| Some owner_str ->
let (own, arg) = owner_args_from_data rpath owner_str in
let c_data = { default_node_data with
script_name = own;
priority = priority;
arg_value = arg;
path = rpath;
source = src; }
in
let tag_values =
match RT.is_tag rt rt_path with
| false -> []
| true -> VT.list_children t
in
let cs =
match tag_values with
| [] -> CS.add c_data cs'
| _ -> List.fold_left (add_tag_instance c_data) cs' tag_values
in (path, cs)
let get_commit_set rt ct src =
snd (VT.fold_tree_with_path (get_node_data rt ct src) ([], CS.empty) ct)
(* for initial consistency with the legacy ordering of delete and add
queues, enforce the following subtlety: if a path in the delete tree is
an owner node, or the tag value thereof, insert in the delete queue; if
the path is in a subtree, however, insert in the add queue - cf. T5492
*)
let legacy_order del_t a b =
let shift c_data (c_del, c_add) =
let path =
match c_data.tag_value with
| None -> c_data.path
| Some v -> c_data.path @ [v]
in
match VT.is_terminal_path del_t path with
| false -> CS.remove c_data c_del, CS.add c_data c_add
| true -> c_del, c_add
in
CS.fold shift a (a, b)
let calculate_priority_lists rt at wt =
let diff = CD.diff_tree [] at wt in
let del_tree = CD.get_tagged_delete_tree diff in
let add_tree = CT.get_subtree diff ["add"] in
let cs_del' = get_commit_set rt del_tree DELETE in
let cs_add' = get_commit_set rt add_tree ADD in
let cs_del, cs_add = legacy_order del_tree cs_del' cs_add' in
List.rev (CS.elements cs_del), CS.elements cs_add
let commit_store c_data =
let out =
let func acc nd =
match nd.reply with
| None -> acc ^ "\n"
| Some r ->
match r.success with
| true -> acc ^ "\n"
| false -> acc ^ "\n" ^ r.out
in List.fold_left func "" c_data.node_list
in print_endline out
let show_commit_data at wt =
let vc =
Startup.load_daemon_config Defaults.defaults.config_file in
let rt_opt =
Startup.read_reference_tree (FP.concat vc.reftree_dir vc.reference_tree)
in
match rt_opt with
| Error msg -> msg
| Ok rt ->
let del_list, add_list =
calculate_priority_lists rt at wt
in
let sprint_node_data acc s =
acc ^ "\n" ^ (node_data_to_yojson s |> Yojson.Safe.to_string)
in
let del_out = List.fold_left sprint_node_data "" del_list in
let add_out = List.fold_left sprint_node_data "" add_list in
del_out ^ "\n" ^ add_out
|
