iterations results from the CPAN

iterations

Developer-Dashboard

view release on metacpan or search on metacpan

lib/Developer/Dashboard/Auth.pm view on Meta::CPAN

sub add_user {
    my ( $self, %args ) = @_;
    my $username = $args{username} || die 'Missing username';
    my $password = $args{password} || die 'Missing password';
    my $role     = $args{role}     || 'helper';
    die 'Username contains unsupported characters'
      if $username !~ /\A[A-Za-z0-9_.-]{1,64}\z/;
    die 'Password must be at least 8 characters long'
      if length($password) < 8;
    my $salt       = sha256_hex( join ':', $$, time, rand(), $username );
    my $iterations = $PBKDF2_ITERATIONS;
    my $record     = {
        username        => $username,
        role            => $role,
        salt            => $salt,
        password_scheme => $PBKDF2_SCHEME,
        iterations      => $iterations,
        password_hash   => _pbkdf2_hmac_sha256_hex( $password, $salt, $iterations ),
        updated_at      => _now_iso8601(),
    };
    my $file = $self->_user_file($username);
    open my $fh, '>:raw', $file or die "Unable to write $file: $!";
    print {$fh} json_encode($record);
    close $fh;
    chmod 0600, $file;
    return $record;
}

lib/Developer/Dashboard/Auth.pm view on Meta::CPAN


# _expected_password_hash($user, $username, $password)
# Recomputes the stored password hash for a record using that record's own
# scheme so legacy and stretched records both verify against the right
# derivation.
# Input: stored user hash reference, username string, candidate password string.
# Output: expected password-hash hex string for the record's declared scheme.
sub _expected_password_hash {
    my ( $self, $user, $username, $password ) = @_;
    if ( ( $user->{password_scheme} || '' ) eq $PBKDF2_SCHEME ) {
        my $iterations = $user->{iterations} || $PBKDF2_ITERATIONS;    # uncoverable condition false
        return _pbkdf2_hmac_sha256_hex( $password, $user->{salt}, $iterations );
    }
    return $self->_password_hash( $username, $password, $user->{salt} );
}

# get_user($username)
# Loads a single stored user record by username.
# Input: username string.
# Output: user hash reference or undef when missing.
sub get_user {
    my ( $self, $username ) = @_;

lib/Developer/Dashboard/Auth.pm view on Meta::CPAN

# Derives the legacy single-round SHA-256 password hash for a user. Retained
# only so pre-existing helper records created before password stretching keep
# verifying; new records use the PBKDF2 scheme instead.
# Input: username string, password string, salt string.
# Output: hash string.
sub _password_hash {
    my ( $self, $username, $password, $salt ) = @_;
    return sha256_hex( join ':', $salt, $username, $password );
}

# _pbkdf2_hmac_sha256_hex($password, $salt, $iterations)
# Stretches a password with PBKDF2-HMAC-SHA256 (RFC 2898). The 32-byte SHA-256
# output equals the derived-key length, so exactly one output block is needed.
# Input: password string, salt string, positive iteration count.
# Output: 64-character lowercase hex string of the derived key.
sub _pbkdf2_hmac_sha256_hex {
    my ( $password, $salt, $iterations ) = @_;
    my $u      = hmac_sha256( $salt . pack( 'N', 1 ), $password );
    my $result = $u;
    for ( 2 .. $iterations ) {
        $u = hmac_sha256( $u, $password );
        $result ^= $u;
    }
    return unpack( 'H*', $result );
}

# _secure_compare($left, $right)
# Compares two strings in length-constant time so password-hash verification
# does not leak how many leading characters matched through timing.
# Input: two strings (either may be undef).

lib/Developer/Dashboard/PageRuntime.pm view on Meta::CPAN

    # wait has already reaped it, and a reaped pid can be reissued by the OS.
    kill 9, $pid if !$drained && kill 0, $pid;
    return 1;
}

# _await_saved_ajax_exit($pid, $process_group, $status_ref)
# Waits out the SIGTERM grace window after a saved-Ajax worker was signalled,
# reaping the worker the moment it exits so its own TERM handler is never cut
# short and the caller does not block on a second wait. Elapsed wall-clock time
# bounds the wait, so the escalation is deterministic instead of depending on a
# fixed number of poll iterations.
# Input: worker pid, owned POSIX process-group id or undef for direct-pid
# cleanup, and an optional scalar reference that receives the reaped wait status.
# Output: true when the worker and any owned group went away inside the window,
# false when the window expired with something still alive.
sub _await_saved_ajax_exit {
    my ( $self, $pid, $process_group, $status_ref ) = @_;
    my $deadline = Time::HiRes::time() + $SAVED_AJAX_TERM_GRACE_SECONDS;
    my $reaped   = 0;
    while (1) {
        if ( !$reaped ) {

t/14-coverage-closure-extra.t view on Meta::CPAN

        sleep 30;
        exit 0;
    }
    open my $fh, '>', $pidfile or die $!;
    print {$fh} $managed_child;
    close $fh;
    # Wait BEFORE the first running_loops call, not around it. This pidfile has
    # no loop state, so the child's process title is the only evidence of its
    # identity, and running_loops deletes the pidfile of any same-namespace pid it
    # cannot recognize. A poll loop therefore destroys its own fixture on the
    # first iteration and can never recover, however many iterations it is given.
    ok(
        wait_for_managed_loop( $runner, $managed_child, $loop_name ),
        'managed loop child becomes identifiable before running_loops reads the collectors root',
    );
    my @loops = $runner->running_loops;
    is( scalar @loops, 1, 'running_loops lists active managed loop pids' );
    is( $loops[0]{name}, $loop_name, 'running_loops returns the managed loop name' );

    $collector_store->mark_run_started( $loop_name, {} );
    ok( $collector_store->read_status($loop_name)->{running}, 'collector status reports running before the loop is stopped' );

t/144-collector-fixture-recognition-race.t view on Meta::CPAN

# unmanaged branch, never signals the child, and returns the recorded pid, so
# waitpid reports 0 - "the child is still there" - where the fixture expects -1.
is( $runner->stop_loop('fixture.untitled'), $untitled, 'stop_loop returns the recorded pid even for a loop it does not recognize' );
is( waitpid( $untitled, WNOHANG ), 0, 'an unrecognized loop child is left running and unreaped, which is the "got 0, expected -1" failure' );
ok( kill( 0, $untitled ), 'the unrecognized loop child really is still alive rather than exited-but-unreaped' );
reap_fixture_child($untitled);

# running_loops is worse than a missed probe: it deletes the pidfile of any
# same-namespace pid it cannot recognize. A fixture that polls running_loops
# before its child is recognizable therefore destroys its own fixture on the
# first iteration, and no number of further iterations can recover it.
my $swept = fork_fixture_child( 0, undef );
my $swept_pidfile = write_bare_pidfile( 'fixture.swept', $swept );
my @swept_rows = $runner->running_loops;
is( scalar( grep { $_->{name} eq 'fixture.swept' } @swept_rows ), 0, 'running_loops does not list a loop whose child has not adopted the managed title' );
ok( !-e $swept_pidfile, 'running_loops deletes the unrecognized pidfile, so a later poll iteration can never see the loop' );
reap_fixture_child($swept);

# Waiting on the runner's own predicate first makes both behaviours
# deterministic without weakening either assertion: the title path is still the
# one being exercised, and the shutdown still has to reap the child.

t/47-zombie-coverage-closure.t view on Meta::CPAN

=head1 WHY IT EXISTS

The broader runtime and refactor suites carry a lot of setup and monkey-patched
state. These two coverage points are simpler and more reliable when exercised in
their own minimal test file.

=head1 WHEN TO USE

Use this focused regression while changing collector child-reaping behavior,
forced worker shutdown, or the runtime helper command detection code. It is
meant for narrow zombie-fix iterations where the broader runtime suites would
add unnecessary setup noise.

=head1 HOW TO USE

Run it directly while iterating on collector zombie handling or runtime helper
resolution:

  prove -lv t/47-zombie-coverage-closure.t

Run it under coverage when closing the final library coverage gap:

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

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};

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

# 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';

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

    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' );

( run in 2.838 seconds using v1.01-cache-2.11-cpan-4ab04211f4c )