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.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                 for my $requirement (map { $_->{requirement} } @{$r->requires}) {
  51                         my ($command, @args) = split ' ', $requirement;
  52
  53                         return OK if $command eq 'cap' && hascaps $user, @args;
  54                 }
  55         }
  56
  57         DECLINED
  58 }
  59
  60 1;
  61 __END__
  62
  63 =head1 NAME
  64
  65 Apache2::AuthzCaps - mod_perl2 capability authorization
  66
  67 =head1 SYNOPSIS
  68
  69   use Apache2::AuthzCaps qw/setcap hascaps/;
  70   $Apache2::AuthzCaps::rootdir = "/path/to/user/directory"
  71   setcap marius => deleteusers => 1; # Grant marius the deleteusers capability
  72   setcap marius => createusers => 0;
  73   hascaps marius => qw/deleteusers/; # returns 1, since marius can delete users
  74   hascaps marius => qw/deleteusers createusers/; # returns 0, since marius can delete users but cannot create users
  75
  76   # In Apache2 config
  77   <Location /protected>
  78     # Insert authentication here
  79     PerlAuthzHandler Apache2::AuthzCaps
  80     PerlSetVar AuthzCapsRootdir /path/to/user/directory
  81     Require cap staff important
  82     Require cap admin
  83   </Location>
  84   # This will:
  85   # 1) Let important staff members access /protected
  86   # 2) Let admins access /protected
  87   # 3) Not let anyone else (such as an important non-staff member or an non-important staff member) access /protected
  88
  89 =head1 DESCRIPTION
  90
  91 Apache2::AuthzCaps is a perl module which provides simple Apache2 capability-based authorization. It contains a PerlAuthzHandler and some utility functions.
  92
  93 The user data is stored in YAML files in a user-set directory. Set this directory using:
  94
  95   $Apache2::AuthzCaps::rootdir = "/path/to/directory"; # From perl
  96   PerlSetVar AuthzCapsRootdir /path/to/directory # From Apache2 config
  97
  98 =head1 FUNCTIONS
  99
 100 =over
 101
 102 =item B<setcap>(I<$username>, I<$capability>, I<$value>)
 103
 104 If I<$value> is true, grants I<$username> the I<$capability> capability. Otherwise denies I<$username> that capability.
 105
 106 =item B<hascaps>(I<$username>, I<$cap>, ...)
 107
 108 Returns true if and only of I<$username> has ALL of the listed capabilities. Dies if I<$username> does not exist.
 109
 110 =item B<handler>
 111
 112 The PerlAuthzHandler for use in apache2.
 113
 114 =back
 115
 116 =head1 AUTHOR
 117
 118 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
 119
 120 =head1 COPYRIGHT AND LICENSE
 121
 122 Copyright (C) 2013 by Marius Gavrilescu
 123
 124 This library is free software; you can redistribute it and/or modify
 125 it under the same terms as Perl itself, either Perl version 5.14.2 or,
 126 at your option, any later version of Perl 5 you may have available.
 127
 128
 129 =cut