File Coverage

blib/lib/Apache2/AuthzCaps.pm

Criterion	Covered	Total	%
statement	43	53	81.1
branch	6	10	60.0
condition	4	7	57.1
subroutine	12	13	92.3
pod	3	3	100.0
total	68	86	79.0

package Apache2::AuthzCaps;

use 5.014000;
use strict;
use warnings;
use subs qw/OK DECLINED/;

our $VERSION = '0.002';

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 if $ENV{MOD_PERL}, 'Apache2::RequestUtil';
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) {
		for my $requirement (map { $_->{requirement} } @{$r->requires}) {
			my ($command, @args) = split ' ', $requirement;

			return OK if $command eq 'cap' && hascaps $user, @args;
		}
	}

	DECLINED
}

1;
__END__