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 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