view release on metacpan or  search on metacpan

lib/AmberDB/Base.pm  view on Meta::CPAN

        },
        simple => sub {
            my $val = shift;
            $self->{_cfg}->{simple} = $val ? 1 : 0;
            $self->_invalidate_table_paths();
        },
        use_ramdisk => sub {
            my $val = shift;
            my $tier = $self->_normalize_ramdisk_tier($val);
            if ( $tier == 3 ) {
                $tier = 0;
            }
            $self->{_cfg}->{use_ramdisk} = $tier;
            $self->_invalidate_table_paths();
        },
    };

    while ( my ( $key, $val ) = each %pairs ) {
        if ( exists $hooks->{$key} ) {
            $hooks->{$key}->($val);
        }
        else {
            $self->{_cfg}->{$key} = $val;
            if ( $key eq 'user' ) {
                $self->{_connect}->{username} = $val;
            }
        }
    }

    return $self;
}

# my $dbase_dir = $adb->path("dbase_dir");         # getter
# $adb->path({ backup_dir => "$tmpdir/backup" });  # setter
# $adb->path( custom_path => "/opt/data" );        # setter
# ------------------------------------------------
sub path {
    my ( $self, @args ) = @_;

    # 1. No arguments: return shallow copy of all path mappings
    if ( !@args ) {
        return { %{ $self->{_path} || {} } };
    }

    # 2. Single scalar argument: getter -> $adb->path('dbase_dir')
    if ( @args == 1 && !ref( $args[0] ) ) {
        return $self->{_path}->{ $args[0] } // '';
    }

    # 3. Setter: key-value list or hashref
    my %pairs = ( @args == 1 && ref( $args[0] ) eq 'HASH' ) ? %{ $args[0] } : @args;

    for my $key ( keys %pairs ) {
        $self->{_path}->{$key} = $pairs{$key};
    }
    $self->_invalidate_table_paths();

    return $self;
}

# Invalidate cached table paths if global path-affecting configurations change
# ------------------------------------------------
sub _invalidate_table_paths {
    my ($self) = @_;

    if ( $self->{_table} && ref( $self->{_table} ) eq 'HASH' ) {
        for my $tbl ( keys %{ $self->{_table} } ) {
            delete $self->{_table}->{$tbl}->{_path}
              if ref( $self->{_table}->{$tbl} ) eq 'HASH';
        }
    }
}

# ============================================================================
# AUTHENTICATION & PASSWORD CRYPTOGRAPHY (Salted SHA-256)
# ============================================================================

# my $shadow = $adb->hash_password($password, [$salt]);
# ---------------------------------------------------------------------
sub hash_password {
    my ( $self, $password, $salt ) = @_;
    return '' unless defined $password && length $password;

    # 16-character cryptographically secure hex salt
    $salt //= sprintf( "%08x%08x", int( rand(0xFFFFFFFF) ), int( rand(0xFFFFFFFF) ) );

    my $hash = sha256_hex( $salt . $password );
    return "sha256\$$salt\$$hash";
}

# my $ok = $adb->verify_password($password, $stored_shadow);
# ---------------------------------------------------------------------
sub verify_password {
    my ( $self, $password, $stored_shadow ) = @_;
    # Passwordless allowed if stored shadow is empty or undef
    return 1 if !defined $stored_shadow || !length $stored_shadow;
    $password //= '';

    my ( $algo, $salt, $expected ) = split /\$/, $stored_shadow;
    return 0 unless defined $algo && defined $salt && defined $expected;

    if ( $algo eq 'sha256' ) {
        my $computed = sha256_hex( $salt . $password );
        return lc($computed) eq lc($expected) ? 1 : 0;
    }
    return $stored_shadow eq $password ? 1 : 0;
}

# ============================================================================
# DATABASE CONNECTION & CLIENT AUTH PROFILE (connect.pl)
# ============================================================================

sub _connect_file {
    my ($self) = @_;
    my $config_dir = $self->path('config_dir') || ( ( $self->path('dbase_dir') || "." ) . "/config" );
    return "$config_dir/connect.pl";
}

sub _load_connect_config {
    my ($self) = @_;
    my $file = $self->_connect_file();