view release on metacpan or  search on metacpan

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

    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 $conf_dir = $self->path('conf_dir') || ( ( $self->path('dbase_dir') || "." ) . "/config" );
    return "$conf_dir/connect.pl";
}

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

    my $target = ( $file =~ m{^(?:\./|[a-zA-Z]:|/|\\)} ) ? $file : "./$file";
    my $data = do $target;
    return undef unless ref($data) eq 'HASH';

    # Auto-upgrade: if any user entry or top-level entry has plain 'password', hash into 'shadow' and delete 'password'
    my $modified = 0;
    if ( defined $data->{password} && length $data->{password} ) {
        $data->{shadow} = $self->hash_password( delete $data->{password} );
        $modified = 1;
    }
    if ( $data->{users} && ref( $data->{users} ) eq 'HASH' ) {
        for my $u ( keys %{ $data->{users} } ) {
            my $u_info = $data->{users}->{$u};
            next unless ref($u_info) eq 'HASH';
            if ( defined $u_info->{password} && length $u_info->{password} ) {
                $u_info->{shadow} = $self->hash_password( delete $u_info->{password} );
                $modified = 1;
            }
        }
    }
    if ($modified) {
        $self->_save_connect_config($data);
    }

    return $data;
}

sub _save_connect_config {
    my ( $self, $data ) = @_;
    my $file = $self->_connect_file();
    return unless defined $file && ref($data) eq 'HASH';

    my ($dir) = $file =~ m{^(.+)[/\\][^/\\]+$};
    $self->make_path($dir) if $dir && !$self->dir_exist($dir);

    require Data::Dumper;
    local $Data::Dumper::Terse    = 1;
    local $Data::Dumper::Indent   = 1;
    local $Data::Dumper::Sortkeys = 1;
    my $dump = Data::Dumper::Dumper($data);
    $dump =~ s/^\s+|\s+$//g;

    if ( open my $fh, '>', $file ) {
        print $fh "# AmberDB Database Connection & Client Auth Profile\n";
        print $fh "return " . $dump . ";\n";
        close $fh;
        return 1;
    }
    return 0;
}

# my $sess_path = $adb->session_file($token);
# ---------------------------------------------------------------------
sub session_file {
    my ( $self, $token ) = @_;
    return '' unless defined $token && length $token;
    my $sess_dir = $self->path('session_dir') || ( ( $self->path('dbase_dir') || "." ) . "/session" );
    return "$sess_dir/cli_$token";
}

# my $token = $adb->generate_token();
# ---------------------------------------------------------------------
sub generate_token {
    my ($self) = @_;
    for ( 1 .. 1000 ) {
        my $token = sprintf( "%04d", int( rand(9000) ) + 1000 );
        my $sf = $self->session_file($token);
        next if $sf && -f $sf;
        my $cf = ".amberdb/session/sess_$token";
        next if -f $cf;
        return $token;
    }
    return sprintf( "%04d", int( rand(9000) ) + 1000 );
}

sub _load_session {
    my ( $self, $token ) = @_;
    return undef unless defined $token && length $token;
    my @files = ( $self->session_file($token), ".amberdb/session/sess_$token" );

    for my $sf (@files) {
        next unless $sf && -f $sf;
        my $target = ( $sf =~ m{^(?:\./|[a-zA-Z]:|/|\\)} ) ? $sf : "./$sf";
        my $data = do $target;
        return $data if ref($data) eq 'HASH';

        if ( open my $fh, '<', $sf ) {
            local $/;
            my $raw = <$fh>;
            close $fh;
            if ( $raw && $raw =~ /^\s*\{/ ) {
                require JSON::PP;
                my $jdata = eval { JSON::PP::decode_json($raw) };
                return $jdata if $jdata && ref($jdata) eq 'HASH';
            }
        }
    }
    return undef;
}

sub _save_session {
    my ( $self, $token, $data ) = @_;
    return unless defined $token && length $token;
    my $sf = $self->session_file($token);
    return unless $sf;

    my ($dir) = $sf =~ m{^(.+)[/\\][^/\\]+$};
    $self->make_path($dir) if $dir && !$self->dir_exist($dir);

    require Data::Dumper;
    local $Data::Dumper::Terse    = 1;
    local $Data::Dumper::Indent   = 1;
    local $Data::Dumper::Sortkeys = 1;
    my $dump = Data::Dumper::Dumper($data);
    $dump =~ s/^\s+|\s+$//g;

    if ( open my $fh, '>', $sf ) {
        print $fh "# AmberDB Active CLI Session Token: $token\n";
        print $fh "return " . $dump . ";\n";
        close $fh;
    }

    # Also sync local .amberdb/session/sess_$token
    my $local_dir = ".amberdb/session";
    $self->make_path($local_dir) unless -d $local_dir;
    my $local_file = "$local_dir/sess_$token";
    if ( open my $lfh, '>', $local_file ) {
        require JSON::PP;
        print $lfh JSON::PP::encode_json($data);
        close $lfh;
    }

    return 1;
}

sub _delete_session {
    my ( $self, $token ) = @_;
    return unless defined $token && length $token;
    my $sf = $self->session_file($token);
    unlink $sf if $sf && -f $sf;
    my $local_file = ".amberdb/session/sess_$token";
    unlink $local_file if -f $local_file;
}

# my $val_or_token = $adb->connect([$key | %args]);
# ---------------------------------------------------------------------
sub connect {
    my ( $self, @args ) = @_;

    # 1. Single scalar argument: attribute getter -> $adb->connect('database')
    if ( @args == 1 && !ref( $args[0] ) ) {
        my $k = $args[0];
        $k = 'database' if $k eq 'dbase' || $k eq 'dbname';
        $k = 'username' if $k eq 'user'  || $k eq 'usr';
        $k = 'password' if $k eq 'pass'  || $k eq 'passwd';
        return $self->{_connect}->{$k} // '';
    }

    # If called with no args and already connected with valid token, return active token
    if ( !@args && defined $self->{_connect}->{token} && length $self->{_connect}->{token} ) {
        return $self->{_connect}->{token};
    }

    # 2. Connection / Authentication Action -> $adb->connect(%args) or $adb->connect()
    my %opts = ( @args == 1 && ref( $args[0] ) eq 'HASH' ) ? %{ $args[0] } : @args;

    my $token    = delete $opts{token}    // delete $opts{tok};
    my $database = delete $opts{database} // delete $opts{dbase} // delete $opts{dbname} // delete $opts{db} // $self->{_connect}->{database};
    my $username = delete $opts{username} // delete $opts{user}  // delete $opts{usr}    // $self->{_connect}->{username};
    my $password = delete $opts{password} // delete $opts{pass}  // delete $opts{passwd}  // $self->{_connect}->{password};

    # Sub-case A: Resume session via token
    if ( defined $token && length $token ) {
        my $sess = $self->_load_session($token);