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