File Coverage

blib/lib/Apache/Sling/Authz.pm
Criterion Covered Total %
statement 85 168 50.6
branch 20 60 33.3
condition 1 3 33.3
subroutine 16 21 76.1
pod 7 11 63.6
total 129 263 49.0


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             package Apache::Sling::Authz;
4              
5 1     1   1554 use 5.008001;
  1         3  
  1         41  
6 1     1   5 use strict;
  1         3  
  1         30  
7 1     1   5 use warnings;
  1         2  
  1         27  
8 1     1   5 use Carp;
  1         3  
  1         67  
9 1     1   1257 use Getopt::Long qw(:config bundling);
  1         13905  
  1         6  
10 1     1   202 use Apache::Sling;
  1         2  
  1         36  
11 1     1   640 use Apache::Sling::AuthzUtil;
  1         4  
  1         53  
12 1     1   6 use Apache::Sling::Print;
  1         2  
  1         35  
13 1     1   6 use Apache::Sling::Request;
  1         2  
  1         43  
14              
15             require Exporter;
16              
17 1     1   5 use base qw(Exporter);
  1         2  
  1         2109  
18              
19             our @EXPORT_OK = qw(command_line);
20              
21             our $VERSION = '0.27';
22              
23             #{{{sub new
24              
25             =pod
26              
27             =head2 new
28              
29             Create, set up, and return an Authz object.
30              
31             =cut
32              
33             sub new {
34 2     2 1 815 my ( $class, $authn, $verbose, $log ) = @_;
35 2 100       5 if ( !defined $authn ) { croak 'no authn provided!'; }
  1         32  
36 1         3 my $response;
37 1 50       4 $verbose = ( defined $verbose ? $verbose : 0 );
38 1         12 my $content = {
39             BaseURL => $$authn->{'BaseURL'},
40             Authn => $authn,
41             Message => "",
42             Response => \$response,
43             Verbose => $verbose,
44             Log => $log
45             };
46 1         3 bless( $content, $class );
47 1         4 return $content;
48             }
49              
50             #}}}
51              
52             #{{{sub set_results
53              
54             =pod
55              
56             =head2 set_results
57              
58             Populate the message and response with results returned from performing query:
59              
60             =cut
61              
62             sub set_results {
63 1     1 1 1232 my ( $content, $message, $response ) = @_;
64 1         3 $content->{'Message'} = $message;
65 1         3 $content->{'Response'} = $response;
66 1         3 return 1;
67             }
68              
69             #}}}
70              
71             #{{{ sub command_line
72             sub command_line {
73 0     0 0 0 my ( $authz, @ARGV ) = @_;
74 0         0 my $sling = Apache::Sling->new;
75 0         0 my $config = $authz->config( $sling, @ARGV );
76 0         0 return $authz->run( $sling, $config );
77             }
78              
79             #}}}
80              
81             #{{{sub config
82              
83             sub config {
84 1     1 1 408 my ( $authz, $sling, @ARGV ) = @_;
85 1         7 my $authz_config = $authz->config_hash( $sling, @ARGV );
86              
87 1 50       8 GetOptions(
88             $authz_config, 'auth=s',
89             'help|?', 'log|L=s',
90             'man|M', 'pass|p=s',
91             'threads|t=s', 'url|U=s',
92             'user|u=s', 'verbose|v+',
93             'addChildNodes!', 'all!',
94             'delete|d', 'lifecycleManage!',
95             'lockManage!', 'modifyACL!',
96             'modifyProps!', 'nodeTypeManage!',
97             'principal|P=s', 'readACL!',
98             'read!', 'remote|r=s',
99             'removeChilds!', 'removeNode!',
100             'retentionManage!', 'versionManage!',
101             'view|V', 'write!'
102             ) or $authz->help();
103              
104 1         1408 return $authz_config;
105             }
106              
107             #}}}
108              
109             #{{{sub config_hash
110              
111             sub config_hash {
112 1     1 0 3 my ( $authz, $sling, @ARGV ) = @_;
113 1         2 my $delete;
114             my $principal;
115 0         0 my $remote_node;
116 0         0 my $view;
117              
118             # privileges:
119 0         0 my $add_child_nodes;
120 0         0 my $all;
121 0         0 my $life_cycle_manage;
122 0         0 my $lock_manage;
123 0         0 my $modify_acl;
124 0         0 my $modify_props;
125 0         0 my $node_type_manage;
126 0         0 my $read;
127 0         0 my $read_acl;
128 0         0 my $remove_childs;
129 0         0 my $remove_node;
130 0         0 my $retention_manage;
131 0         0 my $version_manage;
132 0         0 my $write;
133              
134 1         30 my %authz_config = (
135             'auth' => \$sling->{'Auth'},
136             'help' => \$sling->{'Help'},
137             'log' => \$sling->{'Log'},
138             'man' => \$sling->{'Man'},
139             'pass' => \$sling->{'Pass'},
140             'threads' => \$sling->{'Threads'},
141             'url' => \$sling->{'URL'},
142             'user' => \$sling->{'User'},
143             'verbose' => \$sling->{'Verbose'},
144             'addChildNodes' => \$add_child_nodes,
145             'all' => \$all,
146             'delete' => \$delete,
147             'lifecycleManage' => \$life_cycle_manage,
148             'lockManage' => \$lock_manage,
149             'modifyACL' => \$modify_acl,
150             'modifyProps' => \$modify_props,
151             'nodeTypeManage' => \$node_type_manage,
152             'principal' => \$principal,
153             'readACL' => \$read_acl,
154             'read' => \$read,
155             'remote' => \$remote_node,
156             'removeChilds' => \$remove_childs,
157             'removeNode' => \$remove_node,
158             'retentionManage' => \$retention_manage,
159             'versionManage' => \$version_manage,
160             'view' => \$view,
161             'write' => \$write
162             );
163              
164 1         4 return \%authz_config;
165             }
166              
167             #}}}
168              
169             #{{{sub del
170              
171             =pod
172              
173             =head2 del
174              
175             Delete the access controls for a given principal on a given node:
176              
177             =cut
178              
179             sub del {
180 0     0 1 0 my ( $content, $remoteDest, $principal ) = @_;
181 0         0 my $res = Apache::Sling::Request::request(
182             \$content,
183             Apache::Sling::AuthzUtil::delete_setup(
184             $content->{'BaseURL'}, $remoteDest, $principal
185             )
186             );
187 0         0 my $success = Apache::Sling::AuthzUtil::delete_eval($res);
188 0         0 my $message = "Privileges on \"$remoteDest\" for \"$principal\" ";
189 0 0       0 $message .= ( $success ? "removed." : "were not removed." );
190 0         0 $content->set_results( "$message", $res );
191 0         0 return $success;
192             }
193              
194             #}}}
195              
196             #{{{sub get_acl
197              
198             =pod
199              
200             =head2 get_acl
201              
202             Return the access control list for the node in JSON format
203              
204             =cut
205              
206             sub get_acl {
207 0     0 1 0 my ( $content, $remoteDest ) = @_;
208 0         0 my $res = Apache::Sling::Request::request(
209             \$content,
210             Apache::Sling::AuthzUtil::get_acl_setup(
211             $content->{'BaseURL'}, $remoteDest
212             )
213             );
214 0         0 my $success = Apache::Sling::AuthzUtil::get_acl_eval($res);
215 0         0 my $message = (
216             $success
217 0 0       0 ? ${$res}->content
218             : "Could not view ACL for \"$remoteDest\""
219             );
220 0         0 $content->set_results( "$message", $res );
221 0         0 return $success;
222             }
223              
224             #}}}
225              
226             #{{{ sub help
227             sub help {
228              
229 1     1 0 29 print <<"EOF";
230             Usage: perl $0 [-OPTIONS [-MORE_OPTIONS]] [--] [PROGRAM_ARG1 ...]
231             The following options are accepted:
232              
233             --auth (type) - Specify auth type. If ommitted, default is used.
234             --delete or -d - delete access control list for node for principal.
235             --help or -? - view the script synopsis and options.
236             --log or -L (log) - Log script output to specified log file.
237             --man or -M - view the full script documentation.
238             --(no-)addChildNodes - Grant or deny the addChildNodes privilege
239             --(no-)all - Grant or deny all above privileges
240             --(no-)modifyACL - Grant or deny the modifyACL privilege
241             --(no-)modifyProps - Grant or deny the modifyProperties privilege
242             --(no-)readACL - Grant or deny the readACL privilege
243             --(no-)read - Grant or deny the read privilege
244             --(no-)removeChilds - Grant or deny the removeChildNodes privilege
245             --(no-)removeNode - Grant or deny the removeNode privilege
246             --(no-)write - Grant or deny the write privileges:
247             modifyProperties,addChildNodes,removeNode,removeChildNodes
248             --pass or -p (password) - Password of user performing content manipulations.
249             --principal or -P (principal) - Principal to grant, deny, or delete privilege for.
250             --remote or -r (remoteNode) - specify remote node under JCR root to act on.
251             --url or -U (URL) - URL for system being tested against.
252             --user or -u (username) - Name of user to perform content manipulations as.
253             --verbose or -v or -vv or -vvv - Increase verbosity of output.
254             --view or -V - view access control list for node.
255              
256             Options may be merged together. -- stops processing of options.
257             Space is not required between options and their arguments.
258             For full details run: perl $0 --man
259             EOF
260              
261 1         3 return 1;
262             }
263              
264             #}}}
265              
266             #{{{ sub man
267             sub man {
268              
269 0     0 0 0 my ($authz) = @_;
270              
271 0         0 print <<'EOF';
272             authz perl script. Provides a means of manipulating access control on content
273             in sling from the command line. This script can be used to get, set, update and
274             delete content permissions. It also acts as a reference implementation for the
275             Authz perl library.
276              
277             EOF
278              
279 0         0 $authz->help();
280              
281 0         0 print <<"EOF";
282             * Authenticate and view the ACL for the /data node:
283              
284             perl $0 -U http://localhost:8080 -r /data -V -u admin -p admin
285              
286             * Authenticate and grant the read privilege to the owner principal, view the result:
287              
288             perl $0 -U http://localhost:8080 -r /testdata -P owner --read -u admin -p admin -V
289              
290             * Authenticate and grant the modifyProps privilege to the everyone principal, * view the result:
291              
292             perl $0 -U http://localhost:8080 -r /testdata -P everyone --modifyProps -u admin -p admin -V
293              
294             * Authenticate and deny the addChildNodes privilege to the testuser principal, * view the result:
295              
296             perl $0 -U http://localhost:8080 -r /testdata -P testuser --no-addChildNodes -u admin -p admin -V
297              
298             * Authenticate with form based authentication and grant the read and write privileges to the g-testgroup principal, log the results, including the resulting JSON, to authz.log:
299              
300             perl $0 -U http://localhost:8080 -r /testdata -P g-testgroup --read --write -u admin -p admin --auth form -V -L authz.log
301              
302             JSR-283 privileges:
303              
304             The following privileges are not yet supported, but may be soon:
305              
306             --(no-)lockManage - Grant or deny the lockManagement privilege
307             --(no-)versionManage - Grant or deny the versionManagement privilege
308             --(no-)nodeTypeManage - Grant or deny the nodeTypeManagement privilege
309             --(no-)retentionManage - Grant or deny the retentionManagement privilege
310             --(no-)lifecycleManage - Grant or deny the lifeCycleManagement privilege
311             EOF
312              
313 0         0 return 1;
314             }
315              
316             #}}}
317              
318             #{{{sub modify_privileges
319              
320             =pod
321              
322             =head2 modify_privileges
323              
324             Modify the privileges on a specified node for a specified principal.
325              
326             =cut
327              
328             sub modify_privileges {
329 0     0 1 0 my ( $content, $remoteDest, $principal, $grant_privileges,
330             $deny_privileges ) = @_;
331 0         0 my $res = Apache::Sling::Request::request(
332             \$content,
333             Apache::Sling::AuthzUtil::modify_privilege_setup(
334             $content->{'BaseURL'}, $remoteDest, $principal,
335             $grant_privileges, $deny_privileges
336             )
337             );
338 0         0 my $success = Apache::Sling::AuthzUtil::modify_privilege_eval($res);
339 0         0 my $message = "Privileges on \"$remoteDest\" for \"$principal\" ";
340 0 0       0 $message .= ( $success ? "modified." : "were not modified." );
341 0         0 $content->set_results( "$message", $res );
342 0         0 return $success;
343             }
344              
345             #}}}
346              
347             #{{{sub run
348             sub run {
349 2     2 1 26 my ( $authz, $sling, $config ) = @_;
350 2 100       6 if ( !defined $config ) {
351 1         14 croak 'No authz config supplied!';
352             }
353 1         5 $sling->check_forks;
354 1         2 ${ $config->{'remote'} } =
  1         6  
355 1         1 Apache::Sling::URL::strip_leading_slash( ${ $config->{'remote'} } );
356              
357 1         8 my $authn = Apache::Sling::Authn->new( \$sling );
358 1         5 $authn->login_user();
359 1         1 my @grant_privileges;
360             my @deny_privileges;
361 1 50       2 if ( defined ${ $config->{'read'} } ) {
  1         4  
362 0 0       0 ${ $config->{'read'} }
  0         0  
363             ? push @grant_privileges, 'read'
364             : push @deny_privileges, 'read';
365             }
366 1 50       1 if ( defined ${ $config->{'modifyProps'} } ) {
  1         4  
367 0 0       0 ${ $config->{'modifyProps'} }
  0         0  
368             ? push @grant_privileges, 'modifyProperties'
369             : push @deny_privileges, 'modifyProperties';
370             }
371 1 50       2 if ( defined ${ $config->{'addChildNodes'} } ) {
  1         4  
372 0 0       0 ${ $config->{'addChildNodes'} }
  0         0  
373             ? push @grant_privileges, 'addChildNodes'
374             : push @deny_privileges, 'addChildNodes';
375             }
376 1 50       2 if ( defined ${ $config->{'removeNode'} } ) {
  1         4  
377 0 0       0 ${ $config->{'removeNode'} }
  0         0  
378             ? push @grant_privileges, 'removeNode'
379             : push @deny_privileges, 'removeNode';
380             }
381 1 50       1 if ( defined ${ $config->{'removeChilds'} } ) {
  1         3  
382 0 0       0 ${ $config->{'removeChilds'} }
  0         0  
383             ? push @grant_privileges, 'removeChildNodes'
384             : push @deny_privileges, 'removeChildNodes';
385             }
386 1 50       2 if ( defined ${ $config->{'write'} } ) {
  1         3  
387 0 0       0 ${ $config->{'write'} }
  0         0  
388             ? push @grant_privileges, 'write'
389             : push @deny_privileges, 'write';
390             }
391 1 50       1 if ( defined ${ $config->{'readACL'} } ) {
  1         4  
392 0 0       0 ${ $config->{'readACL'} }
  0         0  
393             ? push @grant_privileges, 'readAccessControl'
394             : push @deny_privileges, 'readAccessControl';
395             }
396 1 50       2 if ( defined ${ $config->{'modifyACL'} } ) {
  1         3  
397 0 0       0 ${ $config->{'modifyACL'} }
  0         0  
398             ? push @grant_privileges, 'modifyAccessControl'
399             : push @deny_privileges, 'modifyAccessControl';
400             }
401              
402             # Privileges that may become available in due course:
403             # if ( defined $lock_manage ) {
404             # $lock_manage ? push ( @grant_privileges, 'lockManagement' ) : push ( @deny_privileges, 'lockManagement' );
405             # }
406             # if ( defined $version_manage ) {
407             # $version_manage ? push ( @grant_privileges, 'versionManagement' ) : push ( @deny_privileges, 'versionManagement' );
408             # }
409             # if ( defined $node_type_manage ) {
410             # $node_type_manage ? push ( @grant_privileges, 'nodeTypeManagement' ) : push ( @deny_privileges, 'nodeTypeManagement' );
411             # }
412             # if ( defined $retention_manage ) {
413             # $retention_manage ? push ( @grant_privileges, 'retentionManagement' ) : push ( @deny_privileges, 'retentionManagement' );
414             # }
415             # if ( defined $life_cycle_manage ) {
416             # $life_cycle_manage ? push ( @grant_privileges, 'lifecycleManagement' ) : push ( @deny_privileges, 'lifecycleManagement' );
417             # }
418 1 50       1 if ( defined ${ $config->{'all'} } ) {
  1         4  
419 0 0       0 ${ $config->{'all'} }
  0         0  
420             ? push @grant_privileges, 'all'
421             : push @deny_privileges, 'all';
422             }
423              
424 1 50 33     10 if ( $sling->{'Help'} ) { $authz->help(); }
  0 50       0  
    50          
    50          
    50          
425 0         0 elsif ( $sling->{'Man'} ) { $authz->man(); }
426 1         3 elsif ( @grant_privileges || @deny_privileges ) {
427 0         0 $authz =
428             Apache::Sling::Authz->new( \$authn, $sling->{'Verbose'},
429             $sling->{'Log'} );
430 0         0 my $success = $authz->modify_privileges(
431 0         0 ${ $config->{'remote'} }, ${ $config->{'principal'} },
  0         0  
432             \@grant_privileges, \@deny_privileges
433             );
434 0         0 Apache::Sling::Print::print_result($authz);
435 0         0 return $success;
436             }
437 1         3 elsif ( defined ${ $config->{'view'} } ) {
438 0         0 $authz =
439             Apache::Sling::Authz->new( \$authn, $sling->{'Verbose'},
440             $sling->{'Log'} );
441 0         0 my $success = $authz->get_acl( ${ $config->{'remote'} } );
  0         0  
442 0         0 Apache::Sling::Print::print_result($authz);
443 0         0 return $success;
444             }
445             elsif ( defined ${ $config->{'delete'} } ) {
446 0         0 $authz =
447             Apache::Sling::Authz->new( \$authn, $sling->{'Verbose'},
448             $sling->{'Log'} );
449 0         0 my $success =
450 0         0 $authz->del( ${ $config->{'remote'} }, ${ $config->{'principal'} } );
  0         0  
451 0         0 Apache::Sling::Print::print_result($authz);
452 0         0 return $success;
453             }
454             else {
455 1         6 $authz->help();
456             }
457 1         5 return 1;
458             }
459              
460             #}}}
461              
462             1;
463              
464             __END__