view release on metacpan or  search on metacpan

t/82-auth-coverage.t  view on Meta::CPAN

#!/usr/bin/env perl

use strict;
use warnings;
use utf8;

use Test::More;
use File::Spec;
use File::Temp qw(tempdir);
use Socket qw(AF_INET6);

use lib 'lib';

use Developer::Dashboard::PathRegistry;
use Developer::Dashboard::FileRegistry;
use Developer::Dashboard::Auth;
use Developer::Dashboard::JSON qw(json_encode);

# Hermetic runtime rooted in a throwaway HOME. The auth config layer resolves
# from the deepest .developer-dashboard directory found walking up from the cwd,
# so we must chdir into the temp home before building the registries.
my $home = tempdir( CLEANUP => 1 );
local $ENV{HOME} = $home;
chdir $home or die "Unable to chdir to $home: $!";

my $paths = Developer::Dashboard::PathRegistry->new( home => $home );
my $files = Developer::Dashboard::FileRegistry->new( paths => $paths );
my $auth  = Developer::Dashboard::Auth->new( paths => $paths, files => $files );

isa_ok( $auth, 'Developer::Dashboard::Auth', 'constructed auth manager' );

# new() rejects missing registries -- exercises the die side of both ||-guards.
{
    my $no_paths = eval { Developer::Dashboard::Auth->new(); 1 } ? '' : $@;
    like( $no_paths, qr/Missing path registry/, 'new dies without a path registry' );
    my $no_files = eval { Developer::Dashboard::Auth->new( paths => $paths ); 1 } ? '' : $@;
    like( $no_files, qr/Missing file registry/, 'new dies without a file registry' );
}

# add_user success plus every guarded rejection path.
{
    my $record = $auth->add_user( username => 'alice', password => 'password123' );
    is( $record->{username}, 'alice', 'add_user stores the requested username' );
    is( $record->{iterations}, 210_000, 'add_user records the default PBKDF2 work factor' );

    my $no_username = eval { $auth->add_user( password => 'password123' ); 1 } ? '' : $@;
    like( $no_username, qr/Missing username/, 'add_user dies without a username' );

    my $no_password = eval { $auth->add_user( username => 'bob' ); 1 } ? '' : $@;
    like( $no_password, qr/Missing password/, 'add_user dies without a password' );

    my $bad_username = eval { $auth->add_user( username => 'bad name!', password => 'password123' ); 1 } ? '' : $@;
    like( $bad_username, qr/unsupported characters/, 'add_user rejects unsupported username characters' );

    my $short_password = eval { $auth->add_user( username => 'carol', password => 'short' ); 1 } ? '' : $@;
    like( $short_password, qr/at least 8 characters/, 'add_user rejects passwords shorter than eight characters' );

    # Force the write-failure die: make the target record path an existing
    # directory so the ">:raw" open cannot succeed.
    my $victim_file = $auth->_user_file('victim');
    mkdir $victim_file or die "Unable to stage directory $victim_file: $!";
    my $write_fail = eval { $auth->add_user( username => 'victim', password => 'password123' ); 1 } ? '' : $@;
    like( $write_fail, qr/Unable to write/, 'add_user dies when the record file cannot be opened for writing' );
}

# verify_user guards, the PBKDF2 verification path, and a record that omits the
# iteration count (so the default work factor fills in).
{
    ok( !defined $auth->verify_user(), 'verify_user returns undef without a username' );
    ok( !defined $auth->verify_user( username => 'alice' ), 'verify_user returns undef without a password' );
    ok( $auth->verify_user( username => 'alice', password => 'password123' ), 'verify_user accepts a valid PBKDF2 login' );
    ok( !defined $auth->verify_user( username => 'alice', password => 'wrongpass1' ), 'verify_user rejects a wrong password' );

    my $salt = 'coverage-salt';
    my $hash = Developer::Dashboard::Auth::_pbkdf2_hmac_sha256_hex( 'password123', $salt, 210_000 );
    my $file = $auth->_user_file('noiter');
    open my $fh, '>', $file or die "Unable to write $file: $!";
    print {$fh} json_encode(
        {
            username        => 'noiter',
            role            => 'helper',
            salt            => $salt,
            password_scheme => 'pbkdf2-hmac-sha256',
            password_hash   => $hash,
        }
    );
    close $fh;
    ok(
        $auth->verify_user( username => 'noiter', password => 'password123' ),
        'verify_user falls back to the default work factor when a record omits its iteration count',
    );
}

# get_user must surface an open failure on a record that exists but is
# unreadable (running as a non-root owner, mode 0000 denies our own read).
{
    my $locked = $auth->_user_file('locked');
    open my $fh, '>', $locked or die "Unable to write $locked: $!";
    print {$fh} json_encode( { username => 'locked' } );
    close $fh;
    chmod 0000, $locked;
    my $read_fail = eval { $auth->get_user('locked'); 1 } ? '' : $@;
    like( $read_fail, qr/Unable to read/, 'get_user dies when an existing record cannot be opened for reading' );
    chmod 0600, $locked;