view release on metacpan or  search on metacpan

t/57-hunt-auth.t  view on Meta::CPAN

use strict;
use warnings FATAL => 'all';

use Digest::SHA qw(sha256_hex hmac_sha256);
use File::Spec;
use File::Temp qw(tempdir);
use Socket qw(AF_INET pack_sockaddr_in inet_aton);
use Test::More;

use lib 'lib';

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

# reference_pbkdf2($password, $salt, $iterations)
# Independent PBKDF2-HMAC-SHA256 reference (single output block) used to
# cross-check the module implementation against RFC test vectors.
# Input: password string, salt string, iteration count.
# Output: 64-character lowercase hex derived key.
sub reference_pbkdf2 {
    my ( $password, $salt, $iterations ) = @_;
    my $u   = hmac_sha256( $salt . pack( 'N', 1 ), $password );
    my $out = $u;
    for ( 2 .. $iterations ) {
        $u = hmac_sha256( $u, $password );
        $out ^= $u;
    }
    return unpack( 'H*', $out );
}

my $home  = tempdir( CLEANUP => 1 );
local $ENV{HOME} = $home;
local $ENV{DEVELOPER_DASHBOARD_BOOKMARKS};
local $ENV{DEVELOPER_DASHBOARD_CONFIGS};
local $ENV{DEVELOPER_DASHBOARD_CHECKERS};

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

# ---------------------------------------------------------------------------
# Finding (2): helper passwords must be stretched with a work factor, not a
# single unstretched SHA-256, while pre-existing SHA-256 records keep working.
# ---------------------------------------------------------------------------

# The module's PBKDF2 helper must match published PBKDF2-HMAC-SHA256 vectors,
# proving the stretching primitive is correct and not a bespoke miscalculation.
is(
    Developer::Dashboard::Auth::_pbkdf2_hmac_sha256_hex( 'password', 'salt', 1 ),
    '120fb6cffcf8b32c43e7225256c4f837a86548c92ccc35480805987cb70be17b',
    'pbkdf2 matches the RFC vector for one iteration',
);
is(
    Developer::Dashboard::Auth::_pbkdf2_hmac_sha256_hex( 'password', 'salt', 2 ),
    'ae4d0c95af6b46d32d0adff928f06dd02a303f8ef3c251dfd6e2d85a95474c43',
    'pbkdf2 matches the RFC vector for two iterations',
);
is(
    Developer::Dashboard::Auth::_pbkdf2_hmac_sha256_hex( 'password', 'salt', 4096 ),
    reference_pbkdf2( 'password', 'salt', 4096 ),
    'pbkdf2 agrees with an independent reference at a higher work factor',
);

my $username = 'stretchuser';
my $password = 'helper-pass-123';
my $record   = $auth->add_user( username => $username, password => $password );

is( $record->{password_scheme}, 'pbkdf2-hmac-sha256', 'add_user records the stretched password scheme' );
cmp_ok( $record->{iterations}, '>=', 200_000, 'add_user records a strong PBKDF2 work factor' );
is( length( $record->{password_hash} ), 64, 'stored password hash is a 32-byte derived key in hex' );

my $unstretched = sha256_hex( join ':', $record->{salt}, $username, $password );
isnt(
    $record->{password_hash},
    $unstretched,
    'stored password hash is stretched, not a single-round salted SHA-256',
);
is(
    $record->{password_hash},
    reference_pbkdf2( $password, $record->{salt}, $record->{iterations} ),
    'stored password hash is exactly the PBKDF2 derivation of the password',
);

ok( $auth->verify_user( username => $username, password => $password ), 'correct password verifies against a stretched record' );
ok( !$auth->verify_user( username => $username, password => 'wrong-password' ), 'wrong password is rejected for a stretched record' );

# Backward compatibility: a helper record written before stretching existed has
# no scheme label and a single-round SHA-256 hash. It must still verify so an
# upgrade never locks established helper users out of their own dashboard.
my $legacy_user = 'legacyhelper';
my $legacy_salt = 'legacy-fixed-salt';
my $legacy_pass = 'legacy-pass-123';
my $legacy_record = {
    username      => $legacy_user,
    role          => 'helper',
    salt          => $legacy_salt,
    password_hash => sha256_hex( join ':', $legacy_salt, $legacy_user, $legacy_pass ),
    updated_at    => '2026-01-01T00:00:00Z',
};
my $legacy_file = File::Spec->catfile( $paths->users_root, "$legacy_user.json" );
open my $lfh, '>:raw', $legacy_file or die "Unable to write $legacy_file: $!";
print {$lfh} json_encode($legacy_record);
close $lfh;

ok( $auth->verify_user( username => $legacy_user, password => $legacy_pass ), 'legacy single-round SHA-256 records still verify (no lockout on upgrade)' );
ok( !$auth->verify_user( username => $legacy_user, password => 'nope' ), 'legacy records still reject wrong passwords' );

# The constant-time comparison must behave like equality across the edge cases
# that matter for hash checking without leaking match progress via early exit.
ok( Developer::Dashboard::Auth::_secure_compare( 'abc123', 'abc123' ), 'secure compare accepts identical strings' );
ok( !Developer::Dashboard::Auth::_secure_compare( 'abc123', 'abc124' ), 'secure compare rejects equal-length differing strings' );
ok( !Developer::Dashboard::Auth::_secure_compare( 'abc', 'abcd' ), 'secure compare rejects length mismatches' );
ok( !Developer::Dashboard::Auth::_secure_compare( undef, 'abc' ), 'secure compare rejects an undefined operand' );

# ---------------------------------------------------------------------------
# Finding (1): DNS-rebinding admin-trust — FIXED.  Arbitrary hostnames that
# merely resolve to loopback are no longer trusted as admin.  Well-known
# local machine aliases (localhost, localhost.localdomain) are still
# accepted without DNS resolution.
# ---------------------------------------------------------------------------

is(
    $auth->trust_tier( remote_addr => '127.0.0.1', host => '127.0.0.1:7890' ),
    'admin',
    'literal loopback host over a loopback connection stays admin',
);
is(
    $auth->trust_tier( remote_addr => '10.0.0.9', host => '127.0.0.1:7890' ),
    'helper',
    'a non-loopback client never gains admin regardless of the host header',
);
is(
    $auth->trust_tier(
        remote_addr          => '127.0.0.1',
        host                 => 'dashboard-alias.example:7890',
        extra_loopback_hosts => ['dashboard-alias.example'],
    ),
    'admin',
    'an explicitly configured local alias host stays admin',
);