view release on metacpan or  search on metacpan

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

# per-record so each stored hash is always verified with its own work factor.
my $PBKDF2_ITERATIONS = 210_000;

# Scheme label stored in a helper-user record so verify_user knows which
# derivation to reproduce. Records without this key are legacy single-round
# SHA-256 hashes and are still accepted for backward compatibility.
my $PBKDF2_SCHEME = 'pbkdf2-hmac-sha256';

# new(%args)
# Constructs an auth manager bound to file and path registries.
# Input: files and paths objects.
# Output: Developer::Dashboard::Auth object.
sub new {
    my ( $class, %args ) = @_;
    my $paths = $args{paths} || die 'Missing path registry';
    my $files = $args{files} || die 'Missing file registry';
    return bless {
        paths => $paths,
        files => $files,
    }, $class;
}

# trust_tier(%args)
# Classifies a request as trusted admin or helper tier.
# Input: remote_addr and host values from the current request, plus optional
# extra_loopback_hosts array reference for configured local-only alias hosts.
# Output: tier string, currently 'admin' or 'helper'.
sub trust_tier {
    my ( $self, %args ) = @_;
    my $remote_addr = $self->_canonical_ip( $args{remote_addr} );
    my $host = $self->_canonical_host( $args{host} );
    # Behind the SSL front-proxy every backend connection arrives from the
    # proxy's loopback socket, so remote_addr is ALWAYS loopback and can no
    # longer prove the real client is local. Never grant the loopback-admin
    # shortcut in that mode -- require an explicit helper login instead.
    return 'helper' if $args{ssl_proxied};
    return 'admin' if $self->_request_is_loopback_admin(
        remote_addr          => $remote_addr,
        host                 => $host,
        extra_loopback_hosts => $args{extra_loopback_hosts},
    );
    return 'helper';
}

# add_user(%args)
# Creates or replaces a file-backed helper user record.
# Input: username, password, and optional role.
# Output: saved user hash reference; the stored password is stretched with
# PBKDF2-HMAC-SHA256 and the scheme/iteration work factor is recorded alongside
# it so verification can reproduce the exact derivation later.
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;
}

# verify_user(%args)
# Verifies a username/password pair against stored auth data.
# Input: username and password.
# Output: user hash reference on success or undef on failure. New records are
# verified with PBKDF2-HMAC-SHA256; pre-existing single-round SHA-256 records
# stay verifiable so upgrading the scheme never locks out established users.
sub verify_user {
    my ( $self, %args ) = @_;
    my $username = $args{username} || return;
    my $password = $args{password} || return;
    my $user = $self->get_user($username) or return;
    my $expected = $self->_expected_password_hash( $user, $username, $password );
    return if !_secure_compare( $expected, $user->{password_hash} );
    return $user;
}

# _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 ) = @_;
    for my $file ( $self->_user_file_candidates($username) ) {
        next if !-f $file;
        open my $fh, '<:raw', $file or die "Unable to read $file: $!";
        local $/;
        return json_decode( scalar <$fh> );
    }
    return;
}

# list_users()
# Lists all valid stored user records.
# Input: none.
# Output: sorted list of user hash references.
sub list_users {
    my ($self) = @_;
    my %users;
    for my $root ( reverse $self->{paths}->users_roots ) {
        opendir my $dh, $root or next;
        while ( my $entry = readdir $dh ) {
            next if $entry eq '.' || $entry eq '..';
            next if $entry !~ /(.*)\.json$/;
            my $user = eval { $self->get_user($1) };
            $users{$1} = $user if $user;
        }
        closedir $dh;
    }
    return sort { $a->{username} cmp $b->{username} } values %users;
}

# remove_user($username)
# Removes a stored user record by username.
# Input: username string.
# Output: true value.
sub remove_user {
    my ( $self, $username ) = @_;
    unlink $_ for grep { -f $_ } $self->_user_file_candidates($username);
    return 1;
}

# login_page(%args)
# Builds the helper login page HTML.
# Input: optional message text and optional redirect_to path/query string.
# Output: HTML string.
sub login_page {
    my ( $self, %args ) = @_;
    my $message = $args{message} || 'Helper access requires login.';
    my $redirect_to = defined $args{redirect_to} ? $args{redirect_to} : '';
    $message =~ s/&/&amp;/g;
    $message =~ s/</&lt;/g;
    $message =~ s/>/&gt;/g;

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

        if ( defined $family && $family == AF_INET ) {
            my ( undef, $packed_addr ) = unpack_sockaddr_in($addr);
            $ip = inet_ntoa($packed_addr);
        }
        elsif ( defined $family && $family == AF_INET6 ) {
            my ( undef, $packed_addr ) = unpack_sockaddr_in6($addr);
            $ip = inet_ntop( AF_INET6, $packed_addr );
        }
        $ip = $self->_canonical_ip($ip);
        next if $ip eq '';
        next if $seen{$ip}++;
        push @ips, $ip;
    }
    return @ips;
}

# _canonical_ip($value)
# Normalizes one IPv4/IPv6 literal into a comparable canonical string.
# Input: raw IP string.
# Output: canonical IP string or the original value when it is not an IP literal.
sub _canonical_ip {
    my ( $self, $value ) = @_;
    return '' if !defined $value;
    $value =~ s/^\s+//;
    $value =~ s/\s+$//;
    return '' if $value eq '';
    if ( $value =~ /\A(?:\d{1,3}\.){3}\d{1,3}\z/ ) {
        return $value;
    }
    if ( $value =~ /:/ ) {
        my $packed = Socket::inet_pton( AF_INET6, $value );
        return defined $packed ? lc( inet_ntop( AF_INET6, $packed ) ) : lc $value;
    }
    return lc $value;
}

# _ip_is_loopback($ip)
# Reports whether one canonical IP literal is loopback-only.
# Input: canonical IPv4/IPv6 literal string.
# Output: boolean true for 127.0.0.0/8 with valid 0-255 octets or ::1; strings
# with out-of-range octets such as 127.0.0.999 are not treated as loopback.
sub _ip_is_loopback {
    my ( $self, $ip ) = @_;
    return 0 if !defined $ip || $ip eq '';
    return 1 if $ip =~ /\A127(?:\.(?:25[0-5]|2[0-4][0-9]|1[0-9]{2}|[1-9]?[0-9])){3}\z/;
    return 1 if $ip eq '::1' || $ip eq '0:0:0:0:0:0:0:1';
    return 0;
}

# _password_hash($username, $password, $salt)
# 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).
# Output: boolean true only when both are defined, equal length, and identical.
sub _secure_compare {
    my ( $left, $right ) = @_;
    return 0 if !defined $left || !defined $right;
    return 0 if length($left) != length($right);
    my $diff = 0;
    $diff |= ord( substr( $left, $_, 1 ) ) ^ ord( substr( $right, $_, 1 ) )
      for 0 .. length($left) - 1;
    return $diff == 0 ? 1 : 0;
}

# _now_iso8601()
# Returns the current UTC timestamp in ISO-8601 form.
# Input: none.
# Output: timestamp string.
sub _now_iso8601 {
    my @t = gmtime();
    return strftime( '%Y-%m-%dT%H:%M:%SZ', @t );
}

1;

__END__

=head1 NAME

Developer::Dashboard::Auth - local auth and trust-tier handling

=head1 SYNOPSIS

  my $auth = Developer::Dashboard::Auth->new(files => $files, paths => $paths);
  my $user = $auth->verify_user(username => 'mvu', password => 'example-pass-123');

=head1 DESCRIPTION

This module implements the local-first trust model for Developer Dashboard.
Loopback requests using loopback-local IPs such as C<127.0.0.1> or C<::1>,
explicitly configured local alias names, or the well-known hostnames
C<localhost>, C<localhost.localdomain>, C<localhost6>, and
C<localhost6.localdomain6> can be treated as trusted admin access, while
all other requests authenticate through file-backed helper user records.

DNS-rebinding protection: hostnames that merely resolve to loopback addresses
via DNS are NOT granted admin trust.  Only the well-known local-machine
aliases listed above, configured C<extra_loopback_hosts>, and literal loopback
IPs are accepted.  This prevents an attacker-controlled hostname that resolves
to C<127.0.0.1> from gaining admin access over a loopback connection.

Helper passwords are stored stretched with PBKDF2-HMAC-SHA256 and each record
carries its own scheme label and iteration work factor. Helper records written