File Coverage

blib/lib/AnyEvent/FTP/Server/Role/Auth.pm
Criterion Covered Total %
statement 43 48 89.5
branch 9 10 90.0
condition 3 3 100.0
subroutine 9 10 90.0
pod 1 5 20.0
total 65 76 85.5


line stmt bran cond sub pod time code
1             package AnyEvent::FTP::Server::Role::Auth;
2              
3 25     25   171901 use strict;
  25         164  
  25         659  
4 25     25   111 use warnings;
  25         44  
  25         504  
5 25     25   362 use 5.010;
  25         65  
6 25     25   414 use Moo::Role;
  25         12452  
  25         143  
7              
8             # ABSTRACT: Authentication role for FTP server
9             our $VERSION = '0.19'; # VERSION
10              
11              
12             has user => (is => 'rw');
13              
14              
15             has authenticated => (is => 'rw', default => sub { 0 } );
16              
17              
18             has authenticator => (
19             is => 'rw',
20             lazy => 1,
21             default => sub { sub { 0 } },
22             );
23              
24              
25             has bad_authentication_delay => (
26             is => 'rw',
27             default => sub { 5 },
28             );
29              
30              
31             has _safe_commands => (
32             is => 'ro',
33             lazy => 1,
34             default => sub {
35             my %h = map { (lc $_ => 1) } @{ shift->unauthenticated_safe_commands };
36             \%h;
37             },
38             );
39              
40             has unauthenticated_safe_commands => (
41             is => 'ro',
42             lazy => 1,
43             default => sub {
44             [qw( USER PASS HELP QUIT )]
45             },
46             );
47              
48              
49             sub auth_command_check_hook
50             {
51 674     674 1 1160 my($self, $con, $command) = @_;
52 674 100 100     5704 return 1 if $self->authenticated || $self->_safe_commands->{$command};
53 24         207 $con->send_response(530 => 'Please login with USER and PASS');
54 24         83 $self->done;
55 24         66 return 0;
56             }
57              
58              
59 6     6 0 22 sub help_user { 'USER username' }
60              
61             sub cmd_user
62             {
63 69     69 0 222 my($self, $con, $req) = @_;
64              
65 69         257 my $user = $req->args;
66 69         226 $user =~ s/^\s+//;
67 69         189 $user =~ s/\s+$//;
68              
69 69 100       206 if($user ne '')
70             {
71 68         259 $self->user($user);
72 68         289 $con->send_response(331 => "Password required for $user");
73             }
74             else
75             {
76 1         4 $con->send_response(530 => "USER requires a parameter");
77             }
78              
79 69         428 $self->done;
80             }
81              
82              
83 6     6 0 17 sub help_pass { 'PASS password' }
84              
85             sub cmd_pass
86             {
87 69     69 0 181 my($self, $con, $req) = @_;
88              
89 69         187 my $user = $self->user;
90 69         183 my $pass = $req->args;
91              
92 69 100       214 unless(defined $user)
93             {
94 1         4 $con->send_response(503 => 'Login with USER first');
95 1         5 $self->done;
96 1         2 return;
97             }
98              
99 68 100       1018 if($self->authenticator->($user, $pass))
100             {
101 64         734 $con->send_response(230 => "User $user logged in");
102 64         137 $self->{authenticated} = 1;
103 64         343 $self->emit(auth => $user);
104 64         187 $self->done;
105             }
106             else
107             {
108 4         67 my $delay = $self->bad_authentication_delay;
109 4 50       24 if($delay > 0)
110             {
111 0         0 my $timer;
112             $timer = AnyEvent->timer( after => 5, cb => sub {
113 0     0   0 $con->send_response(530 => 'Login incorrect');
114 0         0 $self->done;
115 0         0 undef $timer;
116 0         0 });
117             }
118             else
119             {
120 4         19 $con->send_response(530 => 'Login incorrect');
121 4         19 $self->done;
122             }
123             }
124             }
125              
126             1;
127              
128             __END__