Concierge-Auth
view release on metacpan or search on metacpan
- BREAKING: Concierge::Auth is now a thin backend factory, not a
monolithic password-auth implementation. All prior OO methods
(confirm/reject/reply, validateID/validatePwd/validateFile,
checkID/deleteID/checkPwd/setPwd/resetPwd, setFile/rmFile/clearFile,
encryptPwd, pfile, the gen_* wrappers) are removed outright -- no
deprecation shims. Code calling Concierge::Auth directly (rather
than through Concierge.pm) will need to migrate to the new backend
contract below.
- Added Concierge::Auth::Base: the domain-level contract every backend
must implement -- authenticate, is_id_known, enroll,
change_credentials, revoke (returning { success, message, ... }
hashrefs) -- plus working default implementations of the Generator
methods (gen_uuid, gen_random_id, gen_random_token,
gen_random_string, gen_word_phrase, gen_token, gen_crypt_token),
inherited for free unless a backend overrides them.
- Added Concierge::Auth::Pwd: the built-in password-file backend,
implementing Concierge::Auth::Base on top of the previous
file-backed primitives (now private to this module).
Concierge::Auth->new now requires backend => 'Concierge::Auth::Pwd'
(or another conforming backend class) instead of configuring a
password file directly.
use Concierge::Auth;
my $auth = Concierge::Auth->new(
backend_class => 'Concierge::Auth::Pwd',
file => '/path/to/users.passwd',
);
my $result = $auth->enroll($user_id, $password);
my $result = $auth->authenticate($user_id, $password);
my $result = $auth->is_id_known($user_id);
my $result = $auth->change_credentials($user_id, $new_password);
my $result = $auth->revoke($user_id);
# Generators -- work with or without a file
# (backend_class => 'Concierge::Auth::Pwd', no_file => 1)
my $token = $auth->gen_random_token();
my $uuid = $auth->gen_uuid();
```
Each of the five core methods above returns a hashref: `{ success => 1, ... }`
on success, or `{ success => 0, message => '...' }` on failure. See
examples/1-custom-backend-ldap.pl view on Meta::CPAN
#!/usr/bin/env perl
=head1 NAME
1-custom-backend-ldap.pl - Sketch of a minimal Concierge::Auth::LDAP backend
=head1 DESCRIPTION
Concierge::Auth::Base defines a small, domain-level contract (five methods:
C<new>, C<authenticate>, C<is_id_known>, C<enroll>, C<change_credentials>,
C<revoke>) that any backend must satisfy. The built-in C<Concierge::Auth::Pwd>
backend satisfies it using a flat password file; this example sketches what
a I<directory-backed> implementation looks like instead, given the
connection details a developer would normally supply (host, bind DN, bind
password, base DN, and the attribute holding each user's identifier).
This is a sketch for documentation purposes, not a shipped backend: it
requires L<Net::LDAP> (not a dependency of this distribution) and a real
directory server to actually run against. The point is to show how little
code is needed to satisfy the contract once you have the required
examples/1-custom-backend-ldap.pl view on Meta::CPAN
package Concierge::Auth::LDAP {
use Carp qw/croak/;
use parent qw/Concierge::Auth::Base/;
# Swap this for `use Net::LDAP;` to run against a real directory.
# Kept as a soft require so this example loads/documents cleanly even
# without Net::LDAP installed.
my $HAVE_NET_LDAP = eval { require Net::LDAP; 1 };
## new: connect and bind with the *service* account used to search the
## directory (as opposed to the end user's own credentials, which are
## only used transiently inside authenticate()).
## Required args: host, bind_dn, bind_password, base_dn
## Optional args: id_attr (default 'uid')
sub new {
my ($class, %args) = @_;
for my $required (qw/host bind_dn bind_password base_dn/) {
croak "Concierge::Auth::LDAP: missing required arg '$required'"
unless defined $args{$required} && length $args{$required};
}
examples/1-custom-backend-ldap.pl view on Meta::CPAN
## authenticate: verify a submitted credential. Implemented as a bind
## attempt using the user's own DN and submitted password -- no
## passwords are ever read or stored locally.
sub authenticate ($self, $user_id, $credential) {
my $dn = $self->_dn_for($user_id);
return { success => 0, message => "Unknown user_id" }
unless $dn;
my $bind = $self->{ldap}->bind($dn, password => $credential);
return { success => 0, message => "Invalid credentials" }
if $bind->code;
return { success => 1 };
}
## is_id_known: existence check only -- no credential involved.
sub is_id_known ($self, $user_id) {
my $dn = $self->_dn_for($user_id);
return { success => 1, known => $dn ? 1 : 0 };
}
examples/1-custom-backend-ldap.pl view on Meta::CPAN
## externally-provisioned backend like this one instead reports
## whether the ID is already known to the authority.
sub enroll ($self, $user_id, $credential, $opts = undef) {
my $dn = $self->_dn_for($user_id);
return { success => 0, message => "ID not found in directory" }
unless $dn;
return { success => 1, user_id => $user_id, status => 'already_known' };
}
## change_credentials: modify the userPassword attribute via the
## service bind. Real directories often require the *user's own* bind
## (or directory-specific password-change extended ops) rather than a
## simple attribute replace under a service account; that decision is
## directory-policy-specific and intentionally simplified here.
sub change_credentials ($self, $user_id, $new_credential) {
my $dn = $self->_dn_for($user_id);
return { success => 0, message => "ID not found in directory" }
unless $dn;
my $result = $self->{ldap}->modify(
$dn, replace => { userPassword => $new_credential },
);
return { success => 0, message => $result->error }
if $result->code;
examples/1-custom-backend-ldap.pl view on Meta::CPAN
typical OAuth flow the application never sees the user's password at all --
it receives a token from the provider after a redirect-based exchange the
application mediates but doesn't perform inline.
A Concierge::Auth::OAuth backend would still satisfy the same five methods,
but with different inputs:
authenticate($user_id, $token) # verify an access/ID token instead of a password
is_id_known($user_id) # check a local cache of provider subjects
enroll($user_id, $token, \%opts) # record a new provider subject locally
change_credentials(...) # often a no-op or "revoke + re-link"; OAuth
# providers manage credentials themselves
revoke($user_id) # sever the local association only
The token exchange itself (redirect, authorization code, provider callback)
happens *before* any Concierge::Auth method is called at all -- it's
outside this contract's scope, the same way this LDAP sketch's directory
bind happens outside of any web framework's routing layer. Concierge::Auth
only needs to know how to verify what the application hands it.
=head1 SEE ALSO
examples/README.md view on Meta::CPAN
# Concierge::Auth Examples
## 1-custom-backend-ldap.pl
A sketch of a directory-backed (LDAP) `Concierge::Auth::Base` implementation.
It shows how little code is needed to satisfy the five-method backend
contract (`new`, `authenticate`, `is_id_known`, `enroll`,
`change_credentials`, `revoke`) once you have the connection details for a
real directory server (host, bind DN, bind password, base DN).
This is a documentation sketch, not a shipped backend: it requires
`Net::LDAP` (not a dependency of this distribution) and a real directory
server to run against.
```bash
perl 1-custom-backend-ldap.pl
```
lib/Concierge/Auth.pm view on Meta::CPAN
my $auth = Concierge::Auth->new(
backend_class => 'Concierge::Auth::Pwd',
file => '/path/to/auth.pwd',
);
# $auth is a Concierge::Auth::Pwd instance -- use it directly:
my $result = $auth->enroll('alice', 'secret123');
my $result = $auth->authenticate('alice', 'secret123');
my $result = $auth->is_id_known('alice');
my $result = $auth->change_credentials('alice', 'newsecret456');
my $result = $auth->revoke('alice');
=head1 DESCRIPTION
C<Concierge::Auth> is a thin factory that turns a backend class name
into a live, ready-to-use backend instance. Given a fully-qualified
class name (e.g. C<Concierge::Auth::Pwd>) and whatever arguments that
backend needs, C<new> C<require>s the named module, constructs it, and
hands back the instance directly -- there is no wrapper object or
delegation layer. A conforming backend already fully implements the
L<Concierge::Auth::Base> contract, so the returned object responds
directly to C<authenticate>/C<is_id_known>/C<enroll>/
C<change_credentials>/C<revoke>, and to the
L<Concierge::Auth::Generators> methods, with no extra indirection.
The named backend module is C<require>d dynamically inside C<new> --
this module does not C<use> any concrete backend at compile time. A
desk configured for C<Concierge::Auth::LDAP>, for example, never loads
C<Concierge::Auth::Pwd> at all.
All remaining arguments passed to C<new> (e.g. C<file> for C<::Pwd>;
C<host>/C<bind_dn>/C<password> for a hypothetical C<::LDAP>) are passed
straight through to the backend's own C<new> unexamined --
lib/Concierge/Auth/Base.pm view on Meta::CPAN
# $backend->authenticate($user_id, $credential);
sub authenticate { die "Subclass must implement authenticate" }
# $backend->is_id_known($user_id);
sub is_id_known { die "Subclass must implement is_id_known" }
# $backend->enroll($user_id, $credential, \%opts);
sub enroll { die "Subclass must implement enroll" }
# $backend->change_credentials($user_id, $new_credential);
sub change_credentials { die "Subclass must implement change_credentials" }
# $backend->revoke($user_id);
sub revoke { die "Subclass must implement revoke" }
# Generator methods -- default implementations delegate to the plain
# functions in Concierge::Auth::Generators, preserving its wantarray
# (value)/(value, message) dual-return convention. Unlike the five
# methods above, these are NOT required overrides: a backend that has
# no reason to customize ID/token generation gets a working
# implementation for free. Any backend may still override one or more
lib/Concierge/Auth/Base.pm view on Meta::CPAN
=head1 DESCRIPTION
C<Concierge::Auth::Base> defines the interface that every C<Concierge::Auth>
backend must implement, regardless of how it stores or verifies identity.
Backend implementations (C<Concierge::Auth::Pwd> for the built-in
password-file backend, or alternatives such as an LDAP-backed backend)
inherit from this class and must implement the five methods below.
The contract is deliberately expressed at the level of the domain
operations Concierge itself needs to perform -- "add a user," "change
credentials," "is this ID known," "authenticate" -- rather than at the
level of any one backend's natural storage primitives. The built-in
password-file backend, for example, satisfies this contract internally
using its own file-locking, hashing, and response-formatting helpers, but
those are private implementation detail of that backend and are not part
of this contract. A backend with a fundamentally different
storage/verification model (e.g. an LDAP directory) satisfies the same
five methods however fits its model, without needing anything resembling
those primitives at all.
Concierge::Auth backends are intentionally independent of
lib/Concierge/Auth/Base.pm view on Meta::CPAN
{ success => 1, user_id => $user_id, status => 'created' }
# or, for backends where enrollment is external:
{ success => 1, user_id => $user_id, status => 'already_known' }
Or on failure:
{ success => 0, message => "Error description" }
=head2 change_credentials
my $result = $backend->change_credentials($user_id, $new_credential);
Replaces the credential on file for an existing C<$user_id>. Fails if the
ID is not known to this backend.
Must return:
{ success => 1, user_id => $user_id }
Or on failure:
lib/Concierge/Auth/Pwd.pm view on Meta::CPAN
#
# Full ID format policy (length, character set) is only enforced in
# enroll(), since that's the only place a *new* ID is established and
# needs to conform to storage policy going forward. The other four methods
# operate on an ID that either does or doesn't already exist on file, so a
# malformed-but-nonempty ID simply fails to match -- no separate rejection
# message is needed for it.
# =============================================================================
## validatePwd: checks password format constraints (length). Needed by
## both enroll and change_credentials (each establishes a new credential
## value), so kept as a shared utility rather than duplicated. Not used by
## authenticate: a wrong-length submitted password simply fails to match
## the stored hash, so a separate format check there would be redundant.
sub validatePwd ($self, $password) {
return { success => 0, message => "Password cannot be empty" }
unless defined $password && length($password) > 0;
return { success => 0, message => sprintf(
"Password must be between %d and %d characters",
MIN_PASSWORD_LENGTH, MAX_PASSWORD_LENGTH
) } unless length($password) >= MIN_PASSWORD_LENGTH
lib/Concierge/Auth/Pwd.pm view on Meta::CPAN
};
print $pfh join( $sep => $user_id, $phash, "|\n") or do {
close $pfh;
return { success => 0, message => "enroll: Cannot write to file: $!" };
};
close $pfh or return { success => 0, message => "enroll: Cannot close file: $!" };
return { success => 1, user_id => $user_id, status => 'created' };
}
## change_credentials: replaces the credential on file for an existing
## user_id. Fails if the ID is not known.
sub change_credentials ($self, $user_id, $new_credential) {
return { success => 0, message => "ID cannot be empty" }
unless defined $user_id && length($user_id) > 0;
my $vp = $self->validatePwd($new_credential);
return $vp unless $vp->{success};
my $sep = $FIELD_SEPARATOR;
my $pfile = $self->{auth}->{file} || '';
return { success => 0, message => "Auth file not OK" }
unless $pfile && -e $pfile && -r $pfile;
my $phash = $self->{auth}->hash_password($new_credential);
open my $fh, "+<", $pfile
or return { success => 0, message => "change_credentials: Cannot open file: $!" };
flock($fh, LOCK_EX) or do {
close $fh;
return { success => 0, message => "change_credentials: Cannot lock file: $!" };
};
my @lines = <$fh>;
my $success = 0;
my @output;
for my $line ( @lines ) {
if ( $line =~ /^\Q$user_id\E$sep/) {
push @output => join( $sep => $user_id, $phash, "|\n" );
$success++;
next;
}
push @output, $line;
}
unless (
seek($fh, 0, 0)
and truncate($fh, 0)
and print $fh @output
and close $fh
) {
close $fh;
return { success => 0, message => "change_credentials: File update failed: $!" };
}
return $success
? { success => 1, user_id => $user_id }
: { success => 0, message => "ID $user_id not found to reset password" };
}
## revoke: removes user_id as a known identity. Symmetric with enroll.
## No ID format policy check here -- revoke operates on an existing ID, so
## a malformed-but-nonempty ID just fails to match any record on file.
lib/Concierge/Auth/Pwd.pm view on Meta::CPAN
my $auth = Concierge::Auth::Pwd->new( file => '/path/to/auth.pwd' );
# Or without a file (generators and utilities only)
my $auth = Concierge::Auth::Pwd->new( no_file => 1 );
# --- Concierge::Auth::Base contract methods ---
my $result = $auth->enroll('alice', 'secret123');
my $result = $auth->authenticate('alice', 'secret123');
my $result = $auth->is_id_known('alice');
my $result = $auth->change_credentials('alice', 'newsecret456');
my $result = $auth->revoke('alice');
# --- Backend-specific methods (password-file only) ---
my ($ok, $msg) = $auth->setFile('/path/to/other.pwd');
my $hash = $auth->encryptPwd('secret123');
# Generate tokens and random values (inherited from Concierge::Auth::Base)
my ($uuid, $msg) = $auth->gen_uuid(); # v4 UUID
my ($id, $msg) = $auth->gen_random_id(); # 40-char hex ID
my ($token, $msg) = $auth->gen_random_token(32);
my ($string, $msg) = $auth->gen_random_string(16);
my ($phrase, $msg) = $auth->gen_word_phrase(4, 4, 7, '-');
=head1 DESCRIPTION
Concierge::Auth::Pwd is the built-in password-file backend for
Concierge::Auth. It implements the L<Concierge::Auth::Base> contract
(C<authenticate>, C<is_id_known>, C<enroll>, C<change_credentials>,
C<revoke>) on top of a password store backed by L<Crypt::Passphrase>
with Argon2 encoding and Bcrypt validation for legacy password
migration. Passwords are stored in a tab-separated file with
file-locking for concurrent access.
Token and random value generation (C<gen_uuid>, C<gen_random_id>,
C<gen_random_token>, C<gen_random_string>, C<gen_word_phrase>) is not
implemented by this module -- it is inherited from
L<Concierge::Auth::Base>'s default implementations, which delegate to
L<Concierge::Auth::Generators> (using L<Crypt::PRNG> for
lib/Concierge/Auth/Pwd.pm view on Meta::CPAN
L<Concierge::Auth::Base>:
=over 4
=item * C<authenticate>
=item * C<is_id_known>
=item * C<enroll>
=item * C<change_credentials>
=item * C<revoke>
=back
Each of these methods must return its results in the form of a hashref
with C<{ success => 1|0, message => '...' }>, allowing the calling
application to keep control even if the method fails.
=item * Methods specific to how this backend class manages its password
lib/Concierge/Auth/Pwd.pm view on Meta::CPAN
Returns C<{ success => 1, known => 1|0 }>.
=head2 enroll
my $result = $auth->enroll($user_id, $password);
Creates a new password record for C<$user_id>. C<$user_id> must meet
the length and character constraints (this is the only contract method
that enforces ID format policy, since it's the only one establishing a
new ID). Fails if the ID already exists (use C<change_credentials> to
change an existing password).
Returns C<{ success => 1, user_id => $user_id, status => 'created' }>
or C<{ success => 0, message => '...' }>.
=head2 change_credentials
my $result = $auth->change_credentials($user_id, $new_password);
Replaces the stored password hash for an existing C<$user_id>. Fails if
the ID is not found.
Returns C<{ success => 1, user_id => $user_id }> or
C<{ success => 0, message => '...' }>.
=head2 revoke
my $result = $auth->revoke($user_id);
lib/Concierge/Auth/Pwd.pm view on Meta::CPAN
ID simply fails to match any record on file.
Returns C<{ success => 1, user_id => $user_id }> or
C<{ success => 0, message => '...' }>.
=head2 validatePwd
my $result = $auth->validatePwd($password);
Checks whether C<$password> meets the length constraints. Shared by
C<enroll> and C<change_credentials>, both of which establish a new
credential value; not used by C<authenticate>, since a wrong-length
submitted password simply fails to match the stored hash.
Returns C<{ success => 1 }> or C<{ success => 0, message => '...' }>.
=head1 BACKEND-SPECIFIC METHODS
=head2 File Management
=head3 setFile
t/02-validation.t view on Meta::CPAN
use File::Temp qw/tempfile tempdir/;
use Concierge::Auth;
my $dir = tempdir( CLEANUP => 1 );
my $file = "$dir/auth.pwd";
my $auth = Concierge::Auth->new( backend_class => 'Concierge::Auth::Pwd', file => $file );
# ========== validatePwd ==========
# This is the one format-check kept as a shared method on
# Concierge::Auth::Pwd (both enroll and change_credentials need it).
# It now uses the { success, message } hashref convention.
subtest 'validatePwd - valid passwords' => sub {
for my $pwd ( 'password', 'x' x 8, 'x' x 72, 'P@ssw0rd!123' ) {
my $result = $auth->validatePwd($pwd);
ok( $result->{success}, "valid password (length " . length($pwd) . ")" );
}
};
subtest 'validatePwd - empty' => sub {
t/02-validation.t view on Meta::CPAN
for my $id ( 'ab', 'alice-fmt', 'user_name-fmt', 'user.name-fmt',
'user@host-fmt.com', 'A1-fmt', 'z' x 32 ) {
my $result = $auth->enroll($id, 'password123');
ok( $result->{success}, "valid ID accepted: '$id'" );
}
};
# ========== File-related error conditions ==========
# The old validateFile method no longer exists as a standalone method
# either -- file readiness is now checked inline by each contract
# method that needs it (is_id_known, authenticate, change_credentials,
# revoke). Exercise a couple of them with no file configured.
subtest 'is_id_known - no file configured is simply "not known"' => sub {
my $nofile_auth;
my $w = warnings {
$nofile_auth = Concierge::Auth->new( backend_class => 'Concierge::Auth::Pwd', no_file => 1 );
};
my $result = $nofile_auth->is_id_known('alice');
ok( $result->{success}, 'is_id_known still succeeds (no I/O error)' );
ok( !$result->{known}, 'ID reported as not known when no file is configured' );
};
subtest 'change_credentials - no file configured fails' => sub {
my $nofile_auth;
my $w = warnings {
$nofile_auth = Concierge::Auth->new( backend_class => 'Concierge::Auth::Pwd', no_file => 1 );
};
my $result = $nofile_auth->change_credentials('alice', 'password123');
ok( !$result->{success}, 'change_credentials fails when no file is set' );
like( $result->{message}, qr/not OK/i, 'message indicates file not OK' );
};
done_testing;
t/03-auth.t view on Meta::CPAN
ok( !$result->{success}, 'authenticate rejects wrong password' );
like( $result->{message}, qr/Invalid password/i, 'message mentions invalid password' );
};
subtest 'authenticate - missing user' => sub {
my $result = $auth->authenticate('nonexistent', 'password123');
ok( !$result->{success}, 'authenticate rejects missing user' );
like( $result->{message}, qr/not found/i, 'message mentions not found' );
};
# ========== change_credentials (was resetPwd) ==========
subtest 'change_credentials - change password' => sub {
my $result = $auth->change_credentials('alice', 'newpassword456');
ok( $result->{success}, 'change_credentials succeeds' );
is( $result->{user_id}, 'alice', 'result carries the user ID' );
# Old password should fail
my $old = $auth->authenticate('alice', 'password123');
ok( !$old->{success}, 'old password fails after change' );
# New password should succeed
my $new = $auth->authenticate('alice', 'newpassword456');
ok( $new->{success}, 'new password succeeds after change' );
};
subtest 'change_credentials - missing user' => sub {
my $result = $auth->change_credentials('nonexistent', 'password123');
ok( !$result->{success}, 'change_credentials rejects missing user' );
like( $result->{message}, qr/not found/i, 'message mentions not found' );
};
# ========== revoke (was deleteID) ==========
subtest 'revoke - remove user' => sub {
# First confirm user exists
my $exists = $auth->is_id_known('alice');
ok( $exists->{known}, 'user exists before revoke' );
t/03-auth.t view on Meta::CPAN
subtest 'validation failures - bad ID' => sub {
my $result = $auth->enroll('', 'password123');
ok( !$result->{success}, 'enroll rejects empty ID' );
$result = $auth->is_id_known('x');
ok( !$result->{known}, 'is_id_known reports too-short ID as not known' );
$result = $auth->authenticate('', 'password123');
ok( !$result->{success}, 'authenticate rejects empty ID' );
$result = $auth->change_credentials('', 'password123');
ok( !$result->{success}, 'change_credentials rejects empty ID' );
$result = $auth->revoke('');
ok( !$result->{success}, 'revoke rejects empty ID' );
};
subtest 'validation failures - bad password' => sub {
my $result = $auth->enroll('bob', 'short');
ok( !$result->{success}, 'enroll rejects short password' );
$result = $auth->authenticate('bob', 'short');
ok( !$result->{success}, 'authenticate rejects short password (no match found)' );
$result = $auth->change_credentials('bob', 'short');
ok( !$result->{success}, 'change_credentials rejects short password' );
};
subtest 'validation failures - undef/empty password arg' => sub {
my $result = $auth->enroll('someuser', '');
ok( !$result->{success}, 'enroll rejects empty string password' );
like( $result->{message}, qr/empty/i, 'message mentions empty' );
$result = $auth->change_credentials('someuser', '');
ok( !$result->{success}, 'change_credentials rejects empty string password' );
like( $result->{message}, qr/empty/i, 'message mentions empty' );
};
# ========== confirm/reject/reply response helpers ==========
# These backend-specific helpers remain on Concierge::Auth::Pwd (they
# back its file-management and generator wrapper methods, which retain
# the old dual-return convention). Tested here to cover their
# default-message branches.
subtest 'confirm - default message' => sub {
t/03-auth.t view on Meta::CPAN
};
subtest 'revoke - no file configured' => sub {
my $nf;
my $w = warnings { $nf = Concierge::Auth->new( backend_class => 'Concierge::Auth::Pwd', no_file => 1 ) };
like( $w->[0], qr/Utilities only/i, 'constructor warns when no_file' );
my $result = $nf->revoke('alice');
ok( !$result->{success}, 'revoke fails when no file is set' );
};
subtest 'change_credentials - no file configured' => sub {
my $nf;
my $w = warnings { $nf = Concierge::Auth->new( backend_class => 'Concierge::Auth::Pwd', no_file => 1 ) };
like( $w->[0], qr/Utilities only/i, 'constructor warns when no_file' );
my $result = $nf->change_credentials('alice', 'password123');
ok( !$result->{success}, 'change_credentials fails when no file is set' );
like( $result->{message}, qr/Not OK/i, 'message reflects file validation failure' );
};
done_testing;
t/06-io-failures.t view on Meta::CPAN
my $dir = tempdir( CLEANUP => 1 );
# Warm up Crypt::Passphrase::Argon2 (and its /dev/urandom access) before
# any mocking is active, so its own one-time module-load I/O is never at
# risk of being caught by a FAIL_OPEN toggle below.
Concierge::Auth::Pwd->new( no_file => 1 )->encryptPwd('warm-up-password');
# ========== Concierge::Auth::Base - required-method stubs ==========
subtest 'Base - unimplemented contract methods die' => sub {
for my $method (qw(new authenticate is_id_known enroll change_credentials revoke)) {
like(
dies { Concierge::Auth::Base->$method() },
qr/Subclass must implement $method/,
"$method stub dies with expected message",
);
}
};
# ========== new() - file open/chmod failures ==========
t/06-io-failures.t view on Meta::CPAN
my $file = "$dir/enroll_flock_write.pwd";
my $auth = Concierge::Auth::Pwd->new( file => $file );
unlink $file; # skip the duplicate-check block entirely
local $MockBuiltins::FAIL_FLOCK = 1;
my $result = $auth->enroll('alice', 'password123');
ok( !$result->{success}, 'enroll fails when the write-lock fails' );
like( $result->{message}, qr/Cannot lock file for writing/, 'message reflects lock failure' );
};
# ========== change_credentials() ==========
subtest 'change_credentials - pfile set but file missing' => sub {
my $file = "$dir/change_missing.pwd";
my $auth = Concierge::Auth::Pwd->new( file => $file );
$auth->enroll('alice', 'password123');
unlink $file;
my $result = $auth->change_credentials('alice', 'newpassword456');
ok( !$result->{success}, 'change_credentials fails when file has vanished' );
like( $result->{message}, qr/Auth file not OK/, 'message reflects file check failure' );
};
subtest 'change_credentials - open failure' => sub {
my $file = "$dir/change_open.pwd";
my $auth = Concierge::Auth::Pwd->new( file => $file );
$auth->enroll('alice', 'password123');
local $MockBuiltins::FAIL_OPEN = 1;
local $MockBuiltins::FAIL_OPEN_PATH = $file;
my $result = $auth->change_credentials('alice', 'newpassword456');
ok( !$result->{success}, 'change_credentials fails when file cannot be opened' );
like( $result->{message}, qr/Cannot open file/, 'message reflects open failure' );
};
subtest 'change_credentials - flock failure' => sub {
my $file = "$dir/change_flock.pwd";
my $auth = Concierge::Auth::Pwd->new( file => $file );
$auth->enroll('alice', 'password123');
local $MockBuiltins::FAIL_FLOCK = 1;
my $result = $auth->change_credentials('alice', 'newpassword456');
ok( !$result->{success}, 'change_credentials fails when file cannot be locked' );
like( $result->{message}, qr/Cannot lock file/, 'message reflects lock failure' );
};
# ========== revoke() ==========
subtest 'revoke - pfile set but file missing' => sub {
my $file = "$dir/revoke_missing.pwd";
my $auth = Concierge::Auth::Pwd->new( file => $file );
$auth->enroll('alice', 'password123');
unlink $file;
( run in 0.594 second using v1.01-cache-2.11-cpan-aadc1410aed )