Commit | Line | Data |
---|---|---|
7442fd06 MG |
1 | package Apache2::AuthzCaps 0.001; |
2 | ||
3 | use 5.014000; | |
4 | use strict; | |
5 | use warnings; | |
75943539 MG |
6 | use subs qw/OK DECLINED/; |
7 | no if $] >= 5.017011, warnings => 'experimental::smartmatch'; | |
7442fd06 | 8 | |
75943539 MG |
9 | use if $ENV{MOD_PERL}, 'Apache2::Access'; |
10 | use if $ENV{MOD_PERL}, 'Apache2::Const' => qw/OK DECLINED/; | |
11 | use if $ENV{MOD_PERL}, 'Apache2::RequestRec'; | |
7442fd06 MG |
12 | use YAML::Any qw/LoadFile DumpFile/; |
13 | ||
14 | use parent qw/Exporter/; | |
15 | ||
16 | our @EXPORT_OK = qw/setcap hascaps/; | |
17 | ||
18 | ################################################## | |
19 | ||
20 | our $rootdir; | |
21 | ||
22 | sub setcap{ | |
23 | my ($user, $cap, $value) = @_; | |
24 | my $config = eval { LoadFile "$rootdir/$user.yml" } // {}; | |
25 | $config->{caps}//={}; | |
26 | my $caps=$config->{caps}; | |
27 | ||
28 | delete $caps->{$cap} unless $value; | |
29 | $caps->{$cap} = 1 if $value; | |
30 | DumpFile "$rootdir/$user.yml", $config | |
31 | } | |
32 | ||
33 | sub hascaps{ | |
34 | my ($user, @caps) = @_; | |
35 | my $config = LoadFile "$rootdir/$user.yml"; | |
36 | my $caps = $config->{caps}; | |
37 | for (@caps) { | |
38 | return 0 unless $caps->{$_} | |
39 | } | |
40 | 1 | |
41 | } | |
42 | ||
43 | sub handler{ | |
44 | my $r=shift; | |
45 | my $user = $r->user; | |
46 | local $rootdir = $r->dir_config('AuthzCapsRootdir'); | |
47 | ||
48 | if ($user) { | |
49 | LOOP: for my $requirement (map { $_->{requirement} } @{$r->requires}) { | |
50 | my ($command, @args) = split ' ', $requirement; | |
51 | ||
52 | given ($command){ | |
53 | when('cap'){ | |
54 | return OK if hascaps $user, @args | |
55 | } | |
56 | ||
57 | } | |
58 | } | |
59 | } | |
60 | ||
61 | DECLINED | |
62 | } | |
63 | ||
64 | 1; | |
65 | __END__ | |
66 | ||
67 | =head1 NAME | |
68 | ||
69 | Apache2::AuthzCaps - mod_perl2 capability authorization | |
70 | ||
71 | =head1 SYNOPSIS | |
72 | ||
73 | use Apache2::AuthzCaps qw/setcap hascaps/; | |
74 | $Apache2::AuthzCaps::rootdir = "/path/to/user/directory" | |
75 | setcap marius => deleteusers => 1; # Grant marius the deleteusers capability | |
76 | setcap marius => createusers => 0; | |
77 | hascaps marius => qw/deleteusers/; # returns 1, since marius can delete users | |
78 | hascaps marius => qw/deleteusers createusers/; # returns 0, since marius can delete users but cannot create users | |
79 | ||
80 | # In Apache2 config | |
81 | <Location /protected> | |
82 | # Insert authentication here | |
83 | PerlAuthzHandler Apache2::AuthzCaps | |
84 | PerlSetVar AuthzCapsRootdir /path/to/user/directory | |
85 | Require cap staff important | |
86 | Require cap admin | |
87 | </Location> | |
88 | # This will: | |
89 | # 1) Let important staff members access /protected | |
90 | # 2) Let admins access /protected | |
91 | # 3) Not let anyone else (such as an important non-staff member or an non-important staff member) access /protected | |
92 | ||
93 | =head1 DESCRIPTION | |
94 | ||
95 | Apache2::AuthzCaps is a perl module which provides simple Apache2 capability-based authorization. It contains a PerlAuthzHandler and some utility functions. | |
96 | ||
97 | The user data is stored in YAML files in a user-set directory. Set this directory using: | |
98 | ||
99 | $Apache2::AuthzCaps::rootdir = "/path/to/directory"; # From perl | |
100 | PerlSetVar AuthzCapsRootdir /path/to/directory # From Apache2 config | |
101 | ||
102 | =head1 FUNCTIONS | |
103 | ||
104 | =over | |
105 | ||
106 | =item B<setcap>(I<$username>, I<$capability>, I<$value>) | |
107 | ||
108 | If I<$value> is true, grants I<$username> the I<$capability> capability. Otherwise denies I<$username> that capability. | |
109 | ||
110 | =item B<hascaps>(I<$username>, I<$cap>, ...) | |
111 | ||
112 | Returns true if and only of I<$username> has ALL of the listed capabilities. Dies if I<$username> does not exist. | |
113 | ||
114 | =item B<handler> | |
115 | ||
116 | The PerlAuthzHandler for use in apache2. | |
117 | ||
118 | =back | |
119 | ||
120 | =head1 AUTHOR | |
121 | ||
122 | Marius Gavrilescu, E<lt>marius@ieval.roE<gt> | |
123 | ||
124 | =head1 COPYRIGHT AND LICENSE | |
125 | ||
126 | Copyright (C) 2013 by Marius Gavrilescu | |
127 | ||
128 | This library is free software; you can redistribute it and/or modify | |
129 | it under the same terms as Perl itself, either Perl version 5.14.2 or, | |
130 | at your option, any later version of Perl 5 you may have available. | |
131 | ||
132 | ||
133 | =cut |