lib/Apache2/AuthzCaps.pm

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