File Coverage

blib/lib/Apache2/Authen/Passphrase.pm

Criterion	Covered	Total	%
statement	66	77	85.7
branch	6	12	50.0
condition	2	2	100.0
subroutine	19	20	95.0
pod	4	4	100.0
total	97	115	84.3

package Apache2::Authen::Passphrase;

use 5.014000;
use strict;
use warnings;
use parent qw/Exporter/;
use subs qw/OK HTTP_UNAUTHORIZED/;

our $VERSION = 0.002002;

use constant USER_REGEX => qr/^\w{2,20}$/pas;
use constant PASSPHRASE_VERSION => 1;
use constant INVALID_USER => "invalid-user\n";
use constant BAD_PASSWORD => "bad-password\n";

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

our @EXPORT_OK = qw/pwset pwcheck pwhash USER_REGEX PASSPHRASE_VERSION INVALID_USER BAD_PASSWORD/;

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

our $rootdir;
$rootdir //= $ENV{AAP_ROOTDIR};

sub pwhash{
	my ($pass)=@_;

	my $ppr=Authen::Passphrase::BlowfishCrypt->new(
		cost => 10,
		passphrase => $pass,
		salt_random => 1,
	);

	$ppr->as_rfc2307
}

sub pwset{
	my ($user, $pass)=@_;

	my $file = "$rootdir/$user.yml";
	my $conf = eval { LoadFile $file } // undef;
	$conf->{passphrase}=pwhash $pass;
	$conf->{passphrase_version}=PASSPHRASE_VERSION;
	DumpFile $file, $conf;

	chmod 0660, $file;
}

sub pwcheck{
	my ($user, $pass)=@_;
	die INVALID_USER unless $user =~ USER_REGEX; ## no critic (RequireCarping)
	$user=${^MATCH};                             # Make taint shut up
	my $conf=LoadFile "$rootdir/$user.yml";

	## no critic (RequireCarping)
	die BAD_PASSWORD unless keys %$conf;          # Empty hash means no such user
	die BAD_PASSWORD unless Authen::Passphrase->from_rfc2307($conf->{passphrase})->match($pass);
	## use critic
	pwset $user, $pass if $conf->{passphrase_version} < PASSPHRASE_VERSION
}

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

	my ($rc, $pass) = $r->get_basic_auth_pw;
	return $rc unless $rc == OK;

	my $user=$r->user;
	unless (eval { pwcheck $user, $pass; 1 }) {
		$r->note_basic_auth_failure;
		return HTTP_UNAUTHORIZED
	}

	OK
}

1;
__END__