view release on metacpan or  search on metacpan

examples/08-advanced-usage.pl  view on Meta::CPAN

           $expected;
}

print "\n--- Rate Limiting and Security Features ---\n";

# Implement rate limiting for authentication attempts
my %failed_attempts;
my $MAX_ATTEMPTS = 3;
my $LOCKOUT_DURATION = 300; # 5 minutes

sub is_locked_out {
    my ($username) = @_;
    
    return unless exists $failed_attempts{$username};
    
    my $attempts = $failed_attempts{$username};
    my $now = time();
    
    # Clean up old attempts
    @$attempts = grep { $_->{timestamp} > ($now - $LOCKOUT_DURATION) } @$attempts;
    

examples/08-advanced-usage.pl  view on Meta::CPAN

    $failed_attempts{$username} ||= [];
    push @{$failed_attempts{$username}}, {
        timestamp => time(),
        ip_address => '127.0.0.1'  # In real app, get from request
    };
}

sub secure_authenticate {
    my ($auth, $username, $password) = @_;
    
    # Check if user is locked out
    if (is_locked_out($username)) {
        return (0, 'Account temporarily locked due to failed attempts');
    }
    
    # Attempt authentication
    my $success = $auth->checkPwd($username, $password);
    
    if ($success) {
        # Clear failed attempts on successful login
        delete $failed_attempts{$username};
        return (1, 'Authentication successful');
    } else {

examples/08-advanced-usage.pl  view on Meta::CPAN

print "Rate limiting demonstration:\n";

# Simulate multiple failed attempts
for my $attempt (1..5) {
    my ($success, $message) = secure_authenticate($rate_auth, 'testuser', 'wrong_password');
    printf "  Attempt %d: %s - %s\n", $attempt,
           $success ? "✓ success" : "✗ failed", $message;
}

print "\nAttempt with correct password after lockout:\n";
my ($locked_success, $locked_message) = secure_authenticate($rate_auth, 'testuser', 'correct_password');
printf "  Correct password: %s - %s\n",
       $locked_success ? "✓ success" : "✗ failed", $locked_message;

print "\n--- Custom Password Policy ---\n";

# Implement custom password policy
sub validate_password_policy {
    my ($password) = @_;
    
    my @errors;
    
    # Basic length check