File Coverage

blib/lib/Apache2/AuthzCaps.pm

Criterion	Covered	Total	%
statement	44	56	78.5
branch	6	10	60.0
condition	4	4	100.0
subroutine	12	13	92.3
pod	3	3	100.0
total	69	86	80.2

package Apache2::AuthzCaps;

use 5.014000;
use strict;
use warnings;
use subs qw/OK DECLINED/;
no if $] >= 5.017011, warnings => 'experimental::smartmatch';
our $VERSION = '0.001001';

use if $ENV{MOD_PERL}, 'Apache2::Access';
use if $ENV{MOD_PERL}, 'Apache2::Const' => qw/OK DECLINED/;
use if $ENV{MOD_PERL}, 'Apache2::RequestRec';
use YAML::Any qw/LoadFile DumpFile/;

use parent qw/Exporter/;

our @EXPORT_OK = qw/setcap hascaps/;

##################################################

our $rootdir;

sub setcap{
  my ($user, $cap, $value) = @_;
  my $config = eval { LoadFile "$rootdir/$user.yml" } // {};
  $config->{caps}//={};
  my $caps=$config->{caps};

  delete $caps->{$cap} unless $value;
  $caps->{$cap} = 1 if $value;
  DumpFile "$rootdir/$user.yml", $config
}

sub hascaps{
  my ($user, @caps) = @_;
  my $config = LoadFile "$rootdir/$user.yml";
  my $caps = $config->{caps};
  for (@caps) {
	return 0 unless $caps->{$_}
  }
  1
}

sub handler{
  my $r=shift;
  my $user = $r->user;
  local $rootdir = $r->dir_config('AuthzCapsRootdir');

  if ($user) {
  LOOP: for my $requirement (map { $_->{requirement} } @{$r->requires}) {
	  my ($command, @args) = split ' ', $requirement;

	  given ($command){
		when('cap'){
		  return OK if hascaps $user, @args
		}

	  }
	}
  }

  DECLINED
}

1;
__END__