view release on metacpan or  search on metacpan

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

    my ($username, $permission, $expected) = @$test;
    my $token = $user_tokens{$username};
    my $validated_user = validate_token_with_permissions($token, $permission);
    
    printf "  %-15s for %-8s: %s (%s)\n",
           "$username/$permission",
           $permission,
           $validated_user ? "✓ authorized" : "✗ denied",
           $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;
    
    return scalar @$attempts >= $MAX_ATTEMPTS;
}

sub record_failed_attempt {
    my ($username) = @_;
    
    $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 {
        # Record failed attempt
        record_failed_attempt($username);
        return (0, 'Invalid credentials');
    }
}

# Setup test user for rate limiting demo
my ($rate_fh, $rate_file) = tempfile(CLEANUP => 1);
close $rate_fh;
my $rate_auth = Concierge::Auth->new({file => $rate_file});
$rate_auth->setPwd('testuser', 'correct_password');

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
    push @errors, "Password must be at least 8 characters" unless length($password) >= 8;
    
    # Complexity requirements
    push @errors, "Password must contain at least one uppercase letter" unless $password =~ /[A-Z]/;
    push @errors, "Password must contain at least one lowercase letter" unless $password =~ /[a-z]/;
    push @errors, "Password must contain at least one number" unless $password =~ /\d/;
    push @errors, "Password must contain at least one special character" unless $password =~ /[^A-Za-z0-9]/;
    
    # Check for common weak patterns
    push @errors, "Password cannot be all numbers" if $password =~ /^\d+$/;
    push @errors, "Password cannot contain repeated characters" if $password =~ /(.)\1{2,}/;
    
    # Dictionary check (simplified)
    my @common_passwords = qw(password 123456 admin letmein welcome);
    push @errors, "Password is too common" if grep { lc($password) eq $_ } @common_passwords;
    
    return @errors;
}

sub register_with_policy {
    my ($auth, $username, $password) = @_;
    
    # Check password policy
    my @policy_errors = validate_password_policy($password);
    if (@policy_errors) {
        return (0, join('; ', @policy_errors));
    }