Commit | Line | Data |
9a4942da |
1 | use strictures 1; |
2 | use Test::More; |
3 | use DX::Solver; |
4 | use DX::SetOver; |
5ef4d923 |
5 | use DX::Observer::FromCode; |
71217e42 |
6 | use DX::Action::FromCode; |
deec7cc4 |
7 | use File::Spec; |
734376d9 |
8 | use Test::Exception; |
9a4942da |
9 | |
10 | { |
11 | package My::PathStatus; |
12 | |
13 | use Moo; |
14 | |
9c7b21a2 |
15 | with 'DX::Role::Fact'; |
16 | |
9a4942da |
17 | has path => (is => 'ro', required => 1); |
859049a3 |
18 | has info => (is => 'ro', predicate => 1); |
9a4942da |
19 | |
20 | package My::PathStatusInfo; |
21 | |
22 | use Moo; |
23 | |
9c7b21a2 |
24 | with 'DX::Role::Fact'; |
25 | |
9a4942da |
26 | has is_directory => (is => 'ro', default => 0); |
27 | has is_file => (is => 'ro', default => 0); |
28 | has mode => (is => 'ro', required => 1); |
29 | } |
30 | |
31 | @INC{qw(My/PathStatus.pm My/PathStatusInfo.pm)} = (__FILE__,__FILE__); |
32 | |
33 | my %protos = ( |
34 | '.ssh' => My::PathStatus->new( |
35 | path => '.ssh', |
36 | info => My::PathStatusInfo->new(is_directory => 1, mode => '0755') |
37 | ), |
38 | '.ssh/authorized_keys' => My::PathStatus->new( |
39 | path => '.ssh/authorized_keys', |
40 | info => My::PathStatusInfo->new(is_file => 1, mode => '0644') |
41 | ), |
42 | ); |
43 | |
71217e42 |
44 | my %empty = ( |
45 | '.ssh' => My::PathStatus->new( |
46 | path => '.ssh' |
deec7cc4 |
47 | ), |
48 | '.ssh/authorized_keys' => My::PathStatus->new( |
49 | path => '.ssh/authorized_keys' |
71217e42 |
50 | ) |
51 | ); |
52 | |
9a4942da |
53 | my %path_status; |
54 | |
55 | my $solver = DX::Solver->new( |
56 | facts => { path_status => DX::SetOver->new( |
57 | over => 'path', |
58 | values => \%path_status, |
59 | ) }, |
60 | ); |
61 | |
734376d9 |
62 | $solver->add_rule(@$_) for ( |
9a4942da |
63 | [ path_status => [ qw(PS) ], |
e183503f |
64 | [ member_of => 'PS', \'path_status' ] ], |
9a4942da |
65 | [ path => [ qw(PS P) ], |
e183503f |
66 | [ prop => 'PS', \'path', 'P' ] ], |
67 | [ info_prop => [ qw(PS N V) ], |
a5c3a041 |
68 | [ prop => 'PS', \'info', 'PSI' ], |
69 | [ prop => 'PSI', 'N', 'V' ] ], |
e183503f |
70 | [ mode => [ qw(PS M) ], |
71 | [ info_prop => 'PS', \'mode', 'M' ] ], |
71217e42 |
72 | [ exists_path => [ qw(PS) ], |
e183503f |
73 | [ info_prop => 'PS', \'is_directory', \1 ] ], |
859049a3 |
74 | [ exists_path => [ qw(PS) ], |
e183503f |
75 | [ info_prop => 'PS', \'is_file', \1 ] ], |
9a4942da |
76 | [ is_directory => [ qw(PS) ], |
e183503f |
77 | [ info_prop => 'PS', \'is_directory', \1 ] ], |
9a4942da |
78 | [ is_file => [ qw(PS) ], |
e183503f |
79 | [ info_prop => 'PS', \'is_file', \1 ] ], |
9a4942da |
80 | ); |
81 | |
9a4942da |
82 | %path_status = %protos; |
83 | |
5ef4d923 |
84 | sub paths_for_simple { |
7ca660cb |
85 | join ' ', map $_->value_for('PS')->path, $solver->solve( |
7d384eca |
86 | [ path_status => 'PS' ], @_ |
9a4942da |
87 | )->results; |
88 | } |
89 | |
5ef4d923 |
90 | is(paths_for_simple(), '.ssh .ssh/authorized_keys'); |
9a4942da |
91 | |
5ef4d923 |
92 | is(paths_for_simple([ is_directory => 'PS' ]), '.ssh'); |
9a4942da |
93 | |
5ef4d923 |
94 | is(paths_for_simple([ is_file => 'PS' ]), '.ssh/authorized_keys'); |
9a4942da |
95 | |
ccfe7414 |
96 | is(paths_for_simple([ mode => 'PS', \'0755' ]), '.ssh'); |
734376d9 |
97 | |
98 | $solver->add_rule( |
99 | path_status_at => [ 'PS', 'P' ], |
100 | [ path_status => 'PS' ], |
101 | [ path => qw(PS P) ], |
102 | ); |
103 | $solver->add_rule( |
104 | path_status_at => [ 'PS', 'P' ], |
105 | [ constrain => [] => sub { die "ARGH" } ] |
106 | ); |
107 | |
108 | throws_ok { |
7ca660cb |
109 | $solver->solve( |
ccfe7414 |
110 | [ path_status_at => 'PS', \'.ssh' ] |
734376d9 |
111 | )->results |
112 | } qr/ARGH/; |
113 | |
114 | delete $solver->rule_set->rules->{'path_status_at/2'}; |
115 | |
116 | $solver->add_rule( |
117 | path_status_at => [ 'PS', 'P' ], |
118 | [ path_status => 'PS' ], |
119 | [ path => qw(PS P) ], |
120 | [ 'cut' ], |
121 | ); |
122 | $solver->add_rule( |
123 | path_status_at => [ 'PS', 'P' ], |
124 | [ constrain => [] => sub { die "ARGH" } ] |
125 | ); |
126 | |
127 | my @res; |
128 | |
129 | lives_ok { |
7ca660cb |
130 | @res = $solver->solve( |
ccfe7414 |
131 | [ path_status_at => 'PS', \'.ssh' ] |
734376d9 |
132 | )->results |
133 | }; |
134 | |
deec7cc4 |
135 | is(join(' ', map $_->value_for('PS')->path, @res), '.ssh'); |
734376d9 |
136 | |
5ef4d923 |
137 | delete $solver->rule_set->rules->{'path_status_at/2'}; |
138 | |
139 | $solver->add_rule( |
140 | path_status_at => [ 'PS', 'P' ], |
141 | [ path_status => 'PS' ], |
142 | [ path => qw(PS P) ], |
143 | [ 'cut' ], |
144 | ); |
145 | |
146 | my %ob_res; |
147 | |
148 | $solver->add_rule( |
149 | path_status_at => [ 'PS', 'P' ], |
150 | [ observe => [ 'P' ], |
151 | sub { |
152 | my ($path) = $_[0]; |
153 | DX::Observer::FromCode->new( |
154 | code => sub { (path_status => $ob_res{$path}) } |
155 | ) |
156 | } |
157 | ], |
158 | [ path_status => 'PS' ], |
159 | [ path => qw(PS P) ], |
160 | ); |
161 | |
71217e42 |
162 | %path_status = (); |
5ef4d923 |
163 | |
164 | $ob_res{'.ssh'} = $protos{'.ssh'}; |
165 | |
166 | sub paths_for { |
7ca660cb |
167 | join ' ', map $_->value_for('PS')->path, $solver->solve(@_)->results; |
5ef4d923 |
168 | } |
169 | |
170 | is( |
ccfe7414 |
171 | paths_for([ path_status => 'PS' ], [ path => 'PS', \'.ssh' ]), |
5ef4d923 |
172 | '', |
173 | 'no .ssh entry' |
174 | ); |
175 | |
ccfe7414 |
176 | throws_ok { paths_for([ path_status_at => 'PS', \'.ssh' ]) } |
5ef4d923 |
177 | qr/refused/; |
178 | |
179 | $solver->{observation_policy} = sub { 1 }; |
180 | |
181 | is( |
ccfe7414 |
182 | paths_for([ path_status_at => 'PS', \'.ssh' ]), |
5ef4d923 |
183 | '.ssh', |
184 | 'observation' |
185 | ); |
186 | |
187 | is($path_status{'.ssh'}, $ob_res{'.ssh'}); |
188 | |
189 | delete $solver->{observation_policy}; |
190 | |
ccfe7414 |
191 | lives_ok { paths_for([ path_status_at => 'PS', \'.ssh' ]) } |
5ef4d923 |
192 | 'No observation required anymore'; |
734376d9 |
193 | |
71217e42 |
194 | $path_status{'.ssh/authorized_keys'} = $protos{'.ssh/authorized_keys'}; |
195 | |
196 | is( |
6d531540 |
197 | paths_for([ path_status => 'PS' ], [ not => [ [ is_directory => 'PS' ] ] ]), |
71217e42 |
198 | '.ssh/authorized_keys', |
199 | 'Negation' |
200 | ); |
201 | |
202 | $solver->add_rule(@$_) for ( |
203 | [ directory_at => [ qw(PS P) ], |
204 | [ path_status_at => qw(PS P) ], |
205 | [ is_directory => 'PS' ] ], |
deec7cc4 |
206 | [ file_at => [ qw(PS P) ], |
207 | [ path_status_at => qw(PS P) ], |
208 | [ is_file => 'PS' ] ], |
71217e42 |
209 | ); |
210 | |
211 | %path_status = (); |
212 | |
213 | $ob_res{'.ssh'} = $empty{'.ssh'}; |
214 | |
215 | #%path_status = %protos; |
216 | |
217 | $solver->{observation_policy} = sub { 1 }; |
218 | |
219 | sub dot_ssh_query { |
7ca660cb |
220 | $solver->solve([ directory_at => 'PS' => \'.ssh' ]); |
71217e42 |
221 | } |
222 | |
223 | is_deeply( |
224 | [ dot_ssh_query()->results ], |
225 | [] |
226 | ); |
227 | |
ccfe7414 |
228 | #::Dwarn(paths_for([ directory_at => 'PS', \'.ssh' ])); |
71217e42 |
229 | |
230 | $solver->add_rule(@$_) for ( |
231 | [ is_directory => [ qw(PS) ], |
6d531540 |
232 | [ not => [ [ exists_path => 'PS' ] ] ], |
71217e42 |
233 | [ act => [ 'PS' ], |
234 | sub { |
4ce2e778 |
235 | my ($value) = @_; |
71217e42 |
236 | DX::Action::FromCode->new( |
237 | expect => sub { |
4ce2e778 |
238 | (path_status => My::PathStatus->new( |
71217e42 |
239 | path => $value->path, |
240 | info => My::PathStatusInfo->new( |
241 | is_directory => 1, mode => '' |
242 | ) |
243 | )) |
244 | }, |
245 | perform => sub { |
246 | $ob_res{$value->path} = $protos{$value->path}; |
247 | (path_status => $value); |
248 | } |
249 | ) |
250 | } ] ] |
251 | ); |
252 | |
253 | %path_status = (); |
254 | |
255 | @res = dot_ssh_query()->results; |
256 | |
257 | is(scalar(@res),1,'Single result'); |
258 | |
259 | is($path_status{'.ssh'}, $empty{'.ssh'}, 'Empty observed'); |
260 | |
deec7cc4 |
261 | is( |
262 | scalar(my ($action) = $res[0]->actions), 1 |
263 | ); |
71217e42 |
264 | |
e7117efc |
265 | $solver->run_action($action); |
71217e42 |
266 | |
267 | ok(!$path_status{'.ssh'}, 'Empty retracted'); |
268 | |
269 | @res = dot_ssh_query()->results; |
270 | |
271 | is(scalar(@res),1,'Single result'); |
272 | |
273 | is($path_status{'.ssh'}, $protos{'.ssh'}, 'Created observed'); |
274 | |
deec7cc4 |
275 | ok(!$res[0]->actions, 'No action'); |
276 | |
37e9670d |
277 | $solver->add_predicate( |
278 | catfile => [ qw(DirPath FileName FilePath) ], |
279 | [ qw(+ + -) ] => sub { |
280 | +(FilePath => [ value => File::Spec->catfile($_{DirPath}, $_{FileName}) ]) |
281 | }, |
282 | ); |
283 | |
deec7cc4 |
284 | $solver->add_rule(@$_) for ( |
deec7cc4 |
285 | [ file_in => [ qw(DirStatus FileName FileStatus) ], |
286 | [ is_directory => qw(DirStatus) ], |
a5c3a041 |
287 | [ path => qw(DirStatus DirPath) ], |
288 | [ catfile => qw(DirPath FileName FilePath) ], |
289 | [ file_at => qw(FileStatus FilePath) ] ], |
deec7cc4 |
290 | [ is_file => [ qw(PS) ], |
6d531540 |
291 | [ not => [ [ exists_path => 'PS' ] ] ], |
deec7cc4 |
292 | [ act => [ 'PS' ], |
293 | sub { |
4ce2e778 |
294 | my ($value) = @_; |
deec7cc4 |
295 | DX::Action::FromCode->new( |
296 | expect => sub { |
4ce2e778 |
297 | (path_status => My::PathStatus->new( |
deec7cc4 |
298 | path => $value->path, |
299 | info => My::PathStatusInfo->new( |
300 | is_file => 1, mode => '' |
301 | ) |
302 | )) |
303 | }, |
304 | perform => sub { |
305 | $ob_res{$value->path} = $protos{$value->path}; |
306 | (path_status => $value); |
307 | } |
308 | ) |
309 | } ] ] |
310 | ); |
311 | |
312 | %path_status = (); |
313 | %ob_res = %empty; |
314 | |
315 | sub keys_file { |
7ca660cb |
316 | $solver->solve( |
deec7cc4 |
317 | [ directory_at => 'D' => \'.ssh' ], |
318 | [ file_in => 'D' => \'authorized_keys' => 'F' ], |
319 | ); |
320 | } |
321 | |
322 | @res = keys_file()->results; |
323 | |
324 | is(scalar @res, 1, 'One result'); |
325 | |
326 | is(scalar(my @act = $res[0]->actions), 2, 'Two actions'); |
327 | |
4ce2e778 |
328 | #::Dwarn(\@act); |
329 | |
deec7cc4 |
330 | is(scalar(my ($poss) = grep !@{$_->dependencies}, @act), 1, 'One possible'); |
331 | |
e7117efc |
332 | $solver->run_action($poss); |
deec7cc4 |
333 | |
334 | @res = keys_file()->results; |
335 | |
336 | is(scalar @res, 1, 'One result'); |
337 | |
338 | is( |
339 | scalar(($poss) = grep !@{$_->dependencies}, $res[0]->actions), 1, |
340 | 'One possible' |
341 | ); |
342 | |
e7117efc |
343 | $solver->run_action($poss); |
deec7cc4 |
344 | |
345 | @res = keys_file()->results; |
346 | |
347 | is(scalar @res, 1, 'One result'); |
348 | |
349 | is(scalar($res[0]->actions), 0, 'No actions'); |
71217e42 |
350 | |
734376d9 |
351 | done_testing; |