view release on metacpan or  search on metacpan

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

        return unless grep { $_ eq $required_permission || $_ eq 'admin' } @permissions;
    }
    
    # Update usage stats
    $token_data->{last_used} = $now;
    $token_data->{use_count}++;
    
    return $token_data->{username};
}

# Generate tokens with different permissions
my @token_specs = (
    ['alice', ['read'], 'read-only token'],
    ['bob', ['read', 'write'], 'read-write token'],
    ['admin', ['admin'], 'admin token'],
    ['charlie', ['read', 'write', 'delete'], 'full-access token']
);

print "Generating permission-based tokens:\n";
my %user_tokens;

for my $spec (@token_specs) {
    my ($username, $permissions, $description) = @$spec;
    my $token = generate_advanced_token($username, $permissions);
    $user_tokens{$username} = $token;
    
    printf "  %-10s: %s (%s)\n", $username, substr($token, 0, 16) . '...', $description;
}

print "\nPermission-based access tests:\n";
my @permission_tests = (
    ['alice', 'read', 'should succeed'],
    ['alice', 'write', 'should fail - no write permission'],
    ['bob', 'read', 'should succeed'],
    ['bob', 'write', 'should succeed'],
    ['bob', 'delete', 'should fail - no delete permission'],
    ['admin', 'read', 'should succeed - admin can do anything'],
    ['admin', 'delete', 'should succeed - admin can do anything'],
    ['charlie', 'delete', 'should succeed']
);

for my $test (@permission_tests) {
    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));
    }
    
    # Use standard Concierge::Auth registration
    return $auth->setPwd($username, $password);
}

print "Password policy validation:\n";
my @policy_tests = (
    ['ValidPass123!', 'should pass all requirements'],
    ['short', 'should fail - too short'],
    ['alllowercase123!', 'should fail - no uppercase'],
    ['ALLUPPERCASE123!', 'should fail - no lowercase'], 
    ['NoNumbers!', 'should fail - no numbers'],
    ['NoSpecialChars123', 'should fail - no special characters'],
    ['123456789', 'should fail - all numbers'],
    ['aaabbbccc', 'should fail - repeated characters'],
    ['password', 'should fail - common password']
);

for my $test (@policy_tests) {
    my ($password, $expected) = @$test;
    my @errors = validate_password_policy($password);
    
    printf "  %-25s: %s (%s)\n",